Dutch national flag problem

Dutch national flag problem
You are encouraged to solve this task according to the task description, using any language you may know.

The Dutch national flag is composed of three coloured bands in the order red then white and lastly blue. The problem posed by Edsger Dijkstra is:

Given a number of red, blue and white balls in random order, arrange them in the order of the colours Dutch national flag.

When the problem was first posed, Dijkstra then went on to successively refine a solution, minimising the number of swaps and the number of times the colour of a ball needed to determined and restricting the balls to end in an array, ...

This task is to

1. Generate a randomized order of balls ensuring that they are not in the order of the Dutch national flag.
2. Sort the balls in a way idiomatic to your language.
3. Check the sorted balls are in the order of the Dutch national flag.

Cf.

• Dutch national flag problem
• Probabilistic analysis of algorithms for the Dutch national flag problem by Wei-Mei Chen. (pdf)

Ada

<lang Ada>with Ada.Text_IO, Ada.Numerics.Discrete_Random, Ada.Command_Line;

procedure Dutch_National_Flag is

  type Colour_Type is (Red, White, Blue);

  Number: Positive range 2 .. Positive'Last :=
    Positive'Value(Ada.Command_Line.Argument(1));
  -- no sorting if the Number of balls is less than 2

  type Balls is array(1 .. Number) of Colour_Type;

  function Is_Sorted(B: Balls) return Boolean is
     -- checks if balls are in order
  begin
     for I in Balls'First .. Balls'Last-1 loop
        if B(I) > B(I+1) then
           return False;
        end if;
     end loop;
     return True;
  end Is_Sorted;

  function Random_Balls return Balls is
     -- generates an array of random balls, ensuring they are not in order
     package Random_Colour is new Ada.Numerics.Discrete_Random(Colour_Type);
     Gen: Random_Colour.Generator;
     B: Balls;
  begin
     Random_Colour.Reset(Gen);
     loop
        for I in Balls'Range loop
           B(I) := Random_Colour.Random(Gen);
        end loop;
        exit when (not Is_Sorted(B));
        -- ... ensuring they are not in order
     end loop;
     return B;
  end Random_Balls;

  procedure Print(Message: String; B: Balls) is
  begin
     Ada.Text_IO.Put(Message);
     for I in B'Range loop
        Ada.Text_IO.Put(Colour_Type'Image(B(I)));
        if I < B'Last then
           Ada.Text_IO.Put(", ");
        else
           Ada.Text_IO.New_Line;
        end if;
     end loop;
  end Print;

  procedure Sort(Bls: in out Balls) is
     -- sort Bls in O(1) time

     Cnt: array(Colour_Type) of Natural := (Red => 0, White => 0, Blue => 0);
     Col: Colour_Type;

     procedure Move_Colour_To_Top(Bls: in out Balls;
                                  Colour: Colour_Type;
                                  Start: Positive;
                                  Count: Natural) is
        This: Positive := Start;
        Tmp: Colour_Type;
     begin
        for N in Start .. Start+Count-1 loop
           while Bls(This) /= Colour loop
              This := This + 1;
           end loop; -- This is the first index >= N with B(This) = Colour
           Tmp := Bls(N); Bls(N) := Bls(This); Bls(This) := Tmp; -- swap
           This := This + 1;
        end loop;
     end  Move_Colour_To_Top;

  begin
     for Ball in Balls'Range loop
        -- count how often each colour is found
        Col := Bls(Ball);
        Cnt(Col) := Cnt(Col) + 1;
     end loop;
     Move_Colour_To_Top(Bls, Red,   Start => 1,          Count => Cnt(Red));
     Move_Colour_To_Top(Bls, White, Start => 1+Cnt(Red), Count => Cnt(White));
     -- all the remaining balls are blue
  end Sort;

  A: Balls := Random_Balls;

begin

  Print("Original Order: ", A);

  pragma Assert(not Is_Sorted(A));   -- Check if A is unsorted

  Sort(A); -- A = ((Red**Cnt(Red)= & (White**Cnt(White)) & (Blue**Cnt(Blue)))

  pragma Assert(Is_Sorted(A));   -- Check if A is actually sorted

  Print("After Sorting:  ", A);

end Dutch_National_Flag;</lang>

Output:

>./dutch_national_flag 5
Original Order: RED, RED, BLUE, RED, BLUE
After Sorting:  RED, RED, RED, BLUE, BLUE
>./dutch_national_flag 5
Original Order: BLUE, RED, RED, WHITE, RED
After Sorting:  RED, RED, RED, WHITE, BLUE
>./dutch_national_flag 7
Original Order: WHITE, WHITE, BLUE, WHITE, BLUE, BLUE, WHITE
After Sorting:  WHITE, WHITE, WHITE, WHITE, BLUE, BLUE, BLUE

D

<lang d>import std.stdio, std.random, std.algorithm, std.traits, std.range;

enum DutchColors : ubyte { red, white, blue }

void dutchFlagSort(DutchColors[] items) pure nothrow {

   if (items.length < 1) return;
   int lo, mid, hi = items.length - 1;
   while (mid <= hi)
       final switch (items[mid]) {
           case DutchColors.red:
               swap(items[lo], items[mid]);
               lo++;
               mid++;
               break;
           case DutchColors.white:
               mid++;
               break;
           case DutchColors.blue:
               swap(items[mid], items[hi]);
               hi--;
               break;
       }

}

void main() {

   DutchColors[12] balls;
   auto colors = [EnumMembers!DutchColors];
   do {        
       foreach (i; 0 .. balls.length) 
           balls[i] = colors[uniform(0, 3)];
   } while (balls[].isSorted());

   writeln("Original Ball order: ", balls);
   balls[].dutchFlagSort();
   writeln("Sorted Ball Order: ", balls);
   assert(balls[].isSorted(), "Balls not sorted");

}</lang>

Output:

Original Ball order: [white, red, red, white, white, blue, white, blue, blue, white, white, blue]
Sorted Ball Order: [red, red, white, white, white, white, white, white, blue, blue, blue, blue]

Go

<lang go>package main

import (

   "fmt"
   "math/rand"
   "time"

)

// constants define order of colors in Dutch national flag const (

   red = iota
   white
   blue
   nColors

)

// zero object of type is valid red ball. type ball struct {

   color int

}

