Re: Increasing scattered subsequence

• To: mathgroup at smc.vnet.net
• Subject: [mg80086] Re: Increasing scattered subsequence
• From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
• Date: Sun, 12 Aug 2007 07:16:29 -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> <op.twwnxqppqu6oor@monster.gateway.2wire.net>

```Interesting, but certinly not an answer to the original question (at
least in the sense that I undestood the original question). The
question was to find a subsequence such that each element is larger
than all those that precede it in the original sequence, not in the
subsequence.
That's what my code does, anyway.

Andrzej Kozlowski

On 11 Aug 2007, at 19:23, DrMajorBob wrote:

>> 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:
>
> 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.
>
> 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: Version 6 "Mathematica Book" - updated and expanded
• Next by Date: Increasing scattered subsequence
• Previous by thread: Re: Manipulate and conflict in options to update front
• Next by thread: Re: Re: Increasing scattered subsequence