Dutch National Flag

March 5, 2013

We begin with the examine and swap functions:

(define examine vector-ref)

(define (swap! xs p1 p2)
  (let ((t (vector-ref xs p1)))
    (vector-set! xs p1 (vector-ref xs p2))
    (vector-set! xs p2 t))

Although it’s usually stated as a sorting problem, this is actually a partitioning problem. The usual solution is to maintain three pointers: a red pointer that initially points to the first location in the array, a white pointer that initially points to the first location in the array, and a blue pointer that initially points to the last location in the array. Then the array is scanned from left to right. Each time you encounter a red element, swap it with the current red pointer and increment the red and white pointers. Each time you encounter a blue symbol, swap it with the current blue pointer and decrement the blue pointer. Each time you encounter a white symbol, leave it where it is and increment the white pointer. The scan stops when the white pointer crosses the blue pointer, at which point the arrays is partitioned as requested:

(define (dutch-national-flag xs)
  (let loop ((r 0) (w 0) (b (- (vector-length xs) 1)))
    (if (< b w) xs
      (case (examine xs w)
        ((#\R) (set! xs (swap! xs r w))
               (loop (+ r 1) (+ w 1) b))
        ((#\W) (loop r (+ w 1) b))
        ((#\B) (set! xs (swap! xs b w))
               (loop r w (- b 1)))))))

Here’s an example, augmented with the values at each step of the loop so you can see how the pointers track:

> (dutch-national-flag #(#\B #\W #\B #\R #\W #\R #\B))
0 0 6 #(B W B R W R B)
0 0 5 #(B W B R W R B)
0 0 4 #(R W B R W B B)
1 1 4 #(R W B R W B B)
1 2 4 #(R W B R W B B)
1 2 3 #(R W W R B B B)
1 3 3 #(R W W R B B B)
2 4 3 #(R R W W B B B)
#(R R W W B B B)

This is exactly the same algorithm as the “fat pivot” partition that is sometimes used in quicksort, which brings together all the array elements equal to the pivot instead of leaving them in place on one side or the other; the same algorithm is also used in ternary search tries. You can run the program at http://programmingpraxis.codepad.org/0UFUJWc0.

The original source of the exercise is Dijkstra’s book A Discipline of Programming, published by Prentice Hall in 1976.

Pages: 1 2

10 Responses to “Dutch National Flag”

  1. […] today’s Programming Praxis exercise, our goal is to implement a sorting algorithm for lists with three […]

  2. My Haskell solution (see http://bonsaicode.wordpress.com/2013/03/05/dutch-national-flag/ for a version with comments):

    import qualified Data.Vector as V
    swap :: Int -> Int -> V.Vector a -> V.Vector a
    swap i j a = a V.// [(i,a V.! j), (j,a V.! i)]
    flag :: V.Vector Char -> V.Vector Char
    flag xs = f (0, V.length xs - 1) xs 0 where
      f (r,b) a n = if n > b then a else case a V.! n of
        'R' -> f (r+1,b  ) (swap n r a) (n+1)
        'B' -> f (r,  b-1) (swap n b a) n
        _   -> f (r,  b  ) a            (n+1)
  3. seckcoder said

    My python solution here( https://github.com/seckcoder/geass/blob/master/dnf4.py ). Actually I implemented the Dutch National Flag Algorithm for 4 colors.

  4. jpverkamp said

    Here’s mine: Partitioning the Dutch national flag

    This time, I have both a Racket version and a JavaScript version. The JavaScript has an HTML5 canvas visualizer which was pretty neat to write. It will show the blocks as it sorts, along with the three labels. Let me know if you have any problems running it, I haven’t tested it on anything but Win7/Chrome.

  5. Jan Van lent said

    A Common Lisp implementation:

    (use-package :iterate)
    ;; (arotatef a i j k) -> (rotatef (aref a i) (aref a j) (aref a k))
    (defmacro arotatef (a &rest indices)
      `(rotatef ,@(mapcar (lambda (i) `(aref ,a ,i)) indices)))
    (defun rwb-sort (a)
      (iter (with next-red = 0) (with next-white = 0) (with next-blue = 0)
            (for x in-vector a)
            (ecase x
              (red (arotatef a next-blue next-white next-red)
                   (incf next-red) (incf next-white) (incf next-blue))
              (white (arotatef a next-blue next-white)
                     (incf next-white) (incf next-blue))
              (blue (incf next-blue)))))
    (let ((rwb '(red white blue)))
      (defun random-rwb ()
        (elt rwb (random 3))))
    (defun random-rwb-array (n)
      (iter (repeat n)
            (collect (random-rwb) :result-type 'vector))))
    (defun test (n)
      (let ((a (random-rwb-array n)))
        (rwb-sort a)
  6. My version in python without peaking at the solution.  For some reason, I had the idea of starting in the middle.
    def swap(arr, i, j):
        arr[i], arr[j] = arr[j], arr[i]
    def dutch_flag(x):
        >>> dutch_flag (['b', 'r', 'r', 'w', 'r', 'w', 'b', 'w', 'w', 'r'])
        ['r', 'r', 'r', 'r', 'w', 'w', 'w', 'w', 'b', 'b']
        l, u = 0, len(x) - 1
        m1 = (u + l) / 2
        m2 = (u + l) / 2
        while m1 >= l:
            if x[m1] == 'r':
                swap(x, m1, l)
                l = l + 1
            elif x[m1] == 'b':
                swap(x, m1, u)
                u = u - 1
            elif x[m1] == 'w':
                m1 = m1 - 1
        while m2 <= u:
            if x[m2] == 'r':
                swap(x, m2, l)
                l = l + 1
            elif x[m2] == 'b':
                swap(x, m2, u)
                u = u - 1
            elif x[m2] == 'w':
                m2 = m2 + 1
        return x
  7. sbocq said

    Dijkstra had really nothing better to do (not like me :-p).

    Clojure/Script (try online at http://clojurescript.net/).

    (defn sort-flag [cs]
      (let [a (into-array cs)]
        (letfn [(swp [i1 i2] (let [v1 (aget a i1)]
                               (aset a i1 (aget a i2))
                               (aset a i2 v1)))]
          (loop [reds 0, i 0, blues (dec (count a))]
            (when (<= i blues)
              (case (aget a i)
                :red (do (swp i reds)
                         (recur (inc reds) (inc i) blues))
                :white (recur reds (inc i) blues)
                :blue (do (swp i blues)
                          (recur reds i (dec blues)))))))
        (into [] a)))


    => (sort-flag [:blue :red :white])
    [:red :white :blue]
    => (sort-flag [:blue :red :white :red :blue :white :blue :red])
    [:red :red :red :white :white :blue :blue :blue]
    => (sort-flag [:white :blue :red :white :red :blue :white :blue :red])
    [:red :red :red :white :white :white :blue :blue :blue]
    => (sort-flag [:white :blue :red :white :red :blue :white :blue :red :white])
    [:red :red :red :white :white :white :white :blue :blue :blue]

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 )

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: