home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / sci / math / symbolic / 3019 < prev    next >
Encoding:
Text File  |  1992-11-18  |  5.0 KB  |  159 lines
  1. Newsgroups: sci.math.symbolic
  2. Path: sparky!uunet!paladin.american.edu!darwin.sura.net!spool.mu.edu!uwm.edu!ux1.cso.uiuc.edu!news.cso.uiuc.edu!mm-mac17.mse.uiuc.edu!gaylord
  3. From: Richard J. Gaylord <gaylord@ux1.cso.uiuc.edu>
  4. Subject: comparing CAS prog. languages
  5. Message-ID: <Bxx1CI.Fzv@news.cso.uiuc.edu>
  6. X-Xxdate: Wed, 18 Nov 92 08:25:55 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: Wed, 18 Nov 1992 14:24:16 GMT
  11. X-Xxmessage-Id: <A72FAE934F039B11@mm-mac17.mse.uiuc.edu>
  12. Lines: 145
  13.  
  14. this posting consists of  a small number of Mathematica
  15. programs that i have either written or seen on the net or in books that
  16. seem to use functional things like using higher-order functions, pattern
  17. matching, rewrite rules  and list manipulation.  these programs are
  18. more-or-less one-liners but are nontheless 'serious' programs in the
  19. sense that they do things that one might need to do.
  20.  
  21. i would like others who are proficient in other cas languages like maple
  22. or axiom or macsyma to rewrite these  programs in their 
  23. language  and send them to me.
  24.  
  25. i also welcome functional style code from anyone in any cas language (it
  26. is best not to use  graphics, algebraic manipulation, numerics or
  27. mathematical functions in your programs so that we can stay focused on
  28. this one aspect of programming).  it is not necessary to explain the code
  29. in any detail beyond a brief statement and showing an example of the
  30. progam being used as is done below.
  31.  
  32. i will keep all of the programs i receive and post them periodically to
  33. the group so  that people can compare various cas's programming
  34. languages. 
  35.  
  36. people can also send improved versions of the progams that are posted.
  37.  
  38.  
  39. ======================
  40. frequency of occurance of elements in a list
  41.  
  42. frequency[{a,a,b,c,c,c,a}]
  43. {{a, 3}, {b, 1}, {c, 3}}
  44.  
  45. frequency[x_List] := Map[{#, Count[x, #]}&, Union[x]]
  46. ===============
  47. un-nesting lists
  48.  
  49. unNest[{{a,a},{{b,b,b},{b}},{c,c,c},{a}}]
  50. {{a, a}, {b, b, b}, {b}, {c, c, c}, {a}}
  51.  
  52. unNest[lis_] := Map[(# //.{x__List}->x)&, lis]
  53. =================================
  54. generating all 0-1 sequences of length n
  55.  
  56. sequences[3]
  57. {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {0, 1, 1}, {1, 0, 0}, 
  58.  {1, 0, 1}, {1, 1, 0}, {1, 1, 1}}
  59.  
  60. sequences[n_] := 
  61. Flatten[Apply[Outer,Prepend[Table[{0,1},{n}],List]],n -1]
  62. =========================
  63. determining sequence runs in a list:  
  64.  
  65. runEncode[{a,a,b,c,c,c,a}]
  66. {{a, 2}, {b, 1}, {c, 3}, {a, 1}}
  67.  
  68. runEncode1[x_List] :=
  69.     Map[({#, 1})&,x]//.{u___,{v_,r_},{v_,s_},w___}->
  70.                                                                                                                                                           {u,{v,r+s},w}
  71. runEncode2[x_List] := List@@times@@({#, 1}&/@x)
  72. Attributes[times] := {Flat}
  73. times[{a_,m_},{a_,n_}] := times[{a, m + n}]
  74. ===========================
  75. The Josephus Problem  
  76. With n people numbered 1 to n in a circle, every other person is
  77. eliminated  until only one is survives.
  78.  
  79. survivor[10]
  80. {5}
  81.  
  82. survivor[n_] :=
  83.          Nest[(Rest[RotateLeft[#])&,Range[n],n-1]
  84. ===========================
  85. Comparison Shopping 
  86.  
  87. (a) go to two stores and determine the lowest price for each item in a
  88. list
  89.  
  90. comparisionShop1[{2,5,7,3},{3,2,8,2}]
  91. {2, 2, 7, 2}
  92.  
  93. comparisionShop1[x_, y_] := 
  94.          Map[Min,Thread[List[x, y]]]
  95. comparisionShop2[x_, y_] := Map[Min,Transpose[{x, y}]]
  96.  
  97. (b) given the number of each item to be purchased, determine the total
  98. lowest cost.
  99.  
  100. bargainHunter[{2,5,7,3},{3,2,8,2},{2,3,3,1}]
  101. 33
  102.  
  103. bargainHunter[x_, y_, z_] :=
  104.  (comparisionShop1[m_, n_] := 
  105.               Map[Min,Transpose[{m, n}]];
  106.   Apply[Plus,z comparisionShop1[x,y]])             
  107. ===============================
  108. Card Dealing (sampling w/o replacement) 
  109. write a program that randomly selects r numbers from the list Range[n],
  110. removing each number from the list as it is selected.
  111.  
  112. cardDealing[52, 4]
  113. {22, 43, 50, 51}
  114.  
  115. cardDealing[n_, r_] := 
  116.   Complement[Range[n],
  117.       Nest[Delete[#,
  118.         Random[Integer,{1,Length[#]}]]&,Range[n],r]]
  119.  
  120. creating a card deck
  121.  
  122. deck = 
  123. Flatten[Outer[List,{c,d,h,s},Join[Range[2,10],{J,Q,K,A}]],1]
  124. {{c, 2}, {c, 3}, {c, 4}, {c, 5}, {c, 6}, {c, 7}, {c, 8}, 
  125.  {c, 9}, {c, 10}, {c, J}, {c, Q}, {c, K}, {c, A}, {d, 2}, 
  126.  {d, 3}, {d, 4}, {d, 5}, {d, 6}, {d, 7}, {d, 8}, {d, 9}, 
  127.  {d, 10}, {d, J}, {d, Q}, {d, K}, {d, A}, {h, 2}, {h, 3}, 
  128.  {h, 4}, {h, 5}, {h, 6}, {h, 7}, {h, 8}, {h, 9}, {h, 10}, 
  129.  {h, J}, {h, Q}, {h, K}, {h, A}, {s, 2}, {s, 3}, {s, 4}, 
  130.  {s, 5}, {s, 6}, {s, 7}, {s, 8}, {s, 9}, {s, 10}, {s, J}, 
  131.  {s, Q}, {s, K}, {s, A}}
  132.  
  133. cardDealing[52,5]/.Thread[Range[52]->deck]
  134. {{c, 3}, {d, 3}, {d, K}, {h, 3}, {h, K}}
  135. comment: not a bad hand.
  136. =========================
  137. return a list of those elements in a list that are larger than all of the
  138. preceding elements. 
  139.  
  140. maxima[{2,5,3,6,4,8,1}]
  141. {2, 5, 6, 8}
  142.  
  143. maxima1[x_] := Union[Rest[FoldList[Max,-Infinity,x]]]
  144.  
  145. maxima2[x_List] := 
  146.      x//.{a___,b_,e___,c_,d___} :> {a,b,e,d}/;c <= b
  147. =======================
  148. divvying up a list 
  149.  
  150. split[{a,b,c,d,e,f},{2,0,3,1}]
  151. {{a, b}, {}, {c, d, e}, {f}}
  152.  
  153.  split[lis_, parts_] := 
  154.    Inner[Take[lis,{#1,#2}]&,
  155.          Drop[#1,-1]+1,
  156.          Rest[#1],
  157.          List]&[ FoldList[Plus,0,parts] ]
  158. =============================
  159.