Longest increasing subsequence

From Rosetta Code
Task
Longest increasing subsequence
You are encouraged to solve this task according to the task description, using any language you may know.

Calculate and show here a longest increasing subsequence of the list:

And of the list:

Note that a list may have more than one subsequence that is of the maximum length.

Ref
  1. Dynamic Programming #1: Longest Increasing Subsequence on Youtube
  2. An efficient solution can be based on Patience sorting.

AutoHotkey[edit]

Lists := [[3,2,6,4,5,1], [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]]
 
for k, v in Lists {
D := LIS(v)
MsgBox, % D[D.I].seq
}
 
LIS(L) {
D := []
for i, v in L {
D[i, "Length"] := 1, D[i, "Seq"] := v, D[i, "Val"] := v
Loop, % i - 1 {
if(D[A_Index].Val < v && D[A_Index].Length + 1 > D[i].Length) {
D[i].Length := D[A_Index].Length + 1
D[i].Seq := D[A_Index].Seq ", " v
if (D[i].Length > MaxLength)
MaxLength := D[i].Length, D.I := i
}
}
}
return, D
}

Output:

3, 4, 5
0, 4, 6, 9, 13, 15

C[edit]

Using an array that doubles as linked list (more like reversed trees really). O(n) memory and O(n2) runtime.

#include <stdio.h>
#include <stdlib.h>
 
struct node {
int val, len;
struct node *next;
};
 
void lis(int *v, int len)
{
int i;
struct node *p, *n = calloc(len, sizeof *n);
for (i = 0; i < len; i++)
n[i].val = v[i];
 
for (i = len; i--; ) {
// find longest chain that can follow n[i]
for (p = n + i; p++ < n + len; ) {
if (p->val > n[i].val && p->len >= n[i].len) {
n[i].next = p;
n[i].len = p->len + 1;
}
}
}
 
// find longest chain
for (i = 0, p = n; i < len; i++)
if (n[i].len > p->len) p = n + i;
 
do printf(" %d", p->val); while ((p = p->next));
putchar('\n');
 
free(n);
}
 
int main(void)
{
int x[] = { 3, 2, 6, 4, 5, 1 };
int y[] = { 0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15 };
 
lis(x, sizeof(x) / sizeof(int));
lis(y, sizeof(y) / sizeof(int));
return 0;
}
Output:
 3 4 5
 0 4 6 9 13 15

C++[edit]

Patience sorting

#include <iostream>
#include <vector>
#include <tr1/memory>
#include <algorithm>
#include <iterator>
 
template <typename E>
struct Node {
E value;
std::tr1::shared_ptr<Node<E> > pointer;
};
 
template <class E>
struct node_ptr_less {
bool operator()(const std::tr1::shared_ptr<Node<E> > &node1,
const std::tr1::shared_ptr<Node<E> > &node2) const {
return node1->value < node2->value;
}
};
 
 
template <typename E>
std::vector<E> lis(const std::vector<E> &n) {
typedef std::tr1::shared_ptr<Node<E> > NodePtr;
 
std::vector<NodePtr> pileTops;
// sort into piles
for (typename std::vector<E>::const_iterator it = n.begin(); it != n.end(); it++) {
NodePtr node(new Node<E>());
node->value = *it;
typename std::vector<NodePtr>::iterator j =
std::lower_bound(pileTops.begin(), pileTops.end(), node, node_ptr_less<E>());
if (j != pileTops.begin())
node->pointer = *(j-1);
if (j != pileTops.end())
*j = node;
else
pileTops.push_back(node);
}
// extract LIS from piles
std::vector<E> result;
for (NodePtr node = pileTops.back(); node != NULL; node = node->pointer)
result.push_back(node->value);
std::reverse(result.begin(), result.end());
return result;
}
 
int main() {
int arr1[] = {3,2,6,4,5,1};
std::vector<int> vec1(arr1, arr1 + sizeof(arr1)/sizeof(*arr1));
std::vector<int> result1 = lis(vec1);
std::copy(result1.begin(), result1.end(), std::ostream_iterator<int>(std::cout, ", "));
std::cout << std::endl;
 
int arr2[] = {0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15};
std::vector<int> vec2(arr2, arr2 + sizeof(arr2)/sizeof(*arr2));
std::vector<int> result2 = lis(vec2);
std::copy(result2.begin(), result2.end(), std::ostream_iterator<int>(std::cout, ", "));
std::cout << std::endl;
return 0;
}
Output:
2, 4, 5, 
0, 2, 6, 9, 11, 15, 

Clojure[edit]

Implementation using the Patience Sort approach. The elements (newelem) put on a pile combine the "card" with a reference to the top of the previous stack, as per the algorithm. The combination is done using cons, so what gets put on a pile is a list -- a descending subsequence.