// order of balls based on DNF func (b1 ball) lt(b2 ball) bool {

   return b1.color < b2.color

}

// type for arbitrary ordering of balls type ordering []ball

// predicate tells if balls are ordered by DNF func (o ordering) ordered() bool {

   var b0 ball
   for _, b := range o {
       if b.lt(b0) {
           return false
       }
       b0 = b
   }
   return true

}

func init() {

   rand.Seed(time.Now().Unix())

}

// constructor returns new ordering of balls which is randomized but // guaranteed to be not in DNF order. function panics for n < 2. func outOfOrder(n int) ordering {

   if n < 2 {
       panic(fmt.Sprintf("%d invalid", n))
   }
   r := make(ordering, n)
   for {
       for i, _ := range r {
           r[i].color = rand.Intn(nColors)
       }
       if !r.ordered() {
           break
       }
   }
   return r

}

// O(n) algorithm // http://www.csse.monash.edu.au/~lloyd/tildeAlgDS/Sort/Flag/ func (a ordering) sort3() {

   lo, mid, hi := 0, 0, len(a)-1
   for mid <= hi {
       switch a[mid].color {
       case red:
           a[lo], a[mid] = a[mid], a[lo]
           lo++
           mid++
       case white:
           mid++
       default:
           a[mid], a[hi] = a[hi], a[mid]
           hi--
       }
   }

}

func main() {

   f := outOfOrder(12)
   fmt.Println(f)
   f.sort3()
   fmt.Println(f)

}</lang>

Output:

[{1} {0} {0} {2} {1} {1} {1} {2} {2} {0} {1} {2}]
[{0} {0} {0} {1} {1} {1} {1} {1} {2} {2} {2} {2}]

J

