Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

Topic: Re: [mg4779] functional code
Replies: 0

 w.meeussen.vdmcc@vandemoortele.be Posts: 69 Registered: 12/4/04
Re: [mg4779] functional code
Posted: Sep 20, 1996 12:53 AM

At 13:54 13-09-96 -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 non-functional 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 very-same-function 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 sequel-subjects ...