19
$\begingroup$

I have a list, for example

list = {2, 1, 3, 5, 4, 6}

How to find longest ascending sequence of this list?

There are two meanings of this question:

  1. Find the largest subset that $$ X_{i_1} < X_{i_2} < \ldots < X_{i_{n-1}} < X_{i_n} $$ where $$ i_1 < i_2 < \ldots < i_{n-1} < i_n $$

  2. Find the largest subsequence that

    $$ X_i < X_{i+1} < \ldots < X_{j-1} < X_{j} $$

| improve this question | |
$\endgroup$
3
$\begingroup$

Question 1

LongestAscendingSequence was an undocumented in symbol in M10.1 and earlier, and has been removed as of M10.2+. In M10.2 the symbol LongestOrderedSequence was added, but it's functionality is slightly different. So, I thought it might be helpful to provide an answer to part 1 of this question that works in M10.2+.

The main difference between the two functions is that LongestAscendingSequence returned a strictly ascending sequence, while LongestOrderedSequence returns a non-descending sequence. In other words, LongestOrderedSequence includes duplicates, while LongestAscendingSequence did not. One possibility is to define a new LongestAscendingSequence using LongestCommonSequence:

LongestAscendingSequenceSlow[list_] := LongestCommonSequence[list, Union[list]]

However, this is rather slow:

list = RandomInteger[10^6, 10^6];
LongestAscendingSequenceSlow[list]; //AbsoluteTiming

{1.39408, Null}

On the other hand, it is possible to use LongestOrderedSequence to produce a much faster version:

LongestAscendingSequence[list_] := Which[
    Developer`PackedArrayQ[list, Real],
    LongestOrderedSequence[Transpose[{list, -1. Range @ Length @ list}]][[All, 1]],

    True,
    LongestOrderedSequence[Transpose[{list, - Range @ Length @ list}]][[All, 1]]
]

And here is a speed comparison:

r1 = LongestAscendingSequenceSlow[list]; //AbsoluteTiming
r2 = LongestAscendingSequence[list]; //AbsoluteTiming

Length @ r1 === Length @ r2

{1.40971, Null}

{0.098286, Null}

True

Question 2

Now, it is also possible to speed up the second question as follows:

longestAscendingSubsequence[list_] := With[
    {diff=SparseArray[Differences[-list]//UnitStep]},
    {nzp=Flatten @ diff["NonzeroPositions"]},
    {runs=Differences[nzp]},
    {ord=1+Length[runs]-First@Ordering[Reverse@runs,-1]},

    Take[list, nzp[[ord]] + {1, runs[[ord]]}]
]

(I used the new form of With above, although its syntax coloring is completely wrong). A comparison with longest1 and longest2 (I didn't compare @JacobAkkerboom's function because it is designed to work for integers):

SeedRandom[0];
list = RandomReal[NormalDistribution[], 1000000];

longest1[list] //AbsoluteTiming
longest2[list] //AbsoluteTiming
longestAscendingSubsequence[list] //AbsoluteTiming

{0.504056, {-2.34409, -1.21854, -0.951283, -0.873138, -0.744772, -0.157809, 0.380566, 1.36488, 1.65743}}

{0.096426, {-2.34409, -1.21854, -0.951283, -0.873138, -0.744772, -0.157809, 0.380566, 1.36488, 1.65743}}

{0.035699, {-2.34409, -1.21854, -0.951283, -0.873138, -0.744772, -0.157809, 0.380566, 1.36488, 1.65743}}

Finally, note that longest2 doesn't work correctly if there are duplicate points:

longest1[{1., 1., 1., 1., 2., 2., 2.}]
longest2[{1., 1., 1., 1., 2., 2., 2.}]
longestAscendingSubsequence[{1., 1., 1., 1., 2., 2., 2.}]

{1., 2.}

{1., 1., 1., 1., 2., 2., 2.}

{1., 2.}

| improve this answer | |
$\endgroup$
  • $\begingroup$ Cosmetic change to LongestAscendingSequence eliminating code duplication: LongestAscendingSequence@list_ := LongestOrderedSequence[Transpose@{list, Range[If[Developer`PackedArrayQ[list, Real], -1., -1], -Length@list, -1]}][[All, 1]]. $\endgroup$ – jkuczm Aug 16 '17 at 19:30
