Newsgroups: comp.lang.apl
Path: watmath!watserv2.uwaterloo.ca!torn!cs.utexas.edu!sdd.hp.com!ux1.cso.uiuc.edu!news.cso.uiuc.edu!mm-mac22.mse.uiuc.edu!gaylord
From: Richard J. Gaylord <gaylord@ux1.cso.uiuc.edu>
Subject: apl/j programs in  recent VECTOR
Message-ID: <Bxt2Fs.1E0@news.cso.uiuc.edu>
X-Xxdate: Mon, 16 Nov 92 04:58:58 GMT
Sender: usenet@news.cso.uiuc.edu (Net Noise owner)
X-Useragent: Nuntius v1.1.1d12
Organization: University of Illinois
Date: Mon, 16 Nov 1992 10:57:27 GMT
X-Xxmessage-Id: <A72CDB1280029B16@mm-mac22.mse.uiuc.edu>
Lines: 92

in the most recent issue of VECTOR (vol.9 no. 2) on p.139  Roger Hui
gives a solution in J to the Josephus problem.

J=.1&|.&.#:

this problem is one of the first that i use in teaching functional
programming in mathematica and so i thought i'd post the answer in that
language:

Josephus[n_] := Nest[Rest[RotateLeft[#]]&, Range[n], n-1]

Josephus[10]
{5}

the explanation is straightforward: 

Range[n] creates the list {1,2,3,...,n}. 

you perform the following operation on the list:  
		move the first element to the back of the list and drop the next
element.
    this is done with the anonymous function Rest[RotateLeft[#]]& which
can also be
    written as Function[y, Rest[RotateLeft[y]]] 
    where RotateLeft and Rest are built-in functions that do what their
names imply.

you apply this operation n-1 times using the built-in function Nest. 

the result is the last element left in the list.

if you prefer not to state any arguments in the solution you can write
the entire function as an anonymous function :

J = Nest[Rest[RotateLeft[#]]&, Range[#], # - 1]&

J[10]
{5}

this program is typical of the kinds of programs that i will discuss in
my three-hour tutorial "Mathematica Programming for APL'ers" which i will
give at the APL93 Conference in Toronto in August. the outline for that
tutorial is:

"Mathematica Programming for APL'ers"

Part I. Functional Programming in Mathematica
1. List Manipulation
2. higher-order functions

Part II. Rule-Based Programming in Mathematica
1. Pattern Matching
2. Rewrite Rules

==========================

btw -  the determinant of a Hilbert matrix in smalltalk, apl and j was
also discussed in the recent issue of VECTOR. to do that problem in
Mathematica one uses:


Hilbert[n_] := Table[1/(i + j - 1), {i, n}, {j, n}]


Hilbert[3]
     1  1    1  1  1    1  1  1
{{1, -, -}, {-, -, -}, {-, -, -}}
     2  3    2  3  4    3  4  5


Hilbert[3]//MatrixForm
    1   1
    -   -
1   2   3

1   1   1
-   -   -
2   3   4

1   1   1
-   -   -
3   4   5


Table[Det[Hilbert[i]], {i, 1, 7}]
    1    1       1          1                1
{1, --, ----, -------, ------------, ------------------, 
    12  2160  6048000  266716800000  186313420339200000
 
              1
  -------------------------}
  2067909047925770649600000
