Flipping Pancakes

April 7, 2009

This problem is a favorite of mathematicians, who are still searching for the formula that calculates the minimum number of flips required to sort a stack of pancakes. Before he dropped out of school and became rich, Bill Gates wrote the only published paper of his career showing one solution to the problem (which has since been bettered). For a stack of n pancakes, our algorithm makes 2n flips, which is far from optimal.

We begin with a function flip that reverses the top n pancakes on the stack; this is equivalent to inserting a spatula under the nth pancake and flipping:

(define (flip n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (null? xs) (zero? n)) (append ys xs)
      (loop (- n 1) (cdr xs) (cons (car xs) ys)))))

Our algorithm will work by finding the largest pancake in the stack, flipping it to the top, then flipping the entire stack to put the largest pancake on the bottom; the process is then repeated on that diminishing portion of the stack that is not yet sorted. The find-max function finds the largest of the first n pancakes on the stack:

(define (find-max n xs)
  (let loop ((n n) (xs xs) (k 0) (mx 0) (mk 0))
    (cond ((or (zero? n) (null? xs)) mk)
          ((< mx (car xs)) (loop (- n 1) (cdr xs) (+ k 1) (car xs) (+ k 1)))
          (else (loop (- n 1) (cdr xs) (+ k 1) mx mk)))))

Now we simply loop through the stack of pancakes:

(define (pancake xs)
  (let loop ((k (length xs)) (xs xs))
    (let* ((j k) (i (find-max j xs)))
      (if (= j 1) xs
        (loop (- k 1) (flip j (flip i xs)))))))

Here’s how the pancake sort looks:

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

You can run this program at http://programmingpraxis.codepad.org/HQFNnbnb.

Pages: 1 2

Posted by programmingpraxis
Filed in Exercises
12 Comments »

12 Responses to “Flipping Pancakes”

  1. FalconNL said
    April 7, 2009 at 11:37 AM

    This Haskell solution does some unnecessary flips if the bottom of the current subset is already in the correct position, but then again if you want efficiency just do a merge- or quicksort :)

    main = print $ pancakeSort [7,2,9,4,6,1,3,8,5]

pancakeSort :: (Ord a) => [a] -> [a]
pancakeSort xs = foldr sort' xs [1..length xs]

sort' :: (Ord a) => Int -> [a] -> [a]
sort' n xs = flip' n $ flip' (snd . maximum . flip zip [1..] $ take n xs) xs

flip' :: Int -> [a] -> [a]
flip' n = uncurry ((++) . reverse) . splitAt n
  2. Ben Simon said
    April 7, 2009 at 7:34 PM

    Man that Haskell solution is compact. It’s gorgeous. Too bad my Haskell is so rusty that it doesn’t mean anything to me.

    Haskell, the twitter of programming languages…

  3. Jens Axel Søgaard said
    April 8, 2009 at 12:25 PM

    ; Solution using fold

    #lang scheme
    (require srfi/1)

    (define (flip n xs)
    (let-values ([(top bottom) (split-at xs n)])
    (append (reverse top) bottom)))

    (define (find-max n xs)
    (let ([m (apply max (take xs n))])
    (list-index (λ (x) (= x m)) xs)))

    (define (pancake xs)
    (fold (λ (n xs) (flip n (flip (+ (find-max n xs) 1) xs)))
    xs
    (reverse (iota (length xs) 1))))

    (pancake ‘(7 2 9 4 6 11 1 3 8 5 13))

  4. Jens Axel Søgaard said
    April 8, 2009 at 12:27 PM

    ; Solution without fold.

    #lang scheme
    (require srfi/1)

    (define (flip n xs)
    (let-values ([(top bottom) (split-at xs n)])
    (append (reverse top) bottom)))

    (define (find-max n xs)
    (let ([m (apply max (take xs n))])
    (list-index (λ (x) (= x m)) xs)))

    (define (nest f n base)
    (if (= n 0)
    base
    (nest f (- n 1) (f n base))))

    (define (pancake xs)
    (nest (λ (n xs) (flip n (flip (+ (find-max n xs) 1) xs)))
    (length xs)
    xs))

    (pancake ‘(7 2 9 4 6 11 1 3 8 5 10 ))

  5. programmingpraxis said
    April 8, 2009 at 4:48 PM

    Ben,

    It’s not too hard to define Scheme functions so they resemble the curry-and-compose style of Haskell. I just uploaded a small library of higher-order functions to the Standard Prelude, including compose and define-curried; fold-right is already there. That’s most of what you need to replicate the Haskell solution.

  6. Jens Axel Søgaard said
    April 8, 2009 at 7:33 PM

    I notice that the prelude contains this definition:

    (define (second x y) y)

    There is a strong tradition however to let second be:

    (define (second xs) (list-ref xs 1))

    I am not sure what the traditional name for
    the projection is, but perhaps project2 ?

  7. programmingpraxis said
    April 8, 2009 at 8:00 PM

    I think an even older and stronger tradition is to spell your second “cadr”. I just looked; cadr appears on page 13 of the Lisp 1.5 Programmer’s Manual, in the definition of apply.

  8. Jens Axel Søgaard said
    April 8, 2009 at 11:39 PM

    In modern times second is used instead of cadr to stress that one is working with lists. The operation cadr is used for trees built using conses.

    Both in SRFI 1 and the Common Lisp HyperSpec second is used to access the second element of a list.

  9. g said
    April 21, 2009 at 2:44 AM

    here’s my python:

    def flipsort(pile):
    for i in xrange(len(pile)):
        max_index = pile.index(max(pile[i:]))
        if max_index != i:
            pile[max_index:] = pile[max_index:][::-1]
            pile[i:] = pile[i:][::-1]
    return pile
  10. g said
    April 21, 2009 at 3:19 AM

    fixed to work with duplicates:

    def flipsort(pile):
    for i in xrange(len(pile)):
        slice = pile[i:]
        max_index = slice.index(max(slice)) + i
        if max_index != i:
            step += 2
            pile[max_index:] = pile[max_index:][::-1]
            pile[i:] = pile[i:][::-1]
    return pile
  11. g said
    April 21, 2009 at 3:22 AM

    oops, step += 2 shouldn’t be there

Leave a comment