(defn place [piles card]
(let [[les gts] (->> piles (split-with #(<= (ffirst %) card)))
newelem (cons card (->> les last first))
modpile (cons newelem (first gts))]
(concat les (cons modpile (rest gts)))))
 
(defn a-longest [cards]
(let [piles (reduce place '() cards)]
(->> piles last first reverse)))
 
(println (a-longest [3 2 6 4 5 1]))
(println (a-longest [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15]))
Output:
(2 4 5)
(0 2 6 9 11 15)

Common Lisp[edit]

Common Lisp: Using the method in the video[edit]

Slower and more memory usage compared to the patience sort method.

(defun longest-increasing-subseq (list)
(let ((subseqs nil))
(dolist (item list)
(let ((longest-so-far (longest-list-in-lists (remove-if-not #'(lambda (l) (> item (car l))) subseqs))))
(push (cons item longest-so-far) subseqs)))
(reverse (longest-list-in-lists subseqs))))
 
(defun longest-list-in-lists (lists)
(let ((longest nil)
(longest-len 0))
(dolist (list lists)
(let ((len (length list)))
(when (> len longest-len)
(setf longest list
longest-len len))))
longest))
 
(dolist (l (list (list 3 2 6 4 5 1)
(list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15)))
(format t "~A~%" (longest-increasing-subseq l))))
Output:
(2 4 5)
(0 2 6 9 11 15)

Common Lisp: Using the Patience Sort approach[edit]

This is 5 times faster and and uses a third of the memory compared to the approach in the video.

(defun lis-patience-sort (input-list)
(let ((piles nil))
(dolist (item input-list)
(setf piles (insert-item item piles)))
(reverse (caar (last piles)))))
 
(defun insert-item (item piles)
(let ((not-found t))
(loop
while not-found
for pile in piles
and prev = nil then pile
and i from 0
do (when (<= item (caar pile))
(setf (elt piles i) (push (cons item (car prev)) (elt piles i))
not-found nil)))
(if not-found
(append piles (list (list (cons item (caar (last piles))))))
piles)))
 
(dolist (l (list (list 3 2 6 4 5 1)
(list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15)))
(format t "~A~%" (lis-patience-sort l)))
Output:
(2 4 5)
(0 2 6 9 11 15)

Common Lisp: Using the Patience Sort approach (alternative)[edit]

This is a different version of the code above.

(defun insert-item (item piles)
(multiple-value-bind
(i prev)
(do* ((prev nil (car x))
(x piles (cdr x))
(i 0 (1+ i)))
((or (null x) (<= item (caaar x))) (values i prev)))
(if (= i (length piles))
(append piles (list (list (cons item (caar (last piles))))))
(progn (push (cons item (car prev)) (elt piles i))
piles))))
 
(defun longest-inc-seq (input)
(do* ((piles nil (insert-item (car x) piles))
(x input (cdr x)))
((null x) (reverse (caar (last piles))))))
 
(dolist (l (list (list 3 2 6 4 5 1)
(list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15)))
(format t "~A~%" (longest-inc-seq l)))
Output:
(2 4 5)
(0 2 6 9 11 15)

D[edit]

Simple Version[edit]

Translation of: Haskell

Uses the second powerSet function from the Power Set Task.

import std.stdio, std.algorithm, power_set2;
 
T[] lis(T)(T[] items) pure nothrow {
//return items.powerSet.filter!isSorted.max!q{ a.length };
return items
.powerSet
.filter!isSorted
.minPos!q{ a.length > b.length }
.front;
}
 
void main() {
[3, 2, 6, 4, 5, 1].lis.writeln;
[0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15].lis.writeln;
}
Output:
[2, 4, 5]
[0, 2, 6, 9, 11, 15]

Patience sorting[edit]

Translation of: Python

From the second Python entry, using the Patience sorting method.

import std.stdio, std.algorithm, std.array;
 
/// Return one of the Longest Increasing Subsequence of
/// items using patience sorting.
T[] lis(T)(in T[] items) pure nothrow
if (__traits(compiles, T.init < T.init))
out(result) {
assert(result.length <= items.length);
assert(result.isSorted);
assert(result.all!(x => items.canFind(x)));
} body {
if (items.empty)
return null;
 
static struct Node { T val; Node* back; }
auto pile = [[new Node(items[0])]];
 
OUTER: foreach (immutable di; items[1 .. $]) {
foreach (immutable j, ref pj; pile)
if (pj[$ - 1].val > di) {
pj ~= new Node(di, j ? pile[j - 1][$ - 1] : null);
continue OUTER;
}
pile ~= [new Node(di, pile[$ - 1][$ - 1])];
}
 
T[] result;
for (auto ptr = pile[$ - 1][$ - 1]; ptr != null; ptr = ptr.back)
result ~= ptr.val;
result.reverse();
return result;
}
 
void main() {
foreach (d; [[3,2,6,4,5,1],
[0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]])
d.lis.writeln;
}

The output is the same.

Faster Version[edit]

Translation of: Java

With some more optimizations.

import std.stdio, std.algorithm, std.range, std.array;
 
T[] lis(T)(in T[] items) pure nothrow
if (__traits(compiles, T.init < T.init))
out(result) {
assert(result.length <= items.length);
assert(result.isSorted);
assert(result.all!(x => items.canFind(x)));
} body {
if (items.empty)
return null;
 
static struct Node {
T value;
Node* pointer;
}
Node*[] pileTops;
auto nodes = minimallyInitializedArray!(Node[])(items.length);
 
// Sort into piles.
foreach (idx, x; items) {
auto node = &nodes[idx];
node.value = x;
immutable i = pileTops.length -
pileTops.assumeSorted!q{a.value < b.value}
.upperBound(node)
.length;
if (i != 0)
node.pointer = pileTops[i - 1];
if (i != pileTops.length)
pileTops[i] = node;
else
pileTops ~= node;
}
 
// Extract LIS from nodes.
size_t count = 0;
for (auto n = pileTops[$ - 1]; n != null; n = n.pointer)
count++;
auto result = minimallyInitializedArray!(T[])(count);
for (auto n = pileTops[$ - 1]; n != null; n = n.pointer)
result[--count] = n.value;
return result;
}
 
void main() {
foreach (d; [[3,2,6,4,5,1],
[0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]])
d.writeln;
}

The output is the same.

Déjà Vu[edit]

Translation of: Python
in-pair:
if = :nil dup:
false drop
else:
@in-pair &> swap &< dup
 
get-last lst:
get-from lst -- len lst
 
lis-sub pile i di:
for j range 0 -- len pile:
local :pj get-from pile j
if > &< get-last pj di:
push-to pj & di if j get-last get-from pile -- j :nil
return
push-to pile [ & di get-last get-last pile ]
 
lis d:
local :pile [ [ & get-from d 0 :nil ] ]
for i range 1 -- len d:
lis-sub pile i get-from d i
[ for in-pair get-last get-last pile ]
 
!. lis [ 3 2 6 4 5 1 ]
!. lis [ 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15 ]
 
Output:
[ 2 4 5 ]
[ 0 2 6 9 11 15 ]

Elixir[edit]

Translation of: Erlang

Naive version[edit]

very slow

defmodule Longest_increasing_subsequence do
# Naive implementation
def lis(l) do
(for ss <- combos(l), ss == Enum.sort(ss), do: ss)
|> Enum.max_by(fn ss -> length(ss) end)
end
 
defp combos(l) do
Enum.reduce(1..length(l), [[]], fn k, acc -> acc ++ (combos(k, l)) end)
end
defp combos(1, l), do: (for x <- l, do: [x])
defp combos(k, l) when k == length(l), do: [l]
defp combos(k, [h|t]) do
(for subcombos <- combos(k-1, t), do: [h | subcombos]) ++ combos(k, t)
end
end
 
IO.inspect Longest_increasing_subsequence.lis([3,2,6,4,5,1])
IO.inspect Longest_increasing_subsequence.lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15])
Output:
[3, 4, 5]
[0, 4, 6, 9, 13, 15]

Patience sort version[edit]

defmodule Longest_increasing_subsequence do
# Patience sort implementation
def patience_lis(l), do: patience_lis(l, [])
 
defp patience_lis([h | t], []), do: patience_lis(t, [[{h,[]}]])
defp patience_lis([h | t], stacks), do: patience_lis(t, place_in_stack(h, stacks, []))
defp patience_lis([], []), do: []
defp patience_lis([], stacks), do: get_previous(stacks) |> recover_lis |> Enum.reverse
 
defp place_in_stack(e, [stack = [{h,_} | _] | tstacks], prevstacks) when h > e do
prevstacks ++ [[{e, get_previous(prevstacks)} | stack] | tstacks]
end
defp place_in_stack(e, [stack | tstacks], prevstacks) do
place_in_stack(e, tstacks, prevstacks ++ [stack])
end
defp place_in_stack(e, [], prevstacks) do
prevstacks ++ [[{e, get_previous(prevstacks)}]]
end
 
defp get_previous(stack = [_|_]), do: hd(List.last(stack))
defp get_previous([]), do: []
 
defp recover_lis({e, prev}), do: [e | recover_lis(prev)]
defp recover_lis([]), do: []
end
 
IO.inspect Longest_increasing_subsequence.patience_lis([3,2,6,4,5,1])
IO.inspect Longest_increasing_subsequence.patience_lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15])
Output:
[2, 4, 5]
[0, 2, 6, 9, 11, 15]

Erlang[edit]

Both implementations:

- Naive version
Translation of: Haskell

- Patience sort version.

Function combos is copied from panduwana blog.

Function maxBy is copied from Hynek -Pichi- Vychodil's answer.

 
-module(longest_increasing_subsequence).
 
-export([test_naive/0, test_patience/0]).
 
% **************************************************
% Interface to test the implementation
% **************************************************
 
test_naive() ->
test_gen(fun lis/1).
 
test_patience() ->
test_gen(fun patience_lis/1).
 
test_gen(F) ->
show_result(F([3,2,6,4,5,1])),
show_result(F([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15])).
 
show_result(Res) ->
io:format("~w\n", [Res]).
 
% **************************************************
 
% **************************************************
% Naive implementation
% **************************************************
 
lis(L) ->
maxBy(
fun(SS) -> length(SS) end,
[ lists:usort(SS)
||  SS <- combos(L),
SS == lists:sort(SS)]
).
 
% **************************************************
 
% **************************************************
% Patience sort implementation
% **************************************************
 
patience_lis(L) ->
patience_lis(L, []).
 
patience_lis([H | T], Stacks) ->
NStacks =
case Stacks of
[] ->
[[{H,[]}]];
_ ->
place_in_stack(H, Stacks, [])
end,
patience_lis(T, NStacks);
patience_lis([], Stacks) ->
case Stacks of
[] ->
[];
[_|_] ->
lists:reverse( recover_lis( get_previous(Stacks) ) )
end.
 
place_in_stack(E, [Stack = [{H,_} | _] | TStacks], PrevStacks) when H > E ->
PrevStacks ++ [[{E, get_previous(PrevStacks)} | Stack] | TStacks];
place_in_stack(E, [Stack = [{H,_} | _] | TStacks], PrevStacks) when H =< E ->
place_in_stack(E, TStacks, PrevStacks ++ [Stack]);
place_in_stack(E, [], PrevStacks)->
PrevStacks ++ [[{E, get_previous(PrevStacks)}]].
 
get_previous(Stack = [_|_]) ->
hd(lists:last(Stack));
get_previous([]) ->
[].
 
recover_lis({E,Prev}) ->
[E|recover_lis(Prev)];
recover_lis([]) ->
[].
 
% **************************************************
 
% **************************************************
% Copied from http://stackoverflow.com/a/4762387/4162959
% **************************************************
 
maxBy(F, L) ->
element(
2,
lists:max([ {F(X), X} || X <- L])
).
 
% **************************************************
 
% **************************************************
% Copied from https://panduwana.wordpress.com/2010/04/21/combination-in-erlang/
% **************************************************
 
combos(L) ->
lists:foldl(
fun(K, Acc) -> Acc++(combos(K, L)) end,
[[]],
lists:seq(1, length(L))
).
 
combos(1, L) ->
[[X] || X <- L];
combos(K, L) when K == length(L) ->
[L];
combos(K, [H|T]) ->
[[H | Subcombos]
|| Subcombos <- combos(K-1, T)]
++ (combos(K, T)).
 
% **************************************************
 

Output naive:

[3,4,5]
[0,4,6,9,13,15]

Output patience:

[2,4,5]
[0,2,6,9,11,15]

Go[edit]

Patience sorting

package main
 
import (
"fmt"
"sort"
)
 
type Node struct {
val int
back *Node
}
 
func lis (n []int) (result []int) {
var pileTops []*Node
// sort into piles
for _, x := range n {
j := sort.Search(len(pileTops), func (i int) bool { return pileTops[i].val >= x })
node := &Node{ x, nil }
if j != 0 { node.back = pileTops[j-1] }
if j != len(pileTops) {
pileTops[j] = node
} else {
pileTops = append(pileTops, node)
}
}
 
if len(pileTops) == 0 { return []int{} }
for node := pileTops[len(pileTops)-1]; node != nil; node = node.back {
result = append(result, node.val)
}
// reverse
for i := 0; i < len(result)/2; i++ {
result[i], result[len(result)-i-1] = result[len(result)-i-1], result[i]
}
return
}
 
func main() {
for _, d := range [][]int{{3, 2, 6, 4, 5, 1},
{0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15}} {
fmt.Printf("an L.I.S. of %v is %v\n", d, lis(d))
}
}
Output:
an L.I.S. of [3 2 6 4 5 1] is [2 4 5]
an L.I.S. of [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15] is [0 2 6 9 11 15]

Haskell[edit]

Naive implementation[edit]

import Data.Ord          ( comparing )
import Data.List ( maximumBy, subsequences )
import Data.List.Ordered ( isSorted, nub )
 
lis :: Ord a => [a] -> [a]
lis = maximumBy (comparing length) . map nub . filter isSorted . subsequences
-- longest <-- unique <-- increasing <-- all
 
main = do
print $ lis [3,2,6,4,5,1]
print $ lis [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
print $ lis [1,1,1,1]
Output:
[2,4,5]
[0,2,6,9,11,15]
[1]

Patience sorting[edit]

{-# LANGUAGE FlexibleContexts, UnicodeSyntax #-}
 
module Main (main, lis) where
 
import Control.Monad.ST ( ST, runST )
import Control.Monad ( (>>=), (=<<), foldM )
import Data.Array.ST ( Ix, STArray, readArray, writeArray, newArray )
import Data.Array.MArray ( MArray )
 
infix 4
 
() :: Eq α ⇒ α → α → Bool
() = (==)
 
() = (.)
 
 
lis ∷ Ord α ⇒ [α][α]
lis xs = runST $ do
let lxs = length xs
pileTops ← newSTArray (min 1 lxs , lxs) []
i ← foldM (stack pileTops) 0 xs
readArray pileTops i >>= returnreverse
 
stack ∷ (Integral ι, Ord ε, Ix ι, MArray α [ε] μ)
⇒ α ι [ε] → ι → ε → μ ι
stack piles i x = do
j ← bsearch piles x i
writeArray piles j ∘ (x:) =<< if j ≡ 1 then return []
else readArray piles (j-1)
return $ if j ≡ i+1 then i+1 else i
 
bsearch ∷ (Integral ι, Ord ε, Ix ι, MArray α [ε] μ)
⇒ α ι [ε] → ε → ι → μ ι
bsearch piles x = go 1
where go lo hi | lo > hi = return lo
| otherwise =
do (y:_) ← readArray piles mid
if y < x then go (succ mid) hi
else go lo (pred mid)
 
where mid = (lo + hi) `div` 2
 
newSTArray ∷ Ix ι ⇒ (ι,ι) → ε → ST σ (STArray σ ι ε)
newSTArray = newArray
 
 
main ∷ IO ()
main = do
print $ lis [3, 2, 6, 4, 5, 1]
print $ lis [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]
print $ lis [1, 1, 1, 1]
Output:
[2,4,5]
[0,2,6,9,11,15]
[1]

Icon and Unicon[edit]

The following works in both languages:

procedure main(A)
every writes((!lis(A)||" ") | "\n")
end
 
procedure lis(A)
r := [A[1]] | fail
every (put(pt := [], [v := !A]), p := !pt) do
if put(p, p[-1] < v) then r := (*p > *r, p)
else p[-1] := (p[-2] < v)
return r
end

Sample runs:

->lis 3 2 6 4 5 1
 3 4 5
->lis 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15
 0 4 6 9 11 15
->

J[edit]

These examples are simple enough for brute force to be reasonable:

increasing=: (-: /:~)@#~"1 #:@i.@^~&2@#
longestinc=: ] #~ [: (#~ ([: (= >./) +/"1)) #:@I.@increasing

In other words: consider all 2^n bitmasks of length n, and select those which strictly select increasing sequences. Find the length of the longest of these and use the masks of that length to select from the original sequence.

Example use:

 
longestinc 3,2,6,4,5,1
2 4 5
3 4 5
longestinc 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15
0 2 6 9 11 15
0 2 6 9 13 15
0 4 6 9 11 15
0 4 6 9 13 15

Java[edit]

A solution based on patience sorting, except that it is not necessary to keep the whole pile, only the top (in solitaire, bottom) of the pile, along with pointers from each "card" to the top of its "previous" pile.

import java.util.*;
 
public class LIS {
public static <E extends Comparable<? super E>> List<E> lis(List<E> n) {
List<Node<E>> pileTops = new ArrayList<Node<E>>();
// sort into piles
for (E x : n) {
Node<E> node = new Node<E>();
node.value = x;
int i = Collections.binarySearch(pileTops, node);
if (i < 0) i = ~i;
if (i != 0)
node.pointer = pileTops.get(i-1);
if (i != pileTops.size())
pileTops.set(i, node);
else
pileTops.add(node);
}
// extract LIS from nodes
List<E> result = new ArrayList<E>();
for (Node<E> node = pileTops.size() == 0 ? null : pileTops.get(pileTops.size()-1);
node != null; node = node.pointer)
result.add(node.value);
Collections.reverse(result);
return result;
}
 
private static class Node<E extends Comparable<? super E>> implements Comparable<Node<E>> {
public E value;
public Node<E> pointer;
public int compareTo(Node<E> y) { return value.compareTo(y.value); }
}
 
public static void main(String[] args) {
List<Integer> d = Arrays.asList(3,2,6,4,5,1);
System.out.printf("an L.I.S. of %s is %s\n", d, lis(d));
d = Arrays.asList(0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15);
System.out.printf("an L.I.S. of %s is %s\n", d, lis(d));
}
}
Output:
an L.I.S. of [3, 2, 6, 4, 5, 1] is [2, 4, 5]
an L.I.S. of [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15] is [0, 2, 6, 9, 11, 15]

JavaScript[edit]

 
 
var _ = require('underscore');
function findIndex(input){
var len = input.length;
var maxSeqEndingHere = _.range(len).map(function(){return 1;});
for(var i=0; i<len; i++)
for(var j=i-1;j>=0;j--)
if(input[i] > input[j] && maxSeqEndingHere[j] >= maxSeqEndingHere[i])
maxSeqEndingHere[i] = maxSeqEndingHere[j]+1;
return maxSeqEndingHere;
}
 
function findSequence(input, result){
var maxValue = Math.max.apply(null, result);
var maxIndex = result.indexOf(Math.max.apply(Math, result));
var output = [];
output.push(input[maxIndex]);
for(var i = maxIndex ; i >= 0; i--){
if(maxValue==0)break;
if(input[maxIndex] > input[i] && result[i] == maxValue-1){
output.push(input[i]);
maxValue--;
}
}
output.reverse();
return output;
}
 
 
var x = [0, 7, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15];
var y = [3, 2, 6, 4, 5, 1];
 
var result = findIndex(x);
var final = findSequence(x, result);
console.log(final);
 
var result1 = findIndex(y);
var final1 = findSequence(y, result1);
console.log(final1);
 
Output:
[ 0, 2, 6, 9, 11, 15 ]
[ 2, 4, 5 ]

jq[edit]

Works with: jq version 1.4

Use the patience sorting method to find a longest (strictly) increasing subsequence.

Generic functions:

Recent versions of jq have functions that obviate the need for the two generic functions defined in this subsection.

def until(cond; update):
def _until:
if cond then . else (update | _until) end;
try _until catch if .== "break" then empty else . end;
 
# binary search for insertion point
def bsearch(target):
. as $in
| [0, length-1] # [low, high]
| until(.[0] > .[1];
.[0] as $low | .[1] as $high
| ($low + ($high - $low) / 2 | floor) as $mid
| if $in[$mid] >= target
then .[1] = $mid - 1
else .[0] = $mid + 1
end )
| .[0];

lis:

def lis:
 
# Helper function:
# given a stream, produce an array of the items in reverse order:
def reverse(stream): reduce stream as $i ([]; [$i] + .);
 
# put the items into increasing piles using the structure:
# NODE = {"val": value, "back": NODE}
reduce .[] as $x
( []; # array of NODE
# binary search for the appropriate pile
(map(.val) | bsearch($x)) as $i
| setpath([$i];
{"val": $x,
"back": (if $i > 0 then .[$i-1] else null end) })
)
| .[length - 1]
| reverse( recurse(.back) | .val ) ;

Examples:

( [3,2,6,4,5,1],
[0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
) | lis
Output:
$ jq -c -n -f lis.jq
[2,4,5]
[0,2,6,9,11,15]
 

Lua[edit]

function buildLIS(seq)
local piles = { { {table.remove(seq, 1), nil} } }
while #seq>0 do
local x=table.remove(seq, 1)
for j=1,#piles do
if piles[j][#piles[j]][1]>x then
table.insert(piles[j], {x, (piles[j-1] and #piles[j-1])})
break
elseif j==#piles then
table.insert(piles, {{x, #piles[j]}})
end
end
end
local t={}
table.insert(t, piles[#piles][1][1])
local p=piles[#piles][1][2]
for i=#piles-1,1,-1 do
table.insert(t, piles[i][p][1])
p=piles[i][p][2]
end
table.sort(t)
print(unpack(t))
end
 
buildLIS({3,2,6,4,5,1})
buildLIS({0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15})
 
Output:
2   4   5
0   2   6   9   11  15

Mathematica[edit]

Although undocumented, Mathematica has the function LongestAscendingSequence which exactly does what the Task asks for:

LongestAscendingSequence/@{{3,2,6,4,5,1},{0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}}
Output:
{{2,4,5},{0,2,6,9,11,15}}

Nirod[edit]

Translation of: Python
proc longestIncreasingSubsequence[T](d: seq[T]): seq[T] =
var l = newSeq[seq[T]]()
for i in 0 .. <d.len:
var x = newSeq[T]()
for j in 0 .. <i:
if l[j][l[j].high] < d[i] and l[j].len > x.len:
x = l[j]
l.add x & @[d[i]]
result = @[]
for x in l:
if x.len > result.len:
result = x
 
for d in [@[3,2,6,4,5,1], @[0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]]:
echo "a L.I.S. of ", d, " is ", longestIncreasingSubsequence(d)
Output:
a L.I.S. of @[3, 2, 6, 4, 5, 1] is @[3, 4, 5]
a L.I.S. of @[0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15] is @[0, 4, 6, 9, 13, 15]

Objective-C[edit]

Patience sorting

#import <Foundation/Foundation.h>
 
@interface Node : NSObject {
@public
id val;
Node *back;
}
@end
 
@implementation Node
@end
 
@interface NSArray (LIS)
- (NSArray *)longestIncreasingSubsequenceWithComparator:(NSComparator)comparator;
@end
 
@implementation NSArray (LIS)
- (NSArray *)longestIncreasingSubsequenceWithComparator:(NSComparator)comparator {
NSMutableArray *pileTops = [[NSMutableArray alloc] init];
// sort into piles
for (id x in self) {
Node *node = [[Node alloc] init];
node->val = x;
int i = [pileTops indexOfObject:node
inSortedRange:NSMakeRange(0, [pileTops count])
options:NSBinarySearchingInsertionIndex|NSBinarySearchingFirstEqual
usingComparator:^NSComparisonResult(Node *node1, Node *node2) {
return comparator(node1->val, node2->val);
}];
if (i != 0)
node->back = pileTops[i-1];
pileTops[i] = node;
}
 
// follow pointers from last node
NSMutableArray *result = [[NSMutableArray alloc] init];
for (Node *node = [pileTops lastObject]; node; node = node->back)
[result addObject:node->val];
return [[result reverseObjectEnumerator] allObjects];
}
@end
 
int main(int argc, const char *argv[]) {
@autoreleasepool {
for (NSArray *d in @[@[@3, @2, @6, @4, @5, @1],
@[@0, @8, @4, @12, @2, @10, @6, @14, @1, @9, @5, @13, @3, @11, @7, @15]])
NSLog(@"an L.I.S. of %@ is %@", d,
[d longestIncreasingSubsequenceWithComparator:^NSComparisonResult(id obj1, id obj2) {
return [obj1 compare:obj2];
}]);
}
return 0;
}
Output:
an L.I.S. of (
    3,
    2,
    6,
    4,
    5,
    1
) is (
    2,
    4,
    5
)
an L.I.S. of (
    0,
    8,
    4,
    12,
    2,
    10,
    6,
    14,
    1,
    9,
    5,
    13,
    3,
    11,
    7,
    15
) is (
    0,
    2,
    6,
    9,
    11,
    15
)

OCaml[edit]

Naïve implementation[edit]

let longest l = List.fold_left (fun acc x -> if List.length acc < List.length x
then x
else acc) [] l
 
let subsequences d l =
let rec check_subsequences acc = function
| x::s -> check_subsequences (if (List.hd (List.rev x)) < d
then x::acc
else acc) s
| [] -> acc
in check_subsequences [] l
 
let lis d =
let rec lis' l = function
| x::s -> lis' ((longest (subsequences x l)@[x])::l) s
| [] -> longest l
in lis' [] d
 
let _ =
let sequences = [[3; 2; 6; 4; 5; 1]; [0; 8; 4; 12; 2; 10; 6; 14; 1; 9; 5; 13; 3; 11; 7; 15]]
in
List.map (fun x -> print_endline (String.concat " " (List.map string_of_int
(lis x)))) sequences
Output:
3 4 5
0 4 6 9 13 15

Patience sorting[edit]

let lis cmp list =
let pile_tops = Array.make (List.length list) [] in
let bsearch_piles x len =
let rec aux lo hi =
if lo > hi then
lo
else
let mid = (lo + hi) / 2 in
if cmp (List.hd pile_tops.(mid)) x < 0 then
aux (mid+1) hi
else
aux lo (mid-1)
in
aux 0 (len-1)
in
let f len x =
let i = bsearch_piles x len in
pile_tops.(i) <- x :: if i = 0 then [] else pile_tops.(i-1);
if i = len then len+1 else len
in
let len = List.fold_left f 0 list in
List.rev pile_tops.(len-1)

Usage:

# lis compare [3; 2; 6; 4; 5; 1];;
- : int list = [2; 4; 5]
# lis compare [0; 8; 4; 12; 2; 10; 6; 14; 1; 9; 5; 13; 3; 11; 7; 15];;
- : int list = [0; 2; 6; 9; 11; 15]

Perl[edit]

Dynamic programming[edit]

Translation of: Perl 6
sub lis {
my @l = map [], 1 .. @_;
push @{$l[0]}, +$_[0];
for my $i (1 .. @_-1) {
for my $j (0 .. $i - 1) {
if ($_[$j] < $_[$i] and @{$l[$i]} < @{$l[$j]} + 1) {
$l[$i] = [ @{$l[$j]} ];
}
}
push @{$l[$i]}, $_[$i];
}
my ($max, $l) = 0, [];
for (@l) {
($max, $l) = (scalar(@$_), $_) if @$_ > $max;
}
return @$l;
}
 
print join ' ', lis 3, 2, 6, 4, 5, 1;
print join ' ', lis 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15;
 
Output:
2 4 5
0 2 6 9 11 15

Patience sorting[edit]

sub lis {
my @pileTops;
# sort into piles
foreach my $x (@_) {
# binary search
my $low = 0, $high = $#pileTops;
while ($low <= $high) {
my $mid = int(($low + $high) / 2);
if ($pileTops[$mid]{val} >= $x) {
$high = $mid - 1;
} else {
$low = $mid + 1;
}
}
my $i = $low;
my $node = {val => $x};
$node->{back} = $pileTops[$i-1] if $i != 0;
$pileTops[$i] = $node;
}
my @result;
for (my $node = $pileTops[-1]; $node; $node = $node->{back}) {
push @result, $node->{val};
}
 
return reverse @result;
}
 
foreach my $r ([3, 2, 6, 4, 5, 1],
[0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]) {
my @d = @$r;
my @lis = lis(@d);
print "an L.I.S. of [@d] is [@lis]\n";
 
}
Output:
an L.I.S. of [3 2 6 4 5 1] is [2 4 5]
an L.I.S. of [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15] is [0 2 6 9 11 15]

Perl 6[edit]

Works with: rakudo version 2015-09-17

Dynamic programming[edit]

Straight-forward implementation of the algorithm described in the video.

sub lis(@d) {
my @l = [].item xx @d;
@l[0].push: @d[0];
for 1 ..^ @d -> $i {
for ^$i -> $j {
if @d[$j] < @d[$i] && @l[$i] < @l[$j] + 1 {
@l[$i] = [ @l[$j][] ]
}
}
@l[$i].push: @d[$i];
}
return max :by(*.elems), @l;
}
 
say lis([3,2,6,4,5,1]);
say lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]);
Output:
[2 4 5]
[0 2 6 9 11 15]

Patience sorting[edit]

sub lis(@deck is copy) {
my @S = [@deck.shift() => Nil].item;
for @deck -> $card {
with first { @S[$_][*-1].key > $card }, ^@S -> $i {
@S[$i].push: $card => @S[$i-1][*-1] // Nil
} else {
@S.push: [ $card => @S[*-1][*-1] // Nil ].item
}
}
reverse map *.key, (
@S[*-1][*-1], *.value ...^ !*.defined
)
}
 
say lis <3 2 6 4 5 1>;
say lis <0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15>;
Output:
[2 4 5]
[0 2 6 9 11 15]

PHP[edit]

Patience sorting

<?php
class Node {
public $val;
public $back = NULL;
}
 
function lis($n) {
$pileTops = array();
// sort into piles
foreach ($n as $x) {
// binary search
$low = 0; $high = count($pileTops)-1;
while ($low <= $high) {
$mid = (int)(($low + $high) / 2);
if ($pileTops[$mid]->val >= $x)
$high = $mid - 1;
else
$low = $mid + 1;
}
$i = $low;
$node = new Node();
$node->val = $x;
if ($i != 0)
$node->back = $pileTops[$i-1];
$pileTops[$i] = $node;
}
$result = array();
for ($node = count($pileTops) ? $pileTops[count($pileTops)-1] : NULL;
$node != NULL; $node = $node->back)
$result[] = $node->val;
 
return array_reverse($result);
}
 
print_r(lis(array(3, 2, 6, 4, 5, 1)));
print_r(lis(array(0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15)));
?>
Output:
Array
(
    [0] => 2
    [1] => 4
    [2] => 5
)
Array
(
    [0] => 0
    [1] => 2
    [2] => 6
    [3] => 9
    [4] => 11
    [5] => 15
)

PicoLisp[edit]

Adapted patience sorting approach:

(de longinc (Lst)
(let (D NIL R NIL)
(for I Lst
(cond
((< I (last D))
(for (Y . X) D
(T (> X I) (set (nth D Y) I)) ) )
((< I (car R))
(set R I)
(when D (set (cdr R) (last D))) )
(T (when R (queue 'D (car R)))
(push 'R I) ) ) )
(flip R) ) )

Original recursive glutton:

(de glutton (L)
(let N (pop 'L)
(maxi length
(recur (N L)
(ifn L
(list (list N))
(mapcan
'((R)
(if (> (car R) N)
(list (cons N R) R)
(list (list N) R) ) )
(recurse (car L) (cdr L)) ) ) ) ) ) )
 
(test (2 4 5)
(glutton (3 2 6 4 5 1)))
 
(test (2 6 9 11 15)
(glutton (8 4 12 2 10 6 14 1 9 5 13 3 11 7 15)))
 
(test (-31 0 83 782)
(glutton (4 65 2 -31 0 99 83 782 1)) )

PowerShell[edit]

Works with: PowerShell version 2
function Get-LongestSubsequence ( [int[]]$A )
{
If ( $A.Count -lt 2 ) { return $A }
 
# Start with an "empty" pile
# (We will only store the top value in each "pile".)
$Pile = @( [int]::MaxValue )
$Last = 0
 
# Hashtable to hold the back pointers
$BP = @{}
 
# For each number in the orginal sequence...
ForEach ( $N in $A )
{
# Find the first pile with a value greater than N
$i = 0..$Last | Where { $N -lt $Pile[$_] } | Select -First 1
 
# Place N on the pile
$Pile[$i] = $N
 
# Set the back pointer for this value to the value of the previous pile
$BP["$N"] = $Pile[$i-1]
 
# If this is the previously empty pile, add a new empty pile
If ( $i -eq $Last )
{
$Pile += @( [int]::MaxValue )
$Last++
}
}
 
# Ignore the empty pile
$Last--
 
# Start with the value of the last pile
$N = $Pile[$Last]
$S = @( $N )
 
# Add the remainder of the values by walking through the back pointers
ForEach ( $i in $Last..1 )
{
$S += ( $N = $BP["$N"] )
}
 
# Return the series (reversed into the correct order)
return $S[$Last..0]
}
( Get-LongestSubsequence 3, 2, 6, 4, 5, 1 ) -join ', '
( Get-LongestSubsequence 0, 8, 4, 12, 2, 10, 6, 16, 14, 1, 9, 5, 13, 3, 11, 7, 15 ) -join ', '
Output:
2, 4, 5
0, 2, 6, 9, 11, 15

Prolog[edit]

Works with SWI-Prolog version 6.4.1
Naïve implementation.


lis(In, Out) :-
% we ask Prolog to find the longest sequence
aggregate(max(N,Is), (one_is(In, [], Is), length(Is, N)), max(_, Res)),
reverse(Res, Out).
 
 
% we describe the way to find increasing subsequence
one_is([], Current, Current).
 
 
one_is([H | T], Current, Final) :-
( Current = [], one_is(T, [H], Final));
( Current = [H1 | _], H1 < H, one_is(T, [H | Current], Final));
one_is(T, Current, Final).
 

Prolog finds the first longest subsequence

 ?- lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15], Out).
Out = [0,4,6,9,13,15].

 ?- lis([3,2,6,4,5,1], Out).
Out = [3,4,5].

Python[edit]

Python: O(nlogn) Method from Wikipedia's LIS Article[1][edit]

def longest_increasing_subsequence(X):
"""Returns the Longest Increasing Subsequence in the Given List/Array"""
N = len(X)
P = [0] * N
M = [0] * (N+1)
L = 0
for i in range(N):
lo = 1
hi = L
while lo <= hi:
mid = (lo+hi)//2
if (X[M[mid]] < X[i]):
lo = mid+1
else:
hi = mid-1
 
newL = lo
P[i] = M[newL-1]
M[newL] = i
 
if (newL > L):
L = newL
 
S = []
k = M[L]
for i in range(L-1, -1, -1):
S.append(X[k])
k = P[k]
return S[::-1]
 
if __name__ == '__main__':
for d in [[3,2,6,4,5,1], [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]]:
print('a L.I.S. of %s is %s' % (d, longest_increasing_subsequence(d)))
Output:
a L.I.S. of [3, 2, 6, 4, 5, 1] is [2, 4, 5]
a L.I.S. of [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15] is [0, 2, 6, 9, 11, 15]

Python: Method from video[edit]

def longest_increasing_subsequence(d):
'Return one of the L.I.S. of list d'
l = []
for i in range(len(d)):
l.append(max([l[j] for j in range(i) if l[j][-1] < d[i]] or [[]], key=len)
+ [d[i]])
return max(l, key=len)
 
if __name__ == '__main__':
for d in [[3,2,6,4,5,1], [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]]:
print('a L.I.S. of %s is %s' % (d, longest_increasing_subsequence(d)))
Output:
a L.I.S. of [3, 2, 6, 4, 5, 1] is [3, 4, 5]
a L.I.S. of [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15] is [0, 4, 6, 9, 13, 15]

Python: Patience sorting method[edit]

from collections import namedtuple
from functools import total_ordering
from bisect import bisect_left
 
@total_ordering
class Node(namedtuple('Node_', 'val back')):
def __iter__(self):
while self is not None:
yield self.val
self = self.back
def __lt__(self, other):
return self.val < other.val
def __eq__(self, other):
return self.val == other.val
 
def lis(d):
"""Return one of the L.I.S. of list d using patience sorting."""
if not d:
return []
pileTops = []
for di in d:
j = bisect_left(pileTops, Node(di, None))
new_node = Node(di, pileTops[j-1] if j > 0 else None)
if j == len(pileTops):
pileTops.append(new_node)
else:
pileTops[j] = new_node
 
return list(pileTops[-1])[::-1]
 
if __name__ == '__main__':
for d in [[3,2,6,4,5,1],
[0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]]:
print('a L.I.S. of %s is %s' % (d, lis(d)))
Output:
a L.I.S. of [3, 2, 6, 4, 5, 1] is [2, 4, 5]
a L.I.S. of [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15] is [0, 2, 6, 9, 11, 15]

Racket[edit]

Patience sorting. The program saves only the top card of each pile, with a link (cons) to the top of the previous pile at the time it was inserted. It uses binary search to find the correct pile.

#lang racket/base
(require data/gvector)
 
(define (gvector-last gv)
(gvector-ref gv (sub1 (gvector-count gv))))
 
(define (lis-patience-sort input-list)
(let ([piles (gvector)])
(for ([item (in-list input-list)])
(insert-item! piles item))
(reverse (gvector-last piles))))
 
(define (insert-item! piles item)
(if (zero? (gvector-count piles))
(gvector-add! piles (cons item '()))
(cond
[(not (<= item (car (gvector-last piles))))
(gvector-add! piles (cons item (gvector-last piles)))]
[(<= item (car (gvector-ref piles 0)))
(gvector-set! piles 0 (cons item '()))]
[else (let loop ([first 1] [last (sub1 (gvector-count piles))])
(if (= first last)
(gvector-set! piles first (cons item (gvector-ref piles (sub1 first))))
(let ([middle (quotient (+ first last) 2)])
(if (<= item (car (gvector-ref piles middle)))
(loop first middle)
(loop (add1 middle) last)))))])))
Output:
'(2 4 5)
'(0 2 6 9 11 15)

Ruby[edit]

Patience sorting

Node = Struct.new(:val, :back)
 
def lis(n)
pileTops = []
# sort into piles
for x in n
# binary search
low, high = 0, pileTops.size-1
while low <= high
mid = low + (high - low) / 2
if pileTops[mid].val >= x
high = mid - 1
else
low = mid + 1
end
end
i = low
node = Node.new(x)
node.back = pileTops[i-1] if i > 0
pileTops[i] = node
end
 
result = []
node = pileTops.last
while node
result.unshift(node.val)
node = node.back
end
result
end
 
p lis([3, 2, 6, 4, 5, 1])
p lis([0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15])
Output:
[2, 4, 5]
[0, 2, 6, 9, 11, 15]

Scala[edit]

object LongestIncreasingSubsequence extends App {
def longest(l: Array[Int]) = l match {
case _ if l.length < 2 => Array(l)
case l =>
def increasing(done: Array[Int], remaining: Array[Int]): Array[Array[Int]] = remaining match {
case Array() => Array(done)
case Array(head, _*) =>
(if (head > done.last) increasing(done :+ head, remaining.tail) else Array()) ++
increasing(done, remaining.tail) // all increasing combinations
}
val all = (1 to l.length).flatMap(i => increasing(l take i takeRight 1, l.drop(i+1))).sortBy(-_.length)
all.takeWhile(_.length == all.head.length).toArray // longest from all increasing combinations
}
 
val tests = Map(
"3,2,6,4,5,1" -> Array("2,4,5", "3,4,5"),
"0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15" -> Array("0,2,6,9,11,15", "0,2,6,9,13,15", "0,4,6,9,13,15", "0,4,6,9,11,15")
)
def asInts(s: String): Array[Int] = s split "," map Integer.parseInt
assert(tests forall {case (given, expect) =>
val lis = longest(asInts(given))
println(s"$given has ${lis.size} longest increasing subsequences, e.g. "+lis.last.mkString(","))
expect contains lis.last.mkString(",")
})
}
Output:
3,2,6,4,5,1 has 2 longest increasing subsequences, e.g. 2,4,5
0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 has 4 longest increasing subsequences, e.g. 0,2,6,9,11,15

Brute force solution :

 
def powerset[A](s: List[A]) = (0 to s.size).map(s.combinations(_)).reduce(_++_)
def isSorted(l:List[Int])(f: (Int, Int) => Boolean) = l.view.zip(l.tail).forall(x => f(x._1,x._2))
def sequence(set: List[Int])(f: (Int, Int) => Boolean) = powerset(set).filter(_.nonEmpty).filter(x => isSorted(x)(f)).toList.maxBy(_.length)
 
sequence(set)(_<_)
sequence(set)(_>_)

Scheme[edit]

Patience sorting

(define (lis less? lst)
(define pile-tops (make-vector (length lst)))
(define (bsearch-piles x len)
(let aux ((lo 0)
(hi (- len 1)))
(if (> lo hi)
lo
(let ((mid (quotient (+ lo hi) 2)))
(if (less? (car (vector-ref pile-tops mid)) x)
(aux (+ mid 1) hi)
(aux lo (- mid 1)))))))
(let aux ((len 0)
(lst lst))
(if (null? lst)
(reverse (vector-ref pile-tops (- len 1)))
(let* ((x (car lst))
(i (bsearch-piles x len)))
(vector-set! pile-tops i (cons x (if (= i 0)
'()
(vector-ref pile-tops (- i 1)))))
(aux (if (= i len) (+ len 1) len) (cdr lst))))))
 
(display (lis < '(3 2 6 4 5 1))) (newline)
(display (lis < '(0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))) (newline)
Output:
(2 4 5)
(0 2 6 9 11 15)

Sidef[edit]

Dynamic programming:

func lis(a) {
var l = a.len.of { [] }
l[0] << a[0]
for i in (1..a.end) {
for j in ^i {
if ((a[j] < a[i]) && (l[i].len < l[j].len+1)) {
l[i] = [l[j]...]
}
}
l[i] << a[i]
}
l.max_by { .len }
}
 
say lis(%i<3 2 6 4 5 1>)
say lis(%i<0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15>)

Patience sorting:

func lis(deck) {
var pileTops = []
deck.each { |x|
var low = 0;
var high = pileTops.end
while (low <= high) {
var mid = ((low + high) // 2)
if (pileTops[mid]{:val} >= x) {
high = mid-1
} else {
low = mid+1
}
}
var i = low
var node = Hash(val => x)
node{:back} = pileTops[i-1] if (i != 0)
pileTops[i] = node
}
var result = []
for (var node = pileTops[-1]; node; node = node{:back}) {
result << node{:val}
}
result.reverse
}
 
say lis(%i<3 2 6 4 5 1>)
say lis(%i<0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15>)
Output:
[2, 4, 5]
[0, 2, 6, 9, 11, 15]

Standard ML[edit]

Patience sorting

Works with: SML/NJ
fun lis cmp n =
let
val pile_tops = DynamicArray.array (length n, [])
fun bsearch_piles x =
let
fun aux (lo, hi) =
if lo > hi then
lo
else
let
val mid = (lo + hi) div 2
in
if cmp (hd (DynamicArray.sub (pile_tops, mid)), x) = LESS then
aux (mid+1, hi)
else
aux (lo, mid-1)
end
in
aux (0, DynamicArray.bound pile_tops)
end
fun f x =
let
val i = bsearch_piles x
in
DynamicArray.update (pile_tops, i,
x :: (if i = 0 then [] else DynamicArray.sub (pile_tops, i-1)))
end
in
app f n;
rev (DynamicArray.sub (pile_tops, DynamicArray.bound pile_tops))
end

Usage:

- lis Int.compare [3, 2, 6, 4, 5, 1];
val it = [2,4,5] : int list
- lis Int.compare [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15];
val it = [0,2,6,9,11,15] : int list

Swym[edit]

Translation of: Python

Based on the Python video solution. Interpreter at [[2]]

Array.'lis'
{
'stems' = Number.Array.mutableArray[ [] ]
 
forEach(this) 'value'->
{
'bestStem' = stems.where{==[] || .last < value}.max{.length}
 
stems.push( bestStem + [value] )
}
 
return stems.max{.length}
}
 
[3,2,6,4,5,1].lis.trace
[0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15].lis.trace
Output:
[3,4,5]
[0,4,6,9,13,15]

Tcl[edit]

Works with: Tcl version 8.6
package require Tcl 8.6
 
proc longestIncreasingSubsequence {sequence} {
# Get the increasing subsequences (and their lengths)
set subseq [list 1 [lindex $sequence 0]]
foreach value $sequence {
set max {}
foreach {len item} $subseq {
if {[lindex $item end] < $value} {
if {[llength [lappend item $value]] > [llength $max]} {
set max $item
}
} elseif {![llength $max]} {
set max [list $value]
}
}
lappend subseq [llength $max] $max
}
# Pick the longest subsequence; -stride requires Tcl 8.6
return [lindex [lsort -stride 2 -index 0 $subseq] end]
}

Demonstrating:

puts [longestIncreasingSubsequence {3 2 6 4 5 1}]
puts [longestIncreasingSubsequence {0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15}]
Output:
3 4 5
0 4 6 9 13 15

VBScript[edit]

 
Function LIS(arr)
n = UBound(arr)
Dim p()
ReDim p(n)
Dim m()
ReDim m(n)
l = 0
For i = 0 To n
lo = 1
hi = l
Do While lo <= hi
middle = Int((lo+hi)/2)
If arr(m(middle)) < arr(i) Then
lo = middle + 1
Else
hi = middle - 1
End If
Loop
newl = lo
p(i) = m(newl-1)
m(newl) = i
If newL > l Then
l = newl
End If
Next
Dim s()
ReDim s(l)
k = m(l)
For i = l-1 To 0 Step - 1
s(i) = arr(k)
k = p(k)
Next
LIS = Join(s,",")
End Function
 
WScript.StdOut.WriteLine LIS(Array(3,2,6,4,5,1))
WScript.StdOut.WriteLine LIS(Array(0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15))
 
Output:
2,4,5,
0,2,6,9,11,15,

zkl[edit]

fcn longestSequence(ns){ // based on Patience sorting
piles:=L();
backPtr:='wrap(np){ return(np-1,if(np) piles[np-1].len()-1 else -1) }; // maybe (-1,-1)
foreach n in (ns){ newPile:=True; // create list of sorted lists
foreach e,p in (piles.enumerate()){
if(n<p[-1][0]){
p.del(1,-1) // only need the first and last elements
.append(T(n,backPtr(e))); newPile=False;
break;
}
}
if(newPile) piles.append(L(T(n,backPtr(piles.len()))));
}
reg r=L(),p=-1,n=0;
do{ n,p=piles[p][n]; r.write(n); p,n=p; }while(p!=-1);
r.reverse()
}
foreach ns in (T(T(1),T(3,2,6,4,5,1),T(4,65,2,-31,0,99,83,782,1),
T(0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15),"foobar")){
s:=longestSequence(ns);
println(s.len(),": ",s," from ",ns);
}
Output:
1: L(1) from L(1)
3: L(2,4,5) from L(3,2,6,4,5,1)
4: L(-31,0,83,782) from L(4,65,2,-31,0,99,83,782,1)
6: L(0,1,3,9,11,15) from L(0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15)
4: L("f","o","o","r") from foobar