Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

Re: Increasing scattered subsequence

  • To: mathgroup at smc.vnet.net
  • Subject: [mg80134] Re: Increasing scattered subsequence
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Mon, 13 Aug 2007 04:37:26 -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> <16850717.1186975277176.JavaMail.root@m35>
  • Reply-to: drmajorbob at bigfoot.com

> Interesting, but certinly not an answer to the original question

True. I responded a bit too quickly, as I often do.

Bobby

On Sat, 11 Aug 2007 13:02:10 -0500, Andrzej Kozlowski <akoz at mimuw.edu.pl>  
wrote:

> 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:
>>
>> 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.
>>>>
>>>>
>>>> 
>>>
>>>
>>>
>>
>>
>>
>> --DrMajorBob at bigfoot.com
>
>



-- 

DrMajorBob at bigfoot.com


  • Prev by Date: Re: question in mathematica
  • Next by Date: Re: Version 6 "Mathematica Book" - updated and expanded
  • Previous by thread: Re: Increasing scattered subsequence
  • Next by thread: Re: Increasing scattered subsequence