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.

Pages: 1 2

Posted by programmingpraxis
Filed in Exercises
4 Comments »

4 Responses to “Longest Increasing Subsequence”

  1. Paul said
    September 2, 2014 at 10:24 AM

    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]
  3. Francesco said
    September 25, 2014 at 4:35 AM

    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

  4. Francesco said
    September 25, 2014 at 4:39 AM

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

    http://codepad.org/TgbMu3oq

Leave a comment