21
$\begingroup$

  1. There is an undocumented function LongestAscendingSequence

    LongestAscendingSequence[list]

    {1, 3, 4, 6}

    This was mentioned here and here in comments. I hope it will not be treated as a duplicate. I think Q&A-style on SE is more appropriate for this question.

  2. For completeness I ask the second question. It seem to be much simpler but I can't find any simple function. My own answer:

    longest1[list_] := #[[Position[#, Max[#]][[1, 1]] &[Length /@ #]]] &@ Split[list, Less];
longest2[list_] := list[[#2 - # ;; #2 &[Max[#], Position[#, Max[#]][[1, 1]]] &@
    FoldList[(#1 + #2) #2 &, 0, UnitStep@Differences[list]]]];

longest1[list]
longest2[list]

    {1, 3, 5}
{1, 3, 5}

    longest2 is faster for big lists:

    RandomSeed[0];
list = RandomReal[NormalDistribution[], 1000000];

longest1[list] // AbsoluteTiming
longest2[list] // AbsoluteTiming

    {0.925531, {-2.15449, -1.60199, -0.903194, -0.678062, -0.294706, 
   -0.270457, 0.219321, 0.677958, 1.07586}}
{0.228277, {-2.15449, -1.60199, -0.903194, -0.678062, -0.294706, 
   -0.270457, 0.219321, 0.677958, 1.07586}}
| improve this answer | |
$\endgroup$
  • $\begingroup$ I doubt this is "undocumented" in the real sense of the word... it's more likely that it was an oversight in writing the documentation for it. Nevertheless, this is not a duplicate, so thanks for asking&answering to document it! :) $\endgroup$ – rm -rf♦ Oct 18 '13 at 17:26
  • 2
    $\begingroup$ +1. The shortest way previously known to me using built-ins is LongestCommonSequence[list, Sort@list], but LongestAscendingSequence is quite a bit faster. I may add another answer later which uses Compile, if I see that it is competitive with LongestAscendingSequence . $\endgroup$ – Leonid Shifrin Oct 18 '13 at 18:46
  • 2
    $\begingroup$ For the second one I'd use MaxBy[Split[list, Less], Length], utilizing MaxBy, which is part of my "mental toolbox". (Note that MaxBy will only return a single result even if there are several equivalent maximal elements.) $\endgroup$ – Szabolcs Dec 6 '13 at 14:54
  • $\begingroup$ @LeonidShifrin did you find that the compiled approach was uncompetitive, or did you just not have time to try it? This was my first thought as well, and it would be interesting to know whether LongestAscendingSequence is really as fast as it can be, or whether one can do better. $\endgroup$ – Oleksandr R. Dec 7 '13 at 21:09
  • $\begingroup$ @OleksandrR. I just did not have the time. I don't have a C compiler installed on a machine I work with currently most of the time, and the last few months were very busy. Later, I forgot about it. If I don't forget this time, I will test this, and report my findings here - but I can't promise when this happens :) $\endgroup$ – Leonid Shifrin Dec 7 '13 at 22:28
4
$\begingroup$

I suppose it is faster to put everything into one compiled function, but here is a solution using Compile.

cfu = Compile[
  {{ints, _Integer, 1}},
  Block[{prev, next, startSeq, bag},

   startSeq = ints[[1]];
   prev = startSeq;
   bag = Internal`Bag[{1}];
   Do[
    next = ints[[ii]];
    If[
     next < prev,
     Internal`StuffBag[bag, ii];
     ];
    prev = next
    ,
    {ii, 2, Length@ints}
    ];
   Internal`BagPart[bag, All]
   ]
  ,
  CompilationTarget -> "C"
  ]

longestAscendingSeq[list_] :=
 Module[{starts, diffs, maxDiff, maxDiffPos, longestStart},
  starts = cfu[list];
  diffs = Differences@starts;
  maxDiff = Max@diffs;
  maxDiffPos = Position[diffs, maxDiff][[1, 1]];
  longestStart = starts[[maxDiffPos]];
  list[[longestStart ;; longestStart + maxDiff - 1]]
  ]

This gives

longestAscendingSeq[list]

{1,3,5}
| improve this answer | |
$\endgroup$
4
$\begingroup$

Regarding question 2, there's simple algorithm finding longest sub-sequence, of elements with consecutive positions, in single pass over given list.

Function generator returning compiled functions, using this algorithm, can look like this:

compileLongestAscSubseq // ClearAll
compileLongestAscSubseq[
  {type_, rank_Integer /; rank >= 1},
  comparisonFunc : Except@OptionsPattern[] : Less,
  opts : OptionsPattern@Compile
] := Compile[{{list, type, rank}},
  Module[{start, end, bestStart, bestEnd, len, prev, curr},
    len = 0;
    start = end = bestStart = bestEnd = 1;
    prev = Compile`GetElement[list, 1];
    Do[
      curr = Compile`GetElement[list, i];
      If[comparisonFunc[prev, curr],
        end = i;
      (* else *),
        If[len < end - start,
          bestStart = start;
          bestEnd = end;
          len = bestEnd - bestStart;
        ];
        start = end = i
      ];
      prev = curr
      ,
      {i, 2, Length@list}
    ];
    If[len < end - start,
      bestStart = start;
      bestEnd = end
    ];
    Take[list, {bestStart, bestEnd}]
  ],
  opts
]

Let's compile functions taking one-dimensional arrays of integers and reals:

longestAscSubseqI1 = compileLongestAscSubseq[{_Integer, 1}, CompilationTarget -> "C", RuntimeOptions -> "Speed"];
longestAscSubseqR1 = compileLongestAscSubseq[{_Real, 1}, CompilationTarget -> "C", RuntimeOptions -> "Speed"];

Comparison with Jacob Akkerboom's longestAscendingSeq and Carl Woll's longestAscendingSubsequence on list of integers:

SeedRandom@0;
list = RandomInteger[10^6, 10^6];

(result1 = longestAscendingSeq@list) // MaxMemoryUsed // RepeatedTiming
(result2 = longestAscendingSubsequence@list) // MaxMemoryUsed // RepeatedTiming
(result3 = longestAscSubseqI1@list) // MaxMemoryUsed // RepeatedTiming
result1 === result2 === result3
(* {0.041, 16505016} *)
(* {0.051, 25128960} *)
(* {0.0038, 584} *)
(* True *)

longestAscSubseqI1 is over ten times faster and uses almost no additional memory.

Comparison with ybeltukov's longest1 and longest2 and Carl Woll's longestAscendingSubsequence on list of reals:

SeedRandom@0;
list = RandomReal[NormalDistribution[], 10^6];

(result1 = longest1@list) // MaxMemoryUsed // RepeatedTiming
(result2 = longest2@list) // MaxMemoryUsed // RepeatedTiming
(result3 = longestAscendingSubsequence@list) // MaxMemoryUsed // RepeatedTiming
(result4 = longestAscSubseqR1@list) // MaxMemoryUsed // RepeatedTiming
result1 === result2 === result3 === result4
(* {0.467, 79999584} *)
(* {0.12, 48000904} *)
(* {0.056, 25131104} *)
(* {0.0051, 608} *)
(* True *)

longestAscSubseqR1 is over ten times faster than longestAscendingSubsequence and uses almost no additional memory.

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ Very well executed. $\endgroup$ – halirutan♦ Aug 17 '17 at 2:17

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.