Longest increasing subsequence: Difference between revisions
Line 446: | Line 446: | ||
main = do |
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]</lang> |
|||
{{out}} |
{{out}} |
Revision as of 06:49, 25 June 2014
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
- Dynamic Programming #1: Longest Increasing Subsequence on Youtube
- An efficient solution can be based on Patience sorting.
AutoHotkey
<lang AutoHotkey>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 }</lang> Output:
3, 4, 5 0, 4, 6, 9, 13, 15
C
Using an array that doubles as linked list (more like reversed trees really). O(n) memory and O(n2) runtime. <lang c>#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; }</lang>
- Output:
3 4 5 0 4 6 9 13 15
C++
Patience sorting <lang cpp>#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;
}</lang>
- Output:
2, 4, 5, 0, 2, 6, 9, 11, 15,
Clojure
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.
<lang Clojure>(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]))</lang> Output: <lang>(2 4 5) (0 2 6 9 11 15)</lang>
Common Lisp
Common Lisp: Using the method in the video
Slower and more memory usage compared to the patience sort method. <lang lisp>(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))))</lang>
- Output:
(2 4 5) (0 2 6 9 11 15)
Common Lisp: Using the Patience Sort approach
This is 5 times faster and and uses a third of the memory compared to the approach in the video. <lang lisp>(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 ((inserted nil)) (loop for pile in piles
and prev = nil then (car pile) and i from 0 do (when (and (not inserted) (<= item (caar pile))) (setf inserted t (elt piles i) (push (cons item prev) (elt piles i)))))
(if inserted
piles (append piles (list (list (cons item (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~%" (lis-patience-sort l)))</lang>
- Output:
(2 4 5) (0 2 6 9 11 15)
D
Simple Version
Uses the second powerSet function from the Power Set Task. <lang d>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;
}</lang>
- Output:
[2, 4, 5] [0, 2, 6, 9, 11, 15]
Patience sorting
From the second Python entry, using the Patience sorting method. <lang d>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.writeln;
}</lang> The output is the same.
Faster Version
With some more optimizations. <lang d>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;
}</lang> The output is the same.
Déjà Vu
<lang dejavu>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 ] </lang>
- Output:
[ 2 4 5 ] [ 0 2 6 9 11 15 ]
Go
Patience sorting <lang go>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)) }
}</lang>
- 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
Naive implementation
<lang Haskell>import Data.Ord import Data.List import Data.List.Ordered
lis :: Ord a => [a] -> [a] lis = maximumBy (comparing length) -- longest
. filter isSorted -- increasing . subsequences -- 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]</lang>
- Output:
[2,4,5] [0,2,6,9,11,15]
Patience sorting
<lang Haskell>import Control.Monad.ST import Control.Monad import Data.Array.ST
lis :: Ord a => [a] -> [a] lis lst = runST $ do
pileTops <- newSTArray (1, length lst) [] let bsearchPiles x len = aux 1 len where aux lo hi | lo > hi = return lo | otherwise = do let mid = (lo + hi) `div` 2 m <- readArray pileTops mid if head m < x then aux (mid+1) hi else aux lo (mid-1) f len x = do i <- bsearchPiles x len writeArray pileTops i . (x:) =<< if i == 1 then return [] else readArray pileTops (i-1) return $ if i == len+1 then len+1 else len len <- foldM f 0 lst return . reverse =<< readArray pileTops len where newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) 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]</lang>
- Output:
[2,4,5] [0,2,6,9,11,15]
Icon and Unicon
The following works in both languages:
<lang unicon>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</lang>
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
These examples are simple enough for brute force to be reasonable:
<lang j>increasing=: (-: /:~)@#~"1 #:@i.@^~&2@# longestinc=: ] #~ [: (#~ ([: (= >./) +/"1)) #:@I.@increasing</lang>
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:
<lang j>
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</lang>
Java
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. <lang java>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));
}
}</lang>
- 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
<lang javascript>
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); </lang>
- Output:
[ 0, 2, 6, 9, 11, 15 ] [ 2, 4, 5 ]
Lua
<lang lua>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, Template:X,) 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}) </lang>
- Output:
2 4 5 0 2 6 9 11 15
Mathematica
Although undocumented, Mathematica has the function LongestAscendingSequence which exactly does what the Task asks for: <lang Mathematica>LongestAscendingSequence/@{{3,2,6,4,5,1},{0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}}</lang>
- Output:
{{2,4,5},{0,2,6,9,11,15}}
Objective-C
Patience sorting <lang objc>#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;
}</lang>
- 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
Naïve implementation
<lang OCaml>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</lang>
- Output:
3 4 5 0 4 6 9 13 15
Patience sorting
<lang ocaml>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)</lang>
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
Dynamic programming
<lang Perl>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; </lang>
- Output:
2 4 5 0 2 6 9 11 15
Patience sorting
<lang perl>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";
}</lang>
- 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
Dynamic programming
Straight-forward implementation of the algorithm described in the video.
<lang Perl 6>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]);</lang>
- Output:
2 4 5 0 2 6 9 11 15
Patience sorting
<lang Perl 6>sub lis(@deck is copy) {
my @S = [@deck.shift() => Mu].item; for @deck -> $card { if defined my $i = first { @S[$_][*-1].key > $card }, ^@S { @S[$i].push: $card => @S[$i-1][*-1] // Mu } else { @S.push: [ $card => @S[*-1][*-1] // Mu ].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>;</lang>
- Output:
2 4 5 0 2 6 9 11 15
PHP
Patience sorting <lang php><?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))); ?></lang>
- Output:
Array ( [0] => 2 [1] => 4 [2] => 5 ) Array ( [0] => 0 [1] => 2 [2] => 6 [3] => 9 [4] => 11 [5] => 15 )
Prolog
Works with SWI-Prolog version 6.4.1
Naïve implementation.
<lang prolog>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).
</lang>
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
Python: Method from video
<lang python>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)))</lang>
- 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
<lang python>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)))</lang>
- 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
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>#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)))))])))</lang>
- Output:
'(2 4 5) '(0 2 6 9 11 15)
Ruby
Patience sorting <lang ruby>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])</lang>
- Output:
[2, 4, 5] [0, 2, 6, 9, 11, 15]
Scheme
Patience sorting <lang scheme>(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)</lang>
- Output:
(2 4 5) (0 2 6 9 11 15)
Standard ML
Patience sorting
<lang sml>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</lang>
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
Based on the Python video solution. Interpreter at [[1]] <lang swym>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</lang>
- Output:
[3,4,5] [0,4,6,9,13,15]
Tcl
<lang tcl>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]
}</lang> Demonstrating: <lang tcl>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}]</lang>
- Output:
3 4 5 0 4 6 9 13 15
zkl
<lang zkl>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()
}</lang> <lang zkl>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);
}</lang>
- 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