Re: functional code
- To: mathgroup at smc.vnet.net
- Subject: [mg4815] Re: functional code
- From: danl (Daniel Lichtblau)
- Date: Fri, 20 Sep 1996 01:12:38 -0400
- Organization: Wolfram Research, Inc.
- Sender: owner-wri-mathgroup at wolfram.com
In article <51c52l$b2u at ralph.vnet.net> gaylord at ux1.cso.uiuc.edu (richard
j. gaylord) writes:
> 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};
> <code deleted>>
> result
>
> {18,19,14,22,12,25,11,1}
> <...>
I have seen several solutions to this problem. I would not want to run any
of them on a list of 100K elements. If you first run them on
row = Table[Random[Integer, 1000], {500}];
and then on
row = Table[Random[Integer, 1000], {1000}];
you see that each is O(n^2). But the problem obviously can be done in
O(n). I'll summarize some of the timings for the case where row has 1000
elements. These were run on a NeXT turbo.
rowtemp = row;
p = Length[rowtemp];
result = {};
Timing[Do[If[First[rowtemp]>=Last[rowtemp],
AppendTo[result, First[rowtemp]]; rowtemp =Rest[rowtemp],
AppendTo[result,Last[rowtemp]]; rowtemp =Drop[rowtemp,-1]],
{p}];
] (* 7 sec *)
Nest[
Function[y,
({Join[y[[1]],{#}] , DeleteCases[y[[2]], #]})&[Max[First[y[[2]]],
Last[y[[2]]]]]], {{}, row}, Length[row]][[1]] // Timing (* 14.4 sec and
error messages *)
Timing[{{},row}//.{{d___},{a_,b___,c_}}:>
{{d,Max[a,c]},If[a<c,{a,b},{b,c}]}//Flatten] (* 13.9 sec *)
{{},row}//.{
{{d___},{a_,b___,c_}}/;a<c :> {{d,c},{a,b}},
{{d___},{a_,b___,c_}}/;a>=c :> {{d,a},{b,c}}} //
Flatten //Timing (* 11.5 sec *)
Apply[
(#1 - #2)&,
Partition[
(Plus @@ #)& /@ NestList[
If[First[#] >= Last[#], Rest[#], Drop[#, -1]]&,
row,
Length[row]
],
2,
1
],
1
] // Timing (* 15 sec *)
The problem these have with large inputs (that is, the cause of the O(n^2)
behavior), is twofold. Several use AppendTo[list, element] rather than
list = {list, element} followed, at the end of the loop, by list =
Flatten[list]. The former must make a copy of list each time, rather than
just adding a reference to it; hence the O(n^2). This is easily remedied.
The second typical problem is that the new set of elements is formed by
dropping an element from the old. This, too, requires copying O(n)
elements O(n) times. I do not see an obvious functional programming
workaround to make this O(n). My conclusion is that one should either use
procedural code to solve a problem that is best solved by procedural
means, or else one should find a functional programming solution that does
this without all the list copying. This latter choice is beyond my
capability. For the former, I give an O(n) procedural solution below.
takeLargestFromEnds[input_List] := Module[
{j=1, k=Length[input], result={}},
While[j<=k,
If [input[[j]]>input[[k]],
result = {result, input[[j]]}; j++,
result = {result, input[[k]]}; k--];
];
Flatten[result]
]
(tl1 = takeLargestFromEnds[row]); // Timing (* 1.25 sec *)
row = Table[Random[Integer, 1000], {10000}];
(tl2 = takeLargestFromEnds[row]); // Timing (* 12.5 sec *)
Daniel Lichtblau
Wolfram Research, Inc.
danl at wolfram.com
==== [MESSAGE SEPARATOR] ====