Drexel dragonThe Math ForumDonate to the Math Forum



Search All of the Math Forum:

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


Math Forum » Discussions » Software » comp.soft-sys.math.mathematica

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

Advanced Search

Back to Topic List Back to Topic List  
w.meeussen.vdmcc@vandemoortele.be

Posts: 69
Registered: 12/4/04
Re: [mg4779] functional code
Posted: Sep 20, 1996 12:53 AM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply

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 ...








Point your RSS reader here for a feed of the latest messages in this topic.

[Privacy Policy] [Terms of Use]

© Drexel University 1994-2014. All Rights Reserved.
The Math Forum is a research and educational enterprise of the Drexel University School of Education.