Longest increasing subsequence: Difference between revisions

From Rosetta Code
Content added Content deleted
(added php)
Line 432: Line 432:
<pre>2 4 5
<pre>2 4 5
0 2 6 9 11 15</pre>
0 2 6 9 11 15</pre>

=={{header|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];
if ($i != count($pileTops))
$pileTops[$i] = $node;
else
$pileTops[] = $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>
{{out}}
<pre>Array
(
[0] => 2
[1] => 4
[2] => 5
)
Array
(
[0] => 0
[1] => 2
[2] => 6
[3] => 9
[4] => 11
[5] => 15
)</pre>


=={{header|Python}}==
=={{header|Python}}==

Revision as of 10:40, 26 August 2013

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.

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

Translation of: Haskell

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

Translation of: Python

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

Translation of: Java

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

Translation of: Python

<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 ]

Haskell

<lang Haskell>import Data.Ord import Data.List import Data.List.Ordered

-- longest increasing lis = maximumBy (comparing length) . filter isSorted . subsequences

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
->

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]

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

Perl

Translation of: Perl 6

<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

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 patience(@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
       }
   }
   return @S

}

sub lis(@S) {

   reverse map *.key, (
       @S[*-1][*-1], *.value ...^ !*.defined
   )

}

say lis patience(<3 2 6 4 5 1>); say lis patience(<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]; if ($i != count($pileTops)) $pileTops[$i] = $node;

	else

$pileTops[] = $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
)

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]

Swym

Translation of: Python

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

Works with: Tcl version 8.6

<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