Longest Increasing Subsequence

September 2, 2014

Since this is a variant of the previous exercise, we begin by restating the deal function from that exercise:

(define (deal deck)
  (let loop ((deck deck) (selip (list)) (piles (list)))
    (cond ((null? deck) piles) ; no more cards in deck
          ((null? piles) ; add card to new pile
            (loop (cdr deck) (list)
                  (reverse (cons (list (car deck)) selip))))
          ((< (car deck) (caar piles)) ; found correct pile
            (loop (cdr deck) (list)
                  (append (reverse selip)
                          (list (cons (car deck) (car piles)))
                          (cdr piles))))
          (else ; continue search for correct pile
            (loop deck (cons (car piles) selip) (cdr piles))))))

> (deal '(4 2 9 1 3 6 7 8 5))
((1 2 4) (3 9) (5 6) (7) (8))

The difference between the two algorithms is in the storage of the piles; in the previous exercise, a pile was just a list of integers, but not the piles must be a list of integers paired with the top card of the previous deck at the time it was added to the pile. That matters in three places: in the second cond clause where a new pile is created, in the third cond clause where the current card is compared to the top of the current pile, and again in the third cond clause when a card is added to an existing pile. Thus, we rewrite deal to move those three bits of code to auxiliary functions; we also change the count and types of the arguments to those functions, so they will meet the changed need of our new problem:

(define (make-new-pile deck selip) (list (car deck)))

(define (lt? deck piles) (< (car deck) (caar piles)))

(define (add-current-pile deck piles selip) (list (cons (car deck) (car piles))))

(define (deal deck)
  (let loop ((deck deck) (selip (list)) (piles (list)))
    (cond ((null? deck) piles) ; no more cards in deck
          ((null? piles) ; add card to new pile
            (loop (cdr deck) (list)
                  (reverse (cons (make-new-pile deck selip) selip))))
          ((lt? deck piles) ; found correct pile
            (loop (cdr deck) (list)
                  (append (reverse selip)
                          (add-current-pile deck piles selip)
                          (cdr piles))))
          (else ; continue search for correct pile
            (loop deck (cons (car piles) selip) (cdr piles))))))

A quick test shows that the new version of deal and its auxiliaries works the same as the old deal:

> (deal '(4 2 9 1 3 6 7 8 5))
((1 2 4) (3 9) (5 6) (7) (8))

Now we write new auxiliary functions to handle the new type of piles:

(define (make-new-pile deck selip)
  (list (if (null? selip) (list (car deck)) (cons (car deck) selip))))

(define (lt? deck piles) (< (car deck) (caaar piles)))

(define (add-current-pile deck piles selip)
  (list (if (null? selip)
            (cons (list (car deck)) (car piles))
            (cons (cons (car deck) selip) (car piles)))))

The deal function is unchanged; here’s a sample:

> (deal '(4 2 9 1 3 6 7 8 5))
(((1) (2) (4))
  ((3 ((1) (2) (4))) (9 ((2) (4))))
  ((5 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))
    (6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4))))
  ((7 ((6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4))))
      ((3 ((1) (2) (4))) (9 ((2) (4))))
      ((1) (2) (4))))
  ((8 ((7 ((6 ((3 ((1) (2) (4))) (9 ((2) (4))))
              ((1) (2) (4))))
          ((3 ((1) (2) (4))) (9 ((2) (4))))
          ((1) (2) (4))))
      ((6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4))))
      ((3 ((1) (2) (4))) (9 ((2) (4))))
      ((1) (2) (4)))))

The longest increasing subsequence is contained in the top of the last pile, which in the case of our example is ((8 ((7 ((6 ((3 ((1) (2) (4))) …))))))); you can read the longest increasing subsequence backwards as (1 3 6 7 8). The longest increasing subsequence function calls deal, then chases down the caars of the car of the last pair of the result:

(define (lis deck)
  (let loop ((dealt (car (reverse (deal deck)))) (result (list)))
    (if (null? (cdar dealt)) (cons (caar dealt) result)
      (loop (cadar dealt) (cons (caar dealt) result)))))

That’s fun; it’s not often I get to write cadar. You can move the auxiliary functions back in to the main deal function if you like, to save the function-calling overhead, but we won’t bother. Here are some examples:

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

You can run the program at http://programmingpraxis.codepad.org/ltak2soB.

Advertisements

Pages: 1 2

4 Responses to “Longest Increasing Subsequence”

  1. Paul said

    In Python.

    def longest_sub_seq(seq):
        piles = []
        for item in seq:
            last_pile = None
            for pile in piles:
                if item < pile[-1][0]:
                    ptr = len(last_pile) - 1 if last_pile else None
                    pile.append((item, ptr))
                    break
                last_pile = pile
            else:
                ptr = len(last_pile) - 1 if last_pile else None
                piles.append([(item, ptr)])
        pile_nr = len(piles) - 1
        item, ptr = piles[pile_nr][0]
        res = [item]
        while ptr is not None:
            pile_nr -= 1
            item, ptr = piles[pile_nr][ptr]
            res.append(item)
        return res[::-1]
    
  2. Francesco said

    Haskell ahoy

    import Control.Monad
    import Data.List

    test = [3,2,6,4,5,1]

    lsbs cs = filter ((==ml) . length) sortonly
    where sortonly = filter (\\a -> sort a == a) (subs cs)
    ml = maximum $ map length sortonly
    subs cs = filterM (\\a -> [True, False]) cs

    main = print $ lsbs test

  3. Francesco said

    ok, formatting didn’t go easy on me.
    Same snippet on codepad

    http://codepad.org/TgbMu3oq

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: