From: Richard J. Gaylord <gaylord@ux1.cso.uiuc.edu>
Subject: comparing CAS prog. languages
X-Xxdate: Wed, 18 Nov 92 08:25:55 GMT
X-Useragent: Nuntius v1.1.1d12
Organization: University of Illinois
Date: Wed, 18 Nov 1992 14:24:16 GMT
X-Xxmessage-Id: <A72FAE934F039B11@mm-mac17.mse.uiuc.edu>

this posting consists of  a small number of Mathematica
programs that i have either written or seen on the net or in books that
seem to use functional things like using higher-order functions, pattern
matching, rewrite rules  and list manipulation.  these programs are
more-or-less one-liners but are nontheless 'serious' programs in the
sense that they do things that one might need to do.

i would like others who are proficient in other cas languages like maple
or axiom or macsyma to rewrite these  programs in their 
language  and send them to me.

i also welcome functional style code from anyone in any cas language (it
is best not to use  graphics, algebraic manipulation, numerics or
mathematical functions in your programs so that we can stay focused on
this one aspect of programming).  it is not necessary to explain the code
in any detail beyond a brief statement and showing an example of the
progam being used as is done below.

i will keep all of the programs i receive and post them periodically to
the group so  that people can compare various cas's programming
languages. 

people can also send improved versions of the progams that are posted.


======================
frequency of occurance of elements in a list

frequency[{a,a,b,c,c,c,a}]
{{a, 3}, {b, 1}, {c, 3}}

frequency[x_List] := Map[{#, Count[x, #]}&, Union[x]]
===============
un-nesting lists

unNest[{{a,a},{{b,b,b},{b}},{c,c,c},{a}}]
{{a, a}, {b, b, b}, {b}, {c, c, c}, {a}}

unNest[lis_] := Map[(# //.{x__List}->x)&, lis]
=================================
generating all 0-1 sequences of length n

sequences[3]
{{0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {0, 1, 1}, {1, 0, 0}, 
 {1, 0, 1}, {1, 1, 0}, {1, 1, 1}}

sequences[n_] := 
Flatten[Apply[Outer,Prepend[Table[{0,1},{n}],List]],n -1]
=========================
determining sequence runs in a list:  

runEncode[{a,a,b,c,c,c,a}]
{{a, 2}, {b, 1}, {c, 3}, {a, 1}}

runEncode1[x_List] :=
    Map[({#, 1})&,x]//.{u___,{v_,r_},{v_,s_},w___}->
    																																					  {u,{v,r+s},w}
runEncode2[x_List] := List@@times@@({#, 1}&/@x)
Attributes[times] := {Flat}
times[{a_,m_},{a_,n_}] := times[{a, m + n}]
===========================
The Josephus Problem  
With n people numbered 1 to n in a circle, every other person is
eliminated  until only one is survives.

survivor[10]
{5}

survivor[n_] :=
         Nest[(Rest[RotateLeft[#])&,Range[n],n-1]
===========================
Comparison Shopping 

(a) go to two stores and determine the lowest price for each item in a
list

comparisionShop1[{2,5,7,3},{3,2,8,2}]
{2, 2, 7, 2}

comparisionShop1[x_, y_] := 
         Map[Min,Thread[List[x, y]]]
comparisionShop2[x_, y_] := Map[Min,Transpose[{x, y}]]

(b) given the number of each item to be purchased, determine the total
lowest cost.

bargainHunter[{2,5,7,3},{3,2,8,2},{2,3,3,1}]
33

bargainHunter[x_, y_, z_] :=
 (comparisionShop1[m_, n_] := 
              Map[Min,Transpose[{m, n}]];
  Apply[Plus,z comparisionShop1[x,y]])             
===============================
Card Dealing (sampling w/o replacement) 
write a program that randomly selects r numbers from the list Range[n],
removing each number from the list as it is selected.

cardDealing[52, 4]
{22, 43, 50, 51}

cardDealing[n_, r_] := 
  Complement[Range[n],
      Nest[Delete[#,
        Random[Integer,{1,Length[#]}]]&,Range[n],r]]

creating a card deck

deck = 
Flatten[Outer[List,{c,d,h,s},Join[Range[2,10],{J,Q,K,A}]],1]
{{c, 2}, {c, 3}, {c, 4}, {c, 5}, {c, 6}, {c, 7}, {c, 8}, 
 {c, 9}, {c, 10}, {c, J}, {c, Q}, {c, K}, {c, A}, {d, 2}, 
 {d, 3}, {d, 4}, {d, 5}, {d, 6}, {d, 7}, {d, 8}, {d, 9}, 
 {d, 10}, {d, J}, {d, Q}, {d, K}, {d, A}, {h, 2}, {h, 3}, 
 {h, 4}, {h, 5}, {h, 6}, {h, 7}, {h, 8}, {h, 9}, {h, 10}, 
 {h, J}, {h, Q}, {h, K}, {h, A}, {s, 2}, {s, 3}, {s, 4}, 
 {s, 5}, {s, 6}, {s, 7}, {s, 8}, {s, 9}, {s, 10}, {s, J}, 
 {s, Q}, {s, K}, {s, A}}

cardDealing[52,5]/.Thread[Range[52]->deck]
{{c, 3}, {d, 3}, {d, K}, {h, 3}, {h, K}}
comment: not a bad hand.
=========================
return a list of those elements in a list that are larger than all of the
preceding elements. 

maxima[{2,5,3,6,4,8,1}]
{2, 5, 6, 8}

maxima1[x_] := Union[Rest[FoldList[Max,-Infinity,x]]]

maxima2[x_List] := 
     x//.{a___,b_,e___,c_,d___} :> {a,b,e,d}/;c <= b
=======================
divvying up a list 

split[{a,b,c,d,e,f},{2,0,3,1}]
{{a, b}, {}, {c, d, e}, {f}}

 split[lis_, parts_] := 
   Inner[Take[lis,{#1,#2}]&,
         Drop[#1,-1]+1,
         Rest[#1],
         List]&[ FoldList[Plus,0,parts] ]
=============================
Newsgroups: sci.math.symbolic