We shall define a routine to convert the values 0 1 2 to ball names: <lang J>i2b=: {&(;:'red white blue')</lang> and its inverse <lang J>b2i=: i2b inv</lang> Next, we need a random assortment of balls: <lang J> BALLS=: i2b ?20#3

  BALLS

┌────┬───┬────┬───┬───┬─────┬─────┬─────┬────┬────┬─────┬────┬────┬───┬────┬───┬─────┬───┬────┬───┐ │blue│red│blue│red│red│white│white│white│blue│blue│white│blue│blue│red│blue│red│white│red│blue│red│ └────┴───┴────┴───┴───┴─────┴─────┴─────┴────┴────┴─────┴────┴────┴───┴────┴───┴─────┴───┴────┴───┘</lang> And we want to sort them in their canonical order: <lang J> /:~&.b2i BALLS ┌───┬───┬───┬───┬───┬───┬───┬─────┬─────┬─────┬─────┬─────┬────┬────┬────┬────┬────┬────┬────┬────┐ │red│red│red│red│red│red│red│white│white│white│white│white│blue│blue│blue│blue│blue│blue│blue│blue│ └───┴───┴───┴───┴───┴───┴───┴─────┴─────┴─────┴─────┴─────┴────┴────┴────┴────┴────┴────┴────┴────┘</lang> Note that if we were not using J's built in sort, we would probably want to use bin sort here.

Anyways, we can test that they are indeed sorted properly: <lang J> assert@(-: /:~)&b2i /:~&.b2i BALLS</lang>

Perl 6

Here are five ways to do it, all one liners (apart from the test apparatus). <lang>enum NL <red white blue>; my @colors;

sub how'bout (&this-way) {

   sub show {
       say @colors;
       say "Ordered: ", [<=] @colors;
   }

   @colors = NL.roll(20);
   show;
   this-way;
   show;
   say ;

}

say "Using functional sort"; how'bout { @colors = sort *.value, @colors }

say "Using in-place sort"; how'bout { @colors .= sort: *.value }

say "Using a Bag"; how'bout { @colors = red, white, blue Zxx bag(@colors».key)<red white blue> }

say "Using the classify method"; how'bout { @colors = (.list for %(@colors.classify: *.value){0,1,2}) }

say "Using multiple greps"; how'bout { @colors = (.grep(red), .grep(white), .grep(blue) given @colors) }</lang>

Output:

Using functional sort
red red white white red red red red red red red white red white red red red white white white
Ordered: False
red red red red red red red red red red red red red white white white white white white white
Ordered: True

Using in-place sort
red blue white red white blue white blue red white blue blue blue red white white red blue red blue
Ordered: False
red red red red red red white white white white white white blue blue blue blue blue blue blue blue
Ordered: True

Using a Bag
red blue blue blue white red white red white blue blue red red red red blue blue red white blue
Ordered: False
red red red red red red red red white white white white blue blue blue blue blue blue blue blue
Ordered: True

Using the classify method
blue red white blue blue white white red blue red red white red blue white white red blue red white
Ordered: False
red red red red red red red white white white white white white white blue blue blue blue blue blue
Ordered: True

Using multiple greps
red white blue white white red blue white red white red white white white white white red red blue red
Ordered: False
red red red red red red red white white white white white white white white white white blue blue blue
Ordered: True

PicoLisp

