Longest Increasing Subsequence Revisited

This is another problem I have looked at before, but I have a different angle :)

Description of the problem

Assume we have a finite sequence of real numbers \((x_1,\ldots,x_n)\). Our aim today is to find a subsequence \((x_{i_1},\ldots,x_{i_k})\) such that

1. The subsequence must be strictly increasing,
2. The subsequence is the longest such subsequence in the original sequence.

Obvious solution

There is an obvious recursive solution: let f be the function that calculates the subsequence we are looking for. Then (f xs) is the longer of (f (cdr xs)) and (cons (car xs) (f (filter xs))) where (filter xs) returns the list of elements in xs which are greater than (car xs).

Implementation

I am going to need a function that returns the longer of two lists:

(defun longer (x y)
   (if (> (length x) (length y))
       x
       y))
LONGER

And for the recursive function

(defun f (xs)
   (if (cdr xs)
       (longer (f (cdr xs))
               (let ((u (car xs)))
                  (cons u (f (remove-if-not (lambda (x) (> x u)) (cdr xs))))))
       xs))
F

Let us test:

(let ((xs (loop repeat 60 collect (random 10))))
   (equal (longest-inc-seq xs)
          (f xs)))
T

It works just fine for short lists. I took the function longest-inc-seq from my previous post.

The bottleneck

The implementation I gave is recursive and it is terribly inefficient for large lists:

(let ((xs (loop repeat 100 collect (random 20))))
   (time (longest-inc-seq xs))
   (time (f xs))
   nil)
NIL


Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  43,009 processor cycles
  4,096 bytes consed

Evaluation took:
  0.091 seconds of real time
  0.348000 seconds of total run time (0.124000 user, 0.224000 system)
  382.42% CPU
  320,140,485 processor cycles
  44,111,512 bytes consed

Memoization

One can cut down the time and space complexity using memoization.

(let ((table (make-hash-table :test #'equal)))
   (defun g (xs)
      (or (gethash xs table)
          (setf (gethash xs table)
                (if (cdr xs)
                    (longer (g (cdr xs))
                            (let ((u (car xs)))
                                 (cons u (g (remove-if-not (lambda (x) (> x u))
                                                           (cdr xs))))))
                    xs)))))
G
(let ((xs (loop repeat 150 collect (random 20))))
   (time (longest-inc-seq xs))
   (time (f xs))
   (time (g xs))
   nil)
NIL


Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  46,075 processor cycles
  4,096 bytes consed

Evaluation took:
  2.965 seconds of real time
  2.960000 seconds of total run time (2.932000 user, 0.028000 system)
  [ Run times consist of 0.028 seconds GC time, and 2.932 seconds non-GC time. ]
  99.83% CPU
  10,352,715,660 processor cycles
  1,789,128,888 bytes consed

Evaluation took:
  0.001 seconds of real time
  0.004000 seconds of total run time (0.004000 user, 0.000000 system)
  400.00% CPU
  4,342,791 processor cycles
  318,640 bytes consed

Analysis

The original implementation which is based on patience sort is blazingly fast, but its implementation is difficult. The recursive implementation is rather easy to implement but has really bad complexity (exponential). Memoized solution is a good compromise between easy implementaion and speed.