
Re: [mg4779] functional code
Posted:
Sep 20, 1996 12:53 AM


At 13:54 130996 0400, you wrote: >i received the following query from someone and thought i'd post the >problem and a solution i've come up with: > >query: > >Here is my nonfunctional solution to this problem: > >Given a list of numbers row={18,19,1,11,25,12,22,14} >Select the numbers from the list by taking the largest number >from the ends of the list until the list is empty. > >row={18,19,1,11,25,12,22,14}; >p=Length[row]; >result={}; >Do[If[First[row]>=Last[row], >AppendTo[result, First[row]];row=Rest[row], >AppendTo[result,Last[row]];row=Drop[row,1]], >{p}]; > >result > >{18,19,14,22,12,25,11,1} > >If there a way to do this functionally? > With the hindsight of your, Paul Abbott's and Robert Hall's approaches, I am tempted to ' ~Join~ ' in : let the prize go to the cleanest & meanest !! readable !! function. After all, we want to be able to read our code after some weeks have past. Here is my bit : 
my[l_List]:= If[Length[l]<=1, l,
{Max[First[l],Last[l]]} ~Join~ If[First[l]>=Last[l], my[ Rest[l] ], my[ Drop[l,1] ] ] ]  It is a variant of the classical recursive 'Hanoi Towers' problem : If the length is 1, then return the argument, else return the selected bit, followed by the verysamefunction of the shortened argument.
on the following job : row=Table[Random[Integer,{0,9}],{1000}];
my[row] runs in 4.62 Seconds, but I have to set $RecursionLimit=16000 or so;
Paul Abbott's first function :  {{},row}//.{{d___},{a_,b___,c_}}:> {{d,Max[a,c]},If[a<c,{a,b},{b,c}]}//Flatten//Timing  does it in 5.14 Seconds;
Paul's second :  {{},row}//.{ {{d___},{a_,b___,c_}}/;a<c :> {{d,c},{a,b}}, {{d___},{a_,b___,c_}}/;a>=c :> {{d,a},{b,c}}}//Flatten//Timing  in 5.34 Seconds;
Robert Hall's first :  takeLargestFromEnds[row_] := Module[ {result, list = row}, result={}; Do[ If[ First[list]>=Last[list], AppendTo[result, First[list]]; list = Rest[list], AppendTo[result, Last[list]]; list = Drop[list, 1] ], {Length[row]} ]; result ]  does it in 4.11 Seconds, and holds the speed record.
His second version is the slowest :  Apply[ (#1  #2)&, Partition[ (Plus @@ #)& /@ NestList[ If[First[#] >= Last[#], Rest[#], Drop[#, 1]]&, row, Length[row] ], 2, 1 ], 1 ]//Timing  it takes 12.56 Seconds.
But the problem as it stands is ill defined: take for instance : {5,0,3,9,5} It matters what '5' to drop ! if take the left one, the remaining list is {0,3,9,5}, next step >5, but if you take & drop the rightmost '5', then you're left with {5,0,3,9}, next step >9.
in my function my[ ], it is sufficient to replace ... If[First[l]>=Last[l], ... with ... If[First[l]> Last[l], ... to make the change. In Robert Hall's 'takeLargestFromEnds' ,the code is sufficiently transparent to do the same, but I would not know on the spot how to adapt Paul's compact solutions.
I am realy interested to know how other Mma users manage to document and clarify the solutions, once found. Such documentation may seem to be less 'creative' somehow, but ...
Wouter Meeussen
PS. this might become an other one of those sequelsubjects ...

