Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Re: how to get the longest ordered sub

• To: mathgroup at smc.vnet.net
• Subject: [mg103292] Re: [mg103227] Re: [mg103158] how to get the longest ordered sub
• From: DrMajorBob <btreat1 at austin.rr.com>
• Date: Sun, 13 Sep 2009 08:02:45 -0400 (EDT)
• References: <200909090845.EAA05996@smc.vnet.net>
• Reply-to: drmajorbob at yahoo.com

Fred,

Thanks for looking at this!

My singleLongestIncreasing code was meant for permutations (like  
Combinatorica's LongestIncreasingSubsequence) or at least for integer  
sequences with no repeats.

Hence, it doesn't surprise me if it fails on an example like

{207,586,803,964,352,618,586,445}

where 586 appears twice. A simple remedy goes like this:

s = {207, 586, 803, 964, 352, 618, 586, 445};
s[[t = Ordering@s]][[singleLongestIncreasing@Ordering@t]]

{207, 586, 803, 964}

and the same trick works for lists that are not Integer:

s = RandomReal[{0, 10}, 25]
s[[t = Ordering@s]][[singleLongestIncreasing@Ordering@t]]

{0.00676668, 7.13942, 5.40509, 3.2741, 5.53002, 8.21107, 0.244104, \
0.852249, 6.67937, 6.95541, 4.69291, 5.24756, 8.37349, 8.04903, \
5.9746, 4.28895, 8.13952, 3.35027, 5.79979, 4.89208, 5.45609, \
8.62996, 7.58016, 9.68173, 4.20249}

{0.00676668, 0.244104, 0.852249, 4.69291, 5.24756, 5.9746, 8.13952, \
8.62996, 9.68173}

My function is a slight modification of another code that finds ALL  
maximal increasing subsequences (in an integer list with no repeats), and  
that's why I used the "pred" function where List might do just as well. A  
few random tries gave me lists with, say, 35^2 + 1 entries with more than  
60,000 maximal subsequences (all the same length). I don't think List  
takes the place of "pred" in that situation. (But maybe I'm wrong.)

That earlier code is

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[#1, 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@{any}
   ]

I still haven't accomplished finding a maximal STRICTLY increasing  
subsequence of a list with repeats.

Bobby

On Sat, 12 Sep 2009 12:45:58 -0500, Fred Simons <f.h.simons at tue.nl> wrote:

> Hi Bobby,
>
> Since your code and Leonid's solution are so much faster than my poor  
> backtracking program, I deciphered the code you posted in mathgroup to  
> see what is behind it. The basic idea seems to be to construct two  
> functions, defined on the positions of the numbers of the list, the  
> function length giving the maximum length of an increasing sublist  
> ending at that position, the function pos giving the position of the  
> previous element in that increasing sublist. That enabled me to rewrite  
> your code
>
> Clear[zeroPad, singleLongestIncreasing]
> zeroPad[{}] = {0};
> zeroPad[x_List] := x
> singleLongestIncreasing[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]
>    ]
>
> into the following form:
>
> longestincreasingsubsequence3[lst_List] := Module[{length, pos},
> Do[
> With[{z=Pick[Range[i-1],Take[lst, i-1] -lst[[i]], _?Negative]},
> If[z=={}, length[i]=1;pos[i]=0,
> With[{zz =length /@z}, length[i]=1+Max[zz]; pos[i]=Pick[z, zz,  
> Max[zz]][[1]]]]], {i,1, Length[lst]}];
> lst[[Most[NestWhileList[pos,With[{zz=length /@ Range[Length[lst]]},  
> Pick[Range[Length[lst]],zz, Max[zz]][[1]]], Positive]]]]//Reverse]
>
> Both functions are about as fast; maybe yours is a fraction faster. But  
> it turns out that working with arrays rather than with functions still  
> speeds up my implementation considerably:
>
> longestincreasingsubsequence3a[lst_List] := Module[{length=Array[0&,  
> Length[lst]], pos=Array[0&, Length[lst]]},
> Do[
> With[{z=Pick[Range[i-1],Take[lst, i-1] -lst[[i]], _?Negative]},
> If[z=={}, length[[i]]=1;pos[[i]]=0,
> With[{zz =length[[z]]}, length[[i]]=1+Max[zz]; pos[[i]]=Pick[z, zz,  
> Max[zz]][[1]]]]], {i,1, Length[lst]}];
> lst[[Most[NestWhileList[pos[[#]]&,Position[length, Max[length]][[1,1]],  
> Positive]]]]//Reverse]
>
> In[48]:= ClearSystemCache[];
> lst=RandomInteger[{1,10000},2000];
> res1=longestincreasingsubsequence3[lst]; // Timing
> res2=longestincreasingsubsequence3a[lst]; // Timing
> Length[res1]==Length[res2]
>
> Out[50]= {4.103,Null}
> Out[51]= {2.34,Null}
> Out[52]= True
>
> Probably I would not have written this to you, if I did not want to call  
> your attention to a small problem with your code. Here is an example:
>
> In[53]:= lst={207,586,803,964,352,618,586,445};
> singleLongestIncreasing[lst]
> longestincreasingsubsequence3[lst]
> longestincreasingsubsequence3a[lst]
>
> Out[54]= {207,352,586,803,964}
> Out[55]= {207,586,803,964}
> Out[56]= {207,586,803,964}
>
> Your result seems to be incorrect; 803 is not a successor of 586. But I  
> did not study your code in so much detail that I can point to the source  
> of the error.
>
> Kind regards,
>
> Fred Simons
> Eindhoven University of Technology
>
>


-- 
DrMajorBob at yahoo.com

• References:
  • how to get the longest ordered sub sequence of a list in
    • From: a boy <a.dozy.boy@gmail.com>