Longest Increasing Subsequence

It is a slow day, being Sunday and all. Plus I have a terrible case of sinusitis. It is a perfect time to look into some stuff that I failed to understand in the past. The easiest one to attack at the moment are algorithms for a longest increasing subsequence in a given sequence. If anything goes wrong, I’ll blame the sinusitis, or this scotch I have been nursing. You have been warned:

First attempt of refactoring

Here is the code for an O(n log(n)) algorithm given at Rosetta Code:

(defun longest-inc-seq (input)
  (let ((piles nil))
    (dolist (item input)
      (setf piles (insert item piles)))
    (reverse (caar (last piles)))))

LONGEST-INC-SEQ


(defun insert (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)))))))))

INSERT


(longest-inc-seq (list 3 2 6 4 5 1))

(2 4 5)

(longest-inc-seq (list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))

(0 2 6 9 11 15)

There is the immediate refactoring opportunity in the for loop: the (not inserted) clause should have been in the for loop. So, the minimal rewriting of the same code would be

(defun insert (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)))

INSERT


(longest-inc-seq (list 3 2 6 4 5 1))

(2 4 5)

(longest-inc-seq (list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))

(0 2 6 9 11 15)

Looks better, and slightly more efficient. But then again, I do not like the syntax of loop that much. This brings me the new and improve version

(defun longest-inc-seq (input)
  (do* ((piles nil (insert (car x) piles))
        (x input (cdr x)))
       ((null x) (reverse (caar (last piles))))))

LONGEST-INC-SEQ

(defun insert (item piles)
  (multiple-value-bind
        (i prev)
      (do* ((prev nil (caar 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 prev) (elt piles i))
               piles))))

INSERT

(longest-inc-seq (list 3 2 6 4 5 1))

(2 4 5)

(longest-inc-seq (list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))

(0 2 6 9 11 15)

But, I still have a problem: I prefer recursion over the do loops because they are easier to debug in a lisp environment. Hence:

(defun longest-inc-seq (input &optional carry)
  (if (null input) 
      (reverse (caar (last carry)))
      (longest-inc-seq (cdr input) (insert (car input) carry))))

LONGEST-INC-SEQ

(defun insert (item piles &optional prev)
  (cond ((null piles) 
         (reverse (cons (list (cons item (caar prev))) prev)))
        ((<= item (caaar piles)) 
         (append (reverse prev)
                 (progn (push (cons item (caar prev)) (car piles))
                        piles)))
        (t (insert item (cdr piles) (push (car piles) prev)))))

INSERT

(longest-inc-seq (list 3 2 6 4 5 1))

(2 4 5)

(longest-inc-seq (list 0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))

(0 2 6 9 11 15)

A comparison

I ran my three different versions using the same random sequence on my old dinky laptop Intel i5 with 4Gb running sbcl.

(loop repeat 30000 collect (random 100))

And the winner is…

Alas, the recursive version, as sweet as it looks, is the least efficient one.