<lang PicoLisp>(def 'Colors

  (list
     (def 'RED 1)
     (def 'WHITE 2)
     (def 'BLUE 3) ) )

(let (L (make (do 9 (link (get Colors (rand 1 3))))) S (by val sort L))

  (prin "Original balls ")
  (print L)
  (prinl (unless (= L S) " not sorted"))
  (prin "Sorted balls   ")
  (print S)
  (prinl " are sorted") )</lang>

Output:

Original balls (RED BLUE WHITE BLUE BLUE RED WHITE WHITE WHITE) not sorted
Sorted balls   (RED RED WHITE WHITE WHITE WHITE BLUE BLUE BLUE) are sorted

Prolog

Works with SWI-Prolog 6.1.11

Prolog spirit

<lang Prolog>dutch_flag(N) :- length(L, N), repeat, maplist(init,L), \+is_dutch_flag(L) , writeln(L), test_sorted(L), sort_dutch_flag(L, TmpFlag), append(TmpFlag, Flag), writeln(Flag), test_sorted(Flag).

sort_dutch_flag([], [[], [], []]).

sort_dutch_flag([blue | T], [R, W, [blue|B]]) :- sort_dutch_flag(T, [R, W, B]).

sort_dutch_flag([red | T], [[red|R], W, B]) :- sort_dutch_flag(T, [R, W, B]).

sort_dutch_flag([white | T], [R, [white | W], B]) :- sort_dutch_flag(T, [R, W, B]).

init(C) :- R is random(3), nth0(R, [blue, red, white], C).

test_sorted(Flag) :- ( is_dutch_flag(Flag) -> write('it is a dutch flag') ; write('it is not a dutch flag')), nl,nl.

% First color must be red is_dutch_flag([red | T]) :- is_dutch_flag_red(T).

is_dutch_flag_red([red|T]) :- is_dutch_flag_red(T); % second color must be white T = [white | T1], is_dutch_flag_white(T1).

is_dutch_flag_white([white | T]) :- is_dutch_flag_white(T); % last one must be blue T = [blue | T1], is_dutch_flag_blue(T1).

is_dutch_flag_blue([blue | T]) :- is_dutch_flag_blue(T).

is_dutch_flag_blue([]). </lang> Output :

 ?- dutch_flag(20).
[blue,white,white,blue,blue,blue,red,blue,red,blue,blue,blue,white,red,red,blue,blue,red,blue,red]
it is not a dutch flag

[red,red,red,red,red,red,white,white,white,blue,blue,blue,blue,blue,blue,blue,blue,blue,blue,blue]
it is a dutch flag
true .

Functional spirit

Use of filters. <lang Prolog>dutch_flag(N) :- length(L, N),

% create the list to sort repeat, maplist(init,L), \+is_dutch_flag(L) , writeln(L), test_sorted(L),

foldl(\X^Y^Z^(Y = [Red, White, Blue], ( X = blue -> append_dl(Blue, [X|U]-U, Blue1), Z = [Red, White, Blue1]  ; X = red -> append_dl(Red, [X|U]-U, Red1), Z = [Red1, White, Blue]  ; append_dl(White, [X|U]-U, White1), Z = [Red, White1, Blue])), L, [R-R, W-W, B-B], [R1, W1, B1]), append_dl(R1, W1, B1, Flag-[]), write(Flag), nl, test_sorted(Flag).

% append lists in O(1) append_dl(A-B, B-C, A-C). append_dl(A-B, B-C, C-D, A-D).

init(C) :- R is random(3), nth0(R, [blue, red, white], C).

test_sorted(Flag) :- ( is_dutch_flag(Flag) -> write('it is a dutch flag') ; write('it is not a dutch flag')), nl,nl.

% First color must be red is_dutch_flag([red | T]) :- is_dutch_flag_red(T).

is_dutch_flag_red([red|T]) :- is_dutch_flag_red(T); % second color must be white T = [white | T1], is_dutch_flag_white(T1).

is_dutch_flag_white([white | T]) :- is_dutch_flag_white(T); % last one must be blue T = [blue | T1], is_dutch_flag_blue(T1).

is_dutch_flag_blue([blue | T]) :- is_dutch_flag_blue(T).

is_dutch_flag_blue([]). </lang>

Python

Python: Sorted

The heart of the idiomatic Dutch sort in python is the call to function sorted in function dutch_flag_sort. <lang python>import random

colours_in_order = 'Red White Blue'.split()

def dutch_flag_sort(items, order=colours_in_order):

   'return sort of items using the given order'
   reverse_index = dict((x,i) for i,x in enumerate(order))
   return sorted(items, key=lambda x: reverse_index[x])

def dutch_flag_check(items, order=colours_in_order):

   'Return True if each item of items is in the given order'
   reverse_index = dict((x,i) for i,x in enumerate(order))
   order_of_items = [reverse_index[item] for item in items]
   return all(x <= y for x, y in zip(order_of_items, order_of_items[1:]))

def random_balls(mx=5):

   'Select from 1 to mx balls of each colour, randomly'
   balls = sum([[colour] * random.randint(1, mx)
                for colour in colours_in_order], [])
   random.shuffle(balls)
   return balls

def main():

   # Ensure we start unsorted
   while True:
       balls = random_balls()
       if not dutch_flag_check(balls):
           break
   print("Original Ball order:", balls)
   sorted_balls = dutch_flag_sort(balls)
   print("Sorted Ball Order:", sorted_balls)
   assert dutch_flag_check(sorted_balls), 'Whoops. Not sorted!'

if __name__ == '__main__':

   main()</lang>

Sample output:

Original Ball order: ['Red', 'Red', 'Blue', 'Blue', 'Blue', 'Red', 'Red', 'Red', 'White', 'Blue']
Sorted Ball Order: ['Red', 'Red', 'Red', 'Red', 'Red', 'White', 'Blue', 'Blue', 'Blue', 'Blue']

Python: sum of filters

This follows the critics section of the wikipedia article by using a sum of filters.

Replace the function/function call dutch_flag_sort above, with dutch_flag_sort2 defined as: <lang python>from itertools import chain def dutch_flag_sort2(items, order=colours_in_order):

   'return summed filter of items using the given order'
   return list(chain.from_iterable(filter(lambda c: c==colour, items)
                                   for colour in order))</lang> 

Or equivalently using a list comprehension (though perhaps less clear): <lang python>def dutch_flag_sort2(items, order=colours_in_order):

   'return summed filter of items using the given order'
   return [c for colour in order for c in items if c==colour]</lang> 

Output follows that of the sorting solution above.

Python: Construct from ball counts

This reconstructs the correct output by counting how many of each colour their are.

Replace the function/function call dutch_flag_sort above, with dutch_flag_sort3 defined as: <lang python>def dutch_flag_sort3(items, order=colours_in_order):

   'counts each colour to construct flag'
   return sum([[colour] * items.count(colour) for colour in order], [])</lang> 

Output follows that of the sorting solution above.

Python: Explicit in-place sort

<lang python>import random

colours_in_order = 'Red White Blue'.split()

def dutch_flag_sort(items):

   \
   In-place sort of list items using the given order.
   Python idiom is to return None when argument is modified in-place

   O(n)? Algorithm from Go language implementation of
   http://www.csse.monash.edu.au/~lloyd/tildeAlgDS/Sort/Flag/

   lo, mid, hi = 0, 0, len(items)-1
   while mid <= hi:
       colour = items[mid]
       if colour == 'Red':
           items[lo], items[mid] = items[mid], items[lo]
           lo += 1
           mid += 1
       elif colour == 'White':
           mid += 1
       else:
           items[mid], items[hi] = items[hi], items[mid]
           hi -= 1

def dutch_flag_check(items, order=colours_in_order):

   'Return True if each item of items is in the given order'
   order_of_items = [order.index(item) for item in items]
   return all(x <= y for x, y in zip(order_of_items, order_of_items[1:]))

def random_balls(mx=5):

   'Select from 1 to mx balls of each colour, randomly'
   balls = sum(([[colour] * random.randint(1, mx)
                for colour in colours_in_order]), [])
   random.shuffle(balls)
   return balls

def main():

   # Ensure we start unsorted
   while 1:
       balls = random_balls()
       if not dutch_flag_check(balls):
           break
   print("Original Ball order:", balls)
   dutch_flag_sort(balls)
   print("Sorted Ball Order:", balls)
   assert dutch_flag_check(balls), 'Whoops. Not sorted!'

if __name__ == '__main__':

   main()</lang>

Output follows that of the sorting solution above.

REXX

colors as words

This version uses a version of a bin sort with counts, and has been generalized to allow any number of colors.

The REXX solution could've been simplified somewhat by the use of the countstr bif (but older REXX interpreters don't have).

<lang rexx>/*REXX pgm to reorder a set of random colored balls into a correct order*/ /*which is the order of colors on the Dutch flag: red, white, blue. */

parse arg N colors /*get user args from command line*/ if N=',' | N= then N=15 /*use default number of balls. */ if N= then N=15 /*use default number of balls. */ if colors= then colors=space('red white blue') /*use default colors.*/ Ncolors=words(colors) /*count the number of colors. */ @=word(colors,Ncolors) word(colors,1) /*ensure balls aren't in order. */

                 do g=3 to N          /*generate a random # of balls.  */
                 @=@ word(colors,random(1,Ncolors))
                 end   /*g*/

say 'number of colored balls generated = ' N  ; say say 'original ball order:' say @  ; say $=; do j=1 for Ncolors;  ; _=word(colors,j)

                             $=$ copies(_' ',countWords(_,@))
                             end   /*j*/

say ' sorted ball order:' say space($); say

   do k=2 to N                        /*ensure the balls are in order. */
   if wordpos(word($,k),colors)>=wordpos(word($,k-1),colors) then iterate
   say "The list of sorted balls isn't in proper order!";   exit 13
   end   /*k*/

say ' sorted ball list has been confirmed as being sorted correctly.' exit /*stick a fork in it, we're done.* /*──────────────────────────────────COUNTWORDS subroutine───────────────*/ countWords: procedure; parse arg ?,hay; s=1

        do r=0 until _==0;  _=wordpos(?,hay,s);  s=_+1;  end;    return r</lang>

output when using the default input:

number of colored balls generated =  15

original ball order:
blue red white white white white red blue white red blue red blue white red

 sorted  ball order:
red red red red red white white white white white white blue blue blue blue

 sorted  ball list has been confirmed as being sorted correctly.

colors as letters

<lang rexx>/*REXX pgm to reorder a set of random colored balls into a correct order*/ /*which is the order of colors on the Dutch flag: red, white, blue. */

parse arg N colors . /*get user args from command line*/ if N==',' | N== then N=15 /*use default number of balls. */ if colors= then colors='RWB' /*default: R=red, W=white, B=blue*/ Ncolors=length(colors) /*count the number of colors. */ @=right(colors,1)left(colors,1) /*ensure balls aren't in order. */

                 do g=3 to N          /*generate a random # of balls.  */
                 @=@ || substr(colors,random(1,Ncolors),1)
                 end   /*g*/

say 'number of colored balls generated = ' N  ; say say 'original ball order:' say @  ; say $=; do j=1 for Ncolors; _=substr(colors,j,1)

                             #=length(@)-length(space(translate(@,,_),0))
                             $=$||copies(_,#)
                             end   /*j*/

say ' sorted ball order:' say $; say

   do k=2 to N                        /*ensure the balls are in order. */
   if pos(substr($,k,1),colors)>=pos(substr($,k-1,1),colors) then iterate
   say "The list of sorted balls isn't in proper order!";   exit 13
   end   /*k*/

say ' sorted ball list has been confirmed as being sorted correctly.'

                                      /*stick a fork in it, we're done.*/</lang>

output when using the default input:

number of colored balls generated =  15

original ball order:
BRBRRRWRBWRBBBR

 sorted  ball order:
RRRRRRRWWBBBBBB

 sorted  ball list has been confirmed as being sorted correctly.

Tcl

This isn't very efficient in terms of the sorting itself (and it happens to use lsearch twice in the comparator!) but it is very simple to write like this. <lang tcl># The comparison function proc dutchflagcompare {a b} {

   set colors {red white blue}
   return [expr {[lsearch $colors $a] - [lsearch $colors $b]}]

}

1. The test function (evil shimmer of list to string!)

proc isFlagSorted lst {

   expr {![regexp {blue.*(white|red)} $lst] && ![regexp {white.*red} $lst]}

}

1. A ball generator

proc generateBalls n {

   for {set i 0} {$i<$n} {incr i} {

lappend result [lindex {red white blue} [expr {int(rand()*3)}]]

   }
   return $result

}

1. Do the challenge with 20 balls

set balls [generateBalls 20] if {[isFlagSorted $balls]} {

   error "already a sorted flag"

} set sorted [lsort -command dutchflagcompare $balls] if {[isFlagSorted $sorted]} {

   puts "Sorted the flag\n$sorted"

} else {

   puts "sort failed\n$sorted"

}</lang>

Output:

Sorted the flag
red red red red red red red white white white white white white white white white blue blue blue blue