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