home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / lang / apl / 1179 next >
Encoding:
Text File  |  1992-11-15  |  2.8 KB  |  106 lines
  1. Newsgroups: comp.lang.apl
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!sdd.hp.com!ux1.cso.uiuc.edu!news.cso.uiuc.edu!mm-mac22.mse.uiuc.edu!gaylord
  3. From: Richard J. Gaylord <gaylord@ux1.cso.uiuc.edu>
  4. Subject: apl/j programs in  recent VECTOR
  5. Message-ID: <Bxt2Fs.1E0@news.cso.uiuc.edu>
  6. X-Xxdate: Mon, 16 Nov 92 04:58:58 GMT
  7. Sender: usenet@news.cso.uiuc.edu (Net Noise owner)
  8. X-Useragent: Nuntius v1.1.1d12
  9. Organization: University of Illinois
  10. Date: Mon, 16 Nov 1992 10:57:27 GMT
  11. X-Xxmessage-Id: <A72CDB1280029B16@mm-mac22.mse.uiuc.edu>
  12. Lines: 92
  13.  
  14. in the most recent issue of VECTOR (vol.9 no. 2) on p.139  Roger Hui
  15. gives a solution in J to the Josephus problem.
  16.  
  17. J=.1&|.&.#:
  18.  
  19. this problem is one of the first that i use in teaching functional
  20. programming in mathematica and so i thought i'd post the answer in that
  21. language:
  22.  
  23. Josephus[n_] := Nest[Rest[RotateLeft[#]]&, Range[n], n-1]
  24.  
  25. Josephus[10]
  26. {5}
  27.  
  28. the explanation is straightforward: 
  29.  
  30. Range[n] creates the list {1,2,3,...,n}. 
  31.  
  32. you perform the following operation on the list:  
  33.         move the first element to the back of the list and drop the next
  34. element.
  35.     this is done with the anonymous function Rest[RotateLeft[#]]& which
  36. can also be
  37.     written as Function[y, Rest[RotateLeft[y]]] 
  38.     where RotateLeft and Rest are built-in functions that do what their
  39. names imply.
  40.  
  41. you apply this operation n-1 times using the built-in function Nest. 
  42.  
  43. the result is the last element left in the list.
  44.  
  45. if you prefer not to state any arguments in the solution you can write
  46. the entire function as an anonymous function :
  47.  
  48. J = Nest[Rest[RotateLeft[#]]&, Range[#], # - 1]&
  49.  
  50. J[10]
  51. {5}
  52.  
  53. this program is typical of the kinds of programs that i will discuss in
  54. my three-hour tutorial "Mathematica Programming for APL'ers" which i will
  55. give at the APL93 Conference in Toronto in August. the outline for that
  56. tutorial is:
  57.  
  58. "Mathematica Programming for APL'ers"
  59.  
  60. Part I. Functional Programming in Mathematica
  61. 1. List Manipulation
  62. 2. higher-order functions
  63.  
  64. Part II. Rule-Based Programming in Mathematica
  65. 1. Pattern Matching
  66. 2. Rewrite Rules
  67.  
  68. ==========================
  69.  
  70. btw -  the determinant of a Hilbert matrix in smalltalk, apl and j was
  71. also discussed in the recent issue of VECTOR. to do that problem in
  72. Mathematica one uses:
  73.  
  74.  
  75. Hilbert[n_] := Table[1/(i + j - 1), {i, n}, {j, n}]
  76.  
  77.  
  78. Hilbert[3]
  79.      1  1    1  1  1    1  1  1
  80. {{1, -, -}, {-, -, -}, {-, -, -}}
  81.      2  3    2  3  4    3  4  5
  82.  
  83.  
  84. Hilbert[3]//MatrixForm
  85.     1   1
  86.     -   -
  87. 1   2   3
  88.  
  89. 1   1   1
  90. -   -   -
  91. 2   3   4
  92.  
  93. 1   1   1
  94. -   -   -
  95. 3   4   5
  96.  
  97.  
  98. Table[Det[Hilbert[i]], {i, 1, 7}]
  99.     1    1       1          1                1
  100. {1, --, ----, -------, ------------, ------------------, 
  101.     12  2160  6048000  266716800000  186313420339200000
  102.  
  103.               1
  104.   -------------------------}
  105.   2067909047925770649600000
  106.