MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Increasing scattered subsequence

  • To: mathgroup at smc.vnet.net
  • Subject: [mg80084] Increasing scattered subsequence
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Sun, 12 Aug 2007 07:15:27 -0400 (EDT)
  • References: <fa11b990e477.46baf2d3@bgu.ac.il> <D370EB89-ACFD-4FFF-B4E7-84A25FF267C5@mimuw.edu.pl> <C82B7D4D-6C0B-47E1-8603-DEE030A6E387@mimuw.edu.pl> <f69ab100e04a.46bc3a23@bgu.ac.il> <28688943.1186820838583.JavaMail.root@m35>
  • Reply-to: drmajorbob at bigfoot.com

> On 10 Aug 2007, at 10:12, Ivan Egorov wrote:
>
(snip)
>> Write a function maxima[lis_List] which, given a list of numbers,
>> produces a list of those numbers greater than all those
>> that precede them. For example
>>
>> maxima[{ 9, 2, 10, 3, 14, 9}] returns { 9, 10, 14}.

Combinatorica includes a function, LongestIncreasingSubsequence, that  
returns the LONGEST increasing scattered subsequence. And here's a faster  
code of my own:

Clear[zeroPad, singleLongest]
zeroPad[{}] = {0};
zeroPad[x_List] := x
singleLongest[x_List] :=
  Module[{t = Append[x, 1 + Max@x], len, pred, path, max},
   path[i_Integer, o___Integer] /; pred[i] != {} :=
    path[Last@pred@i, i, o];
   len[i_] := len[i] = Module[
      {mx, prior, pick, nxt = t[[i]]},
      pick = Pick[Range[i - 1], Take[t, i - 1] - nxt, _?Negative];
      prior = len /@ pick;
      mx = Max@zeroPad@prior;
      pred[nxt] = t[[Pick[pick, prior, mx]]];
      1 + mx];
   len /@ Range@Length@t;
   Most[(path@Last@t) /. path -> List]
   ]

Needs["Combinatorica`"]
n = 35;
s = Ordering@RandomReal[{0, 1}, n^2 + 1];
Timing[mine = singleLongest@s]
Timing[theirs = LongestIncreasingSubsequence@s]
theirs == mine

{1.39, {51, 64, 89, 131, 143, 148, 189, 193, 195, 197, 241, 255, 318,
   332, 372, 393, 408, 444, 448, 468, 478, 491, 493, 497, 535, 536,
   563, 581, 599, 613, 618, 620, 639, 648, 688, 725, 747, 753, 762,
   766, 767, 802, 842, 850, 876, 950, 960, 961, 998, 1045, 1052, 1076,
   1084, 1087, 1095, 1101, 1104, 1149, 1168, 1194}}

{12.375, {51, 64, 89, 131, 143, 148, 189, 193, 195, 197, 241, 255,
   318, 332, 372, 393, 408, 444, 448, 468, 478, 491, 493, 497, 535,
   536, 563, 581, 599, 613, 618, 620, 639, 648, 688, 725, 747, 753,
   762, 766, 767, 802, 842, 850, 876, 950, 960, 961, 998, 1045, 1052,
   1076, 1084, 1087, 1095, 1101, 1104, 1149, 1168, 1194}}

True

I call it "singleLongest" because the following code returns ALL the  
optimal subsequences.

Clear[zeroPad, longest]
zeroPad[{}] = {0};
zeroPad[x_List] := x
longest[x_List] :=
  Module[{t = Append[x, 1 + Max@x], len, pred, path, max},
   path[i_Integer, o___Integer] /; pred[i] != {} :=
    Flatten[path[#, i, o] & /@ pred[i]];
   len[i_] := len[i] = Module[
      {mx, prior, pick, nxt = t[[i]]},
      pick = Pick[Range[i - 1], Take[t, i - 1] - nxt, _?Negative];
      prior = len /@ pick;
      mx = Max@zeroPad@prior;
      pred[nxt] = t[[Pick[pick, prior, mx]]];
      1 + mx];
   len /@ Range@Length@t;
   (path@Last@t) /. path[any__] :> Most@List[any]
   ]

n = 25;
s = Ordering@RandomReal[{0, 1}, n^2 + 1];
Timing[mine = longest@s;]
Timing[theirs = LongestIncreasingSubsequence@s]
MemberQ[mine, theirs]
Length@theirs
Length /@ mine // Union
Length@mine

{0.812, Null}

{3.625, {23, 27, 29, 39, 46, 54, 74, 82, 99, 137, 149, 173, 202, 205,
   234, 258, 282, 284, 290, 291, 295, 322, 337, 344, 345, 347, 350,
   351, 411, 421, 435, 445, 453, 461, 480, 520, 540, 568, 569, 592,
   597, 598, 612, 615}}

True

44

{44}

4536

"longest" is fast when a reasonable number of optima exist (4536 in that 
problem), but it can be slow in extreme cases:

n = 25;
s = Ordering@RandomReal[{0, 1}, n^2 + 1];
Timing[mine = longest@s;]
Timing[theirs = LongestIncreasingSubsequence@s]
MemberQ[mine, theirs]
Length@theirs
Length /@ mine // Union
Length@mine

{59.156, Null}

{3.61, {5, 36, 53, 61, 78, 117, 140, 157, 161, 197, 200, 209, 215,
   229, 232, 234, 235, 246, 254, 271, 293, 328, 370, 372, 377, 378,
   380, 385, 391, 398, 406, 416, 435, 451, 460, 474, 512, 514, 528,
   558, 559, 572, 573, 578, 596, 619}}

True

46

{46}

359250

In case one NEEDS all 359250 solutions, it's only 16 times slower than the  
built-in that returns just ONE.

Bobby

On Sat, 11 Aug 2007 01:22:04 -0500, Andrzej Kozlowski <akoz at mimuw.edu.pl>  
wrote:

> First, please send such question to the MathGroup,
>
> mathgroup at smc.vnet.net
>
> not me personally. (I really have desire, tiem or ability to replace
> the enitre MathGroup.)
> So I have decided to post this question to the MathGroup in case
> someone else finds it interesting.
>
> Also, there is something about this question and the earlier you sent
> me that make sme suspicious.  What do you say "you need to use
> recursion and pattern matching, Select and Join"? This sounds to me
> like some sort of test problem so I have decided to answer it but
> without using any of these functions (although it may not be the
> simplest way to do this). So here is my answer:
>
>   ls = {9, 2, 10, 3, 14, 9};
>
> Reverse[Last[Last[Reap[NestWhile[With[{a = First[Ordering[#, -1]]},
> Sow[#[[a]]]; Take[#, a - 1]] &,ls,Length[#] > 0 &]]]]]
>
> {9, 10, 14}
>
>
> On 10 Aug 2007, at 10:12, Ivan Egorov wrote:
>
>> I have one more question.
>>
>>
>>
>> Write a function maxima[lis_List] which, given a list of numbers,
>> produces a list of those
>>
>> numbers greater than all those that precede them. For example
>>
>> maxima[{ 9, 2, 10, 3, 14, 9}] returns { 9, 10, 14}. You need to use
>> recursion, pattern matching,
>>
>> Select and Join.
>>
>>
>> =E2=80=8E
>
>
>



-- =

DrMajorBob at bigfoot.com


  • Prev by Date: Re: Increasing scattered subsequence
  • Next by Date: Re: Re: Re: Working with factors of triangular numbers.
  • Previous by thread: Re: Re: Increasing scattered subsequence
  • Next by thread: Re: Increasing scattered subsequence