Dutch national flag problem

From Rosetta Code
Task
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.

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

AutoIt

Given each color a value in descending order ( Red = 1, White = 2 And Blue = 3) <lang Autoit>

  1. include <Array.au3>

Dutch_Flag(50) Func Dutch_Flag($arrayitems) Local $avArray[$arrayitems] For $i = 0 To UBound($avArray) - 1 $avArray[$i] = Random(1, 3, 1) Next Local $low = 2, $high = 3, $i = 0 Local $arraypos = -1 Local $p = UBound($avArray) - 1 While $i < $p if $avArray[$i] < $low Then $arraypos += 1 _ArraySwap($avArray[$i], $avArray[$arraypos]) $i += 1 ElseIf $avArray[$i] >= $high Then _ArraySwap($avArray[$i], $avArray[$p]) $p -= 1 Else $i += 1 EndIf WEnd _ArrayDisplay($avArray) EndFunc  ;==>Dutch_Flag </lang>


AutoHotKey

<lang AutoHotKey> label2: random, k, 1, 10 ; increase 10 to the highest no. of balls that could possible be taken loop, % k { random, random_list, 1, 3 l .= random_list "," }

IfNotInString, l, 1 goto, label2

IfNotInString, l, 2 goto, label2

IfNotInString, l, 3 goto, label2



gosub, label Clip := l_w . "random list" . "`r`n" Sort l, N D, gosub, label Clip .= l_w . "sorted list" MsgBox % Clip exitapp label: l_R := RegExReplace(l, "1", "R") l_B := RegExReplace(l_R, "2", "B") l_W := RegExReplace(l_B, "3", "W") return </lang>

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> INSTALL @lib$+"SORTLIB" 

     Sort% = FN_sortinit(0,0)
     
     nBalls% = 12
     DIM Balls$(nBalls%-1), Weight%(nBalls%-1), DutchFlag$(2)
     DutchFlag$() = "Red ", "White ", "Blue "
     
     REM. Generate random list of balls, ensuring not sorted:
     REPEAT
       prev% = 0 : sorted% = TRUE
       FOR ball% = 0 TO nBalls%-1
         index% = RND(3) - 1
         Balls$(ball%) = DutchFlag$(index%)
         IF index% < prev% THEN sorted% = FALSE
         prev% = index%
       NEXT
     UNTIL NOT sorted%
     PRINT "Random list: " SUM(Balls$())
     
     REM. Assign Dutch Flag weightings to ball colours:
     DutchFlag$ = SUM(DutchFlag$())
     FOR ball% = 0 TO nBalls%-1
       Weight%(ball%) = INSTR(DutchFlag$, Balls$(ball%))
     NEXT
     
     REM. Sort into Dutch Flag colour sequence:
     C% = nBalls%
     CALL Sort%, Weight%(0), Balls$(0)
     PRINT "Sorted list: " SUM(Balls$())
     
     REM Final check:
     prev% = 0 : sorted% = TRUE
     FOR ball% = 0 TO nBalls%-1
       weight% = INSTR(DutchFlag$, Balls$(ball%))
       IF weight% < prev% THEN sorted% = FALSE
       prev% = weight%
     NEXT
     IF NOT sorted% PRINT "Error: Balls are not in correct order!"</lang>

Output: 

Random list: Red White Red Blue White Red White Blue Red Red Blue Red
Sorted list: Red Red Red Red Red Red White White White Blue Blue Blue

C

<lang c>#include <stdio.h> //printf()

  1. include <stdlib.h> //srand(), rand(), RAND_MAX, qsort()
  2. include <stdbool.h> //true, false
  3. include <time.h> //time()
  1. define NUMBALLS 5 //NUMBALLS>1

int compar(const void *a, const void *b){ char c1=*(const char*)a, c2=*(const char*)b; //first cast void* to char*, then dereference return c1-c2; }

_Bool issorted(char *balls){ int i,state; state=0; for(i=0;i<NUMBALLS;i++){ if(balls[i]<state)return false; if(balls[i]>state)state=balls[i]; } return true; }

void printout(char *balls){ int i; char str[NUMBALLS+1]; for(i=0;i<NUMBALLS;i++)str[i]=balls[i]==0?'r':balls[i]==1?'w':'b'; printf("%s\n",str); }

int main(void) { char balls[NUMBALLS]; //0=r, 1=w, 2=b int i; srand(time(NULL)); //not a good seed but good enough for the example rand(); //rand() always starts with the same values for certain seeds, making // testing pretty irritating // Generate balls for(i=0;i<NUMBALLS;i++)balls[i]=(double)rand()/RAND_MAX*3; while(issorted(balls)){ //enforce that we start with non-sorted balls printf("Accidentally still sorted: "); printout(balls); for(i=0;i<NUMBALLS;i++)balls[i]=(double)rand()/RAND_MAX*3; } printf("Non-sorted: "); printout(balls); qsort(balls,NUMBALLS,sizeof(char),compar); //sort them using quicksort (stdlib) if(issorted(balls)){ //unnecessary check but task enforces it printf("Sorted: "); printout(balls); } else { printf("Sort failed: "); printout(balls); } return 0; }</lang>

Output:
Accidentally still sorted:rrrww
Non-sorted: rbwww
Sorted: rwwwb

C_sharp

<lang csharp>using System; using System.Collections.Generic; using System.Linq; using System.Text;

namespace RosettaCode { 

   class Program
   {
       static void QuickSort(IComparable[] elements, int left, int right)
       {
           int i = left, j = right;
           IComparable pivot = elements[left + (right - left) / 2];

           while (i <= j)
           {
               while (elements[i].CompareTo(pivot) < 0) i++;
               while (elements[j].CompareTo(pivot) > 0) j--;

               if (i <= j)
               {
                   // Swap
                   IComparable tmp = elements[i];
                   elements[i] = elements[j];
                   elements[j] = tmp;
                   i++;
                   j--;
               }
           }

           // Recursive calls
           if (left < j) QuickSort(elements, left, j);
           if (i < right) QuickSort(elements, i, right);
       }
       const int NUMBALLS = 5;
       static void Main(string[] args)
       {
           Func<string[], bool> IsSorted = (ballList) =>
               {
                   int state = 0;
                   for (int i = 0; i < NUMBALLS; i++)
                   {
                       if (int.Parse(ballList[i]) < state)
                           return false;
                       if (int.Parse(ballList[i]) > state)
                           state = int.Parse(ballList[i]);
                   }
                   return true;
               };
           Func<string[], string> PrintOut = (ballList2) =>
               {
                   StringBuilder str = new StringBuilder();
                   for (int i = 0; i < NUMBALLS; i++)
                       str.Append(int.Parse(ballList2[i]) == 0 ? "r" : int.Parse(ballList2[i]) == 1 ? "w" : "b");
                   return str.ToString();
               };
           bool continueLoop = true;
           string[] balls = new string[NUMBALLS]; // 0 = r, 1 = w, 2 = b
           Random numberGenerator = new Random();
           do // Enforce that we start with non-sorted balls
           {
               // Generate balls
               for (int i = 0; i < NUMBALLS; i++)
                   balls[i] = numberGenerator.Next(3).ToString();

               continueLoop = IsSorted(balls);
               if (continueLoop)
                   Console.WriteLine("Accidentally still sorted: {0}", PrintOut(balls));
           } while (continueLoop);
           Console.WriteLine("Non-sorted: {0}", PrintOut(balls));
           QuickSort(balls, 0, NUMBALLS - 1); // Sort them using quicksort
           Console.WriteLine("{0}: {1}", IsSorted(balls) ? "Sorted" : "Sort failed", PrintOut(balls));
       }
   }

} </lang>

C++

<lang cpp>#include <algorithm>

  1. include <iostream>

// Dutch national flag problem template <typename BidIt, typename T> void dnf_partition(BidIt first, BidIt last, const T& low, const T& high) { 

   for (BidIt next = first; next != last; ) {
       if (*next < low) {
           std::iter_swap(first++, next++);
       } else if (!(*next < high)) {
           std::iter_swap(next, --last);
       } else {
           ++next;
       }
   }

}

enum Colors { RED, WHITE, BLUE };

void print(const Colors *balls, size_t size) { 

   static const char *label[] = { "red", "white", "blue" };

   std::cout << "Balls:";
   for (size_t i = 0; i < size; ++i) {
       std::cout << ' ' << label[balls[i]];
   }
   std::cout << "\nSorted: " << std::boolalpha << std::is_sorted(balls, balls + size) << '\n';

}

int main() { 

   Colors balls[] = { RED, WHITE, BLUE, RED, WHITE, BLUE, RED, WHITE, BLUE };

   std::random_shuffle(balls, balls + 9);
   print(balls, 9);

   dnf_partition(balls, balls + 9, WHITE, BLUE);
   print(balls, 9);

}</lang>

Output:
Balls: blue white red blue red blue white red white
Sorted: false
Balls: red red red white white white blue blue blue
Sorted: true

D

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

enum DutchColors { red, white, blue }

void dutchNationalFlagSort(DutchColors[] items) pure nothrow { 

   int lo, mid, hi = items.length - 1;

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

}

void main() { 

   DutchColors[12] balls;
   foreach (ref ball; balls)
       ball = [EnumMembers!DutchColors][uniform(0, $)];

   writeln("Original Ball order:\n", balls);
   balls.dutchNationalFlagSort();
   writeln("\nSorted Ball Order:\n", balls);
   assert(balls[].isSorted(), "Balls not sorted");

}</lang>

Output:
Original Ball order:
[red, white, white, blue, white, red, red, red, red, red, blue, red]

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

Bidirectional Range Version

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

      std.array, std.traits;

/* This implementation has less requirements, it works with just a Bidirectional Range instead of a Random Access Range.

(Comments modified from "Notes on Programming" by Alexander 

Stepanov.)

 Let us assume that somehow we managed to solve the problem up
 to some middle point s:

 0000001111?????22222222
       ^   ^   ^
       f   s   l         (first, second, last)

 If s points to an item with value 0 (red) we swap it with an
 element pointed at by f and advance both f and s.
 If s refers to an item 1 (white) we just advance s.
 If s refers to an item 2 (blue) we swap elements
 pointed by l and s and we decrement l.

In D/Phobos we use Ranges, that are like pairs of iterators. So 'secondLast' represents the s and l iterators, and the 'first' range contains f plus an unused end.

secondLast represents the inclusive range of items not yet seen. When it's empty, the algorithm has finished.

Loop variant: in each iteration of the for loop the length of secondLast decreases by 1. So the algorithm terminates.

  • /

void dutchNationalFlagSort(Range, T)(Range secondLast, 

                                    in T lowVal, in T highVal)

pure nothrow if (isBidirectionalRange!Range && 

                hasSwappableElements!Range &&
                is(ElementType!Range == T)) {
   for (auto first = secondLast; !secondLast.empty; )
       if (secondLast.front == lowVal) {
           swap(first.front, secondLast.front);
           first.popFront();
           secondLast.popFront();
       } else if (secondLast.front == highVal) {
           swap(secondLast.front, secondLast.back);
           secondLast.popBack();
       } else
           secondLast.popFront();

}

void main() { 

   enum DutchColors { red, white, blue }
   DutchColors[12] balls;
   foreach (ref ball; balls)
       ball = [EnumMembers!DutchColors][uniform(0, $)];

   writeln("Original Ball order:\n", balls);
   balls[].dutchNationalFlagSort(DutchColors.red,
                                 DutchColors.blue);
   writeln("\nSorted Ball Order:\n", balls);
   assert(balls[].isSorted(), "Balls not sorted");

   // More tests:
   foreach (i; 0 .. 100_000) {
       int n = uniform(0, balls.length);
       foreach (ref ball; balls[0 .. n])
           ball = [EnumMembers!DutchColors][uniform(0, $)];
       balls[0 .. n].dutchNationalFlagSort(DutchColors.red,
                                           DutchColors.blue);
       assert(balls[0 .. n].isSorted());
   }

}</lang> The output is the same.

Erlang

<lang erlang>-module(dutch). -export([random_balls/1, is_dutch/1, dutch/1]).

ball(red) -> 1; ball(white) -> 2; ball(blue) -> 3.

random_ball() -> lists:nth(random:uniform(3), [red, white, blue]).

random_balls(N) -> random_balls(N,[]). random_balls(0,L) -> L; random_balls(N,L) when N > 0 -> 

 B = random_ball(),
 random_balls(N-1, [B|L]).

is_dutch([]) -> true; is_dutch([_]) -> true; is_dutch([B|[H|L]]) -> (ball(B) < ball(H)) and is_dutch([H|L]); is_dutch(_) -> false.

dutch(L) -> dutch([],[],[],L).

dutch(R, W, B, []) -> R ++ W ++ B; dutch(R, W, B, [red | L]) -> dutch([red|R], W, B, L); dutch(R, W, B, [white | L]) -> dutch(R, [white|W], B, L); dutch(R, W, B, [blue | L]) -> dutch(R, W, [blue|B], L).</lang>

Sample usage: <lang erlang>main(_) -> 

  L = random_balls(10),
  case is_dutch(L) of
    true  -> io:format("The random sequence ~p is already in the order of the Dutch flag!~n", [L]);
    false -> io:format("The starting random sequence is ~p;~nThe ordered sequence is ~p.~n", [L, dutch(L)])
  end.</lang>

Sample output: 

The starting random sequence is [white,white,blue,blue,white,red,white,blue,
                                 blue,white];
The ordered sequence is [red,white,white,white,white,white,blue,blue,blue,
                         blue].

Fortran

Please find the example run along with compilation instructions on a GNU/linux platform in the comments at the beginning of the FORTRAN 2008 program source. The Netherlands program, using equal numbers of colors, solved the problem at three sample sizes. Swaps number 2/3 the total of samples, convincingly demonstrating the O(n) time behavior that's directly provable by inspection. The color strings are chosen for ASCII sort. Feature not used.

Abhor code duplication. I've repeated code anyway to demonstrate FORTRAN pointers, which behave like an alias. A subroutine with traditional arguments including the number of valid elements of the array is appropriate. I'd use one long array instead of 3 arrays and the size intrinsic. <lang> !-*- mode: compilation; default-directory: "/tmp/" -*- !Compilation started at Mon Jun 3 11:18:24 ! !a=./f && make FFLAGS='-O0 -g' $a && OMP_NUM_THREADS=2 $a < unixdict.txt !gfortran -std=f2008 -O0 -g -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f ! Original and flag sequences ! WHITE RED blue blue RED WHITE WHITE WHITE blue RED RED blue ! RED RED RED RED WHITE WHITE WHITE WHITE blue blue blue blue ! 12 items, 8 swaps. ! 999 items, 666 swaps. ! 9999 items, 6666 swaps. ! !Compilation finished at Mon Jun 3 11:18:24

program Netherlands 

 character(len=6), parameter, dimension(3) :: colors = (/'RED   ', 'WHITE ', 'blue  '/)
 integer, dimension(12) :: sort_me
 integer, dimension(999), target :: a999
 integer, dimension(9999), target :: a9999
 integer, dimension(:), pointer  :: pi
 integer :: i, swaps
 data sort_me/4*1,4*2,4*3/
 call shuffle(sort_me, 5)
 write(6,*)'Original and flag sequences'
 write(6,*) (colors(sort_me(i)), i = 1, size(sort_me))
 call partition3way(sort_me, 2, swaps)
 write(6,*) (colors(sort_me(i)), i = 1, size(sort_me))
 write(6,*) 12,'items,',swaps,' swaps.'
 pi => a999
 do i=1, size(pi)
   pi(i) = 1 + L(size(pi)/3 .lt. i) + L(2*size(pi)/3 .lt. i)
 end do
 call shuffle(pi, size(pi)/3+1)
 call partition3way(pi, 2, swaps)
 write(6,*) size(pi),'items,',swaps,' swaps.'
 pi => a9999
 do i=1, size(pi)
   pi(i) = 1 + L(size(pi)/3 .lt. i) + L(2*size(pi)/3 .lt. i)
 end do
 call shuffle(pi, size(pi)/3+1)
 call partition3way(pi, 2, swaps)
 write(6,*) size(pi),'items,',swaps,' swaps.'

contains 

 integer function L(q)
   ! In Ken Iverson's spirit, APL logicals are more useful as integers.
   logical, intent(in) :: q
   if (q) then
     L = 1
   else
     L = 0
   end if
 end function L

 subroutine swap(a,i,j)
   integer, dimension(:), intent(inout) :: a
   integer, intent(in) :: i, j
   integer :: t
   t = a(i)
   a(i) = a(j)
   a(j) = t
 end subroutine swap

 subroutine partition3way(a, pivot, swaps)
   integer, dimension(:), intent(inout) :: a
   integer, intent(in) :: pivot
   integer, intent(out) :: swaps
   integer :: i, j, k
   swaps = 0
   i = 0
   j = 1
   k = size(a) + 1
   do while (j .lt. k)
     if (pivot .eq. a(j)) then
       j = j+1
       swaps = swaps-1
     else if (pivot .lt. a(j)) then
       k = k-1
       call swap(a, k, j)
     else
       i = i+1
       call swap(a, i, j)
       j = j+1
     end if
     swaps = swaps+1
   end do
 end subroutine partition3way

 subroutine shuffle(a, n) ! a rather specialized shuffle not for general use
   integer, intent(inout), dimension(:) :: a
   integer, intent(in) :: n
   integer :: i, j, k
   real :: harvest
   do i=1, size(a)-1
     call random_number(harvest)
     harvest = harvest - epsilon(harvest)*L(harvest.eq.1)
     k = L(i.eq.1)*(n-1) + i
     j = i + int((size(a) - k) * harvest)
     call swap(a, i, j)
   end do
 end subroutine shuffle

end program Netherlands </lang>

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}]

Haskell

With the Color data type we take care that no other values than Red, White and Blue can be used. The "deriving" clause is a key aspect: We want Haskell to make Color automatically an instance of the classes Show, Eq, Ord and Enum. - Show means that Haskell can convert the data constructors Red, White and Blue to text. - Eq means that two values of type Color can be compared for equality, as if they were numbers or characters. - Ord means that one can sort a list of values of type Color according to the order in which the constructors Red, White and Blue were declared. We don't need to check if the order of the colors is right - it just is. - Enum menas that Red, White and Blue are automatically enumerated: every constructor is assigned to an integer.

The function "sort" works with anything that belongs to the Eq and Ord classes. The function "randomRIO" takes a range of two integers to give a random value within the range. We make Color an instance of Enum so that we can give Red, White and Blue as integers to randomRIO and convert the random number back to Red, White or Blue. <lang Haskell>import Data.List (sort) import System.Random (randomRIO) import System.IO.Unsafe (unsafePerformIO)

data Color = Red | White | Blue deriving (Show, Eq, Ord, Enum)

dutch :: [Color] -> [Color] dutch = sort

isDutch :: [Color] -> Bool isDutch x = x == dutch x

randomBalls :: Int -> [Color] randomBalls 0 = [] randomBalls n = toEnum (unsafePerformIO (randomRIO (fromEnum Red, 

   fromEnum Blue))) : randomBalls (n - 1)

main :: IO () main = do 

   let a = randomBalls 20
   case isDutch a of
       True -> putStrLn $ "The random sequence " ++ show a ++
           " is already in the order of the Dutch national flag!"
       False -> do
           putStrLn $ "The starting random sequence is " ++ show a ++ "\n"
           putStrLn $ "The ordered sequence is " ++ show (dutch a)</lang>

Output: 

The starting random sequence is [White,Blue,Blue,Blue,Blue,Blue,Blue,Red,Red,
White,White,Blue,White,White,Red,White,Blue,White,Red,Red]

The ordered sequence is [Red,Red,Red,Red,Red,White,White,White,White,White,
White,White,Blue,Blue,Blue,Blue,Blue,Blue,Blue,Blue]

To understand why Dijsktra was interested in the problem, here's an example showing difficiency of using generic sort: <lang haskell>inorder n = and $ zipWith (<=) n (tail n) -- or use Data.List.Ordered

mk012 :: Int -> Int -> [Int] -- definitely unordered mk012 n = (++[0]).(2:).map (`mod` 3).take n.frr where -- frr = Fast Rubbish Randoms frr = tail . iterate (\n -> n * 7 + 13)

dutch1 n = (filter (==0) n)++(filter (==1) n)++(filter (==2) n)

dutch2 n = a++b++c where (a,b,c) = foldl f ([],[],[]) n -- scan list once; it *may* help f (a,b,c) x = case x of 0 -> (0:a, b, c) 1 -> (a, x:b, c) 2 -> (a, b, x:c)

main = do -- 3 methods, comment/uncomment each for speed comparisons -- print $ inorder $ sort s -- O(n log n) -- print $ inorder $ dutch1 s -- O(n) print $ inorder $ dutch2 s -- O(n) where s = mk012 10000000 42</lang>

Icon and Unicon

The following solution works in both languages.

The problem statement isn't clear on whether the randomized list of balls has to contain at least one of each color. The approach below assumes that you can have no balls of a given color (including no balls at all - though that makes ensuring they're not properly sorted at the start hard...). To force at least one of each color ball, change "?n-1" to "?n" in the 3rd line.

<lang unicon>procedure main(a) 

   n := integer(!a) | 20
   every (nr|nw|nb) := ?n-1
   sIn := repl("r",nw)||repl("w",nb)||repl("b",nr)
   write(sRand := bestShuffle(sIn))
   write(sOut := map(csort(map(sRand,"rwb","123")),"123","rwb"))
   if sIn ~== sOut then write("Eh? Not in correct order!")

end

procedure bestShuffle(s) # (Taken from the Best Shuffle task) 

   t := s
   every !t :=: ?t    # Uncommented to get a random best shuffling
   every i := 1 to *t do
       every j := (1 to i-1) | (i+1 to *t) do
          if (t[i] ~== s[j]) & (s[i] ~== t[j]) then break t[i] :=: t[j]
   return t

end

procedure csort(w) 

   every (s := "") ||:= (find(c := !cset(w),w),c)
   return s

end</lang>

A few sample runs: 

->dutch
bwwwwwwwwwrrrrrrbbbrrbrwwwrw
rrrrrrrrrrwwwwwwwwwwwwwbbbbb
->dutch
bbbbbbrbbbbbbrwwrwwrwwwwrw
rrrrrwwwwwwwwwbbbbbbbbbbbb
->dutch
bbbbbbbbbwbbwrrrrrrrrrwrrwwrr
rrrrrrrrrrrrrwwwwwbbbbbbbbbbb
->dutch
wbrbrrwwrbrbwrrrrrrwrrrrrrrrr
rrrrrrrrrrrrrrrrrrrrwwwwwbbbb
->

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>


Lasso

<lang Lasso>define orderdutchflag(a) => { local(r = array, w = array, b = array) with i in #a do => { match(#i) => { case('Red') #r->insert(#i) case('White') #w->insert(#i) case('Blue') #b->insert(#i) } } return #r + #w + #b }

orderdutchflag(array('Red', 'Red', 'Blue', 'Blue', 'Blue', 'Red', 'Red', 'Red', 'White', 'Blue'))</lang>

Output:
array(Red, Red, Red, Red, Red, White, Blue, Blue, Blue, Blue)

<lang logo>; We'll just use words for the balls make "colors {red white blue}

to get a mapping from colors back to a numeric value,
we make variables out of the color names (e.g. the variable
"red" has value "1").

foreach arraytolist :colors [ 

 make ? #

]

Make a random list of a given size

to random_balls :n 

 local "balls
 make "balls array n
 repeat n [
   setitem # :balls pick :colors
 ]
 output :balls

end

Test for Dutchness

to dutch? :array 

  output dutchlist? arraytolist :array

end

List is easier than array to test

to dutchlist? :list 

 output cond [
   [(less? count :list 2) "true]
   [(greater? thing first :list thing item 2 :list) "false ]
   [else dutchlist? butfirst :list]
 ]

end

But array is better for sorting algorithm

to dutch :array 

 local "lo
 make "lo 0
 local "hi
 make "hi sum 1 count :array
 local "i
 make "i 1
 while [:i < :hi] [
   case (item :i :array) [
     [[red]
        make "lo sum :lo 1
        swap :array :lo :i
        make "i sum :i 1
     ]
     [[white]
        make "i sum :i 1
     ]
     [[blue]
        make "hi difference :hi 1
        swap :array :hi :i
     ]
   ]
 ]
 output :array

end

utility routine to swap array elements

to swap :array :a :b 

 local "temp
 make "temp item :a :array
 setitem :a :array item :b :array
 setitem :b :array :temp

end</lang>

Test code: <lang>do.while [ 

 make "list random_balls 10

] [dutch? :list]

print (sentence [Start list:] arraytolist :list) print (sentence [Sorted:] arraytolist dutch :list) bye</lang>

Output: 

Start list: white blue red red red white blue red red white
Sorted: red red red red red white white white blue blue

Mathematica

<lang Mathematica>flagSort[data_List] := Sort[data, (#1 === RED || #2 === BLUE) &]</lang>

Output:
flagSort[{WHITE, RED, RED, WHITE, WHITE, BLUE, WHITE, BLUE, BLUE, WHITE, WHITE, BLUE}]

{RED, RED, WHITE, WHITE, WHITE, WHITE, WHITE, WHITE, BLUE, BLUE, BLUE, BLUE}

PARI/GP

A counting sort might be more appropriate here, but that would conceal the details of the sort. <lang parigp>compare(a,b)={ 

 if (a==b,
   0
 ,
  if(a=="red" || b=="blue", -1, 1)
 )

}; r(n)=vector(n,i,if(random(3),if(random(2),"red","white"),"blue")); inorder(v)=for(i=2,#v,if(compare(v[i-1],v[i])>0,return(0)));1;

v=r(10); while(inorder(v), v=r(10)); v=vecsort(v,compare); inorder(v)</lang>

Output: 

1

Perl

The task is probably not to just sort an array. The wikipedia links has a slightly better explanation that leads to the following code: <lang perl>#!/usr/bin/perl

Task
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.

use strict; use 5.010; # //

use List::Util qw( shuffle );

my @colours = qw( blue white red );

sub are_ordered { 

   my $balls = shift;
   my $last = 0;
   for my $ball (@$balls) {
       return if $ball < $last;
       $last = $ball;
   }
   return 1;

}


sub show { 

   my $balls = shift;
   print join(' ', map $colours[$_], @$balls), "\n";

}


sub debug { 

   return unless $ENV{DEBUG};

   my ($pos, $top, $bottom, $balls) = @_;
   for my $i (0 .. $#$balls) {
       my ($prefix, $suffix) = (q()) x 2;

       ($prefix, $suffix) = qw/( )/ if $i == $pos;
       $prefix           .= '>'     if $i == $top;
       $suffix           .= '<'     if $i == $bottom;

       print STDERR " $prefix$colours[$balls->[$i]]$suffix";
   }
   print STDERR "\n";

}


my $count = shift // 10; die "$count: Not enough balls\n" if $count < 3;

my $balls = [qw( 2 1 0 )]; push @$balls, int rand 3 until @$balls == $count; do { @$balls = shuffle @$balls } while are_ordered($balls);

show($balls);

my $top = 0; my $bottom = $#$balls;

my $i = 0; while ($i <= $bottom) { 

   debug($i, $top, $bottom, $balls);
   my $col = $colours[ $balls->[$i] ];
   if ('red' eq $col and $i < $bottom) {
       @{$balls}[$bottom, $i] = @{$balls}[$i, $bottom];
       $bottom--;
   } elsif ('blue' eq $col and $i > $top) {
       @{$balls}[$top, $i] = @{$balls}[$i, $top];
       $top++;
   } else {
       $i++;
   }

} debug($i, $top, $bottom, $balls);

show($balls); are_ordered($balls) or die "Incorrect\n";</lang> You can run it with no parameters, it sorts 10 balls in such a case. If you provide one parameter, it is used as the number of balls. The second parameter turns on debugging that shows how the balls are being swapped.

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.

Racket

<lang Racket>

  1. lang racket

(define dutch-colors '(red white blue))

(define (dutch-order? balls) 

 ;; drop each color from the front, should end up empty
 (null? (for/fold ([r balls]) ([color dutch-colors])
          (dropf r (curry eq? color)))))

(define (random-balls) 

 (define balls
   (for/list ([i (random 20)])
     (list-ref dutch-colors (random (length dutch-colors)))))
 (if (dutch-order? balls) (random-balls) balls))
first method
use a key to map colors to integers

(define (order->key order) 

 (let ([alist (for/list ([x order] [i (in-naturals)]) (cons x i))])
   (λ(b) (cdr (assq b alist)))))

(define (sort-balls/key balls) 

 (sort balls < #:key (order->key dutch-colors)))
second method
use a comparator built from the ordered list

(define ((order<? ord) x y) 

 (memq y (cdr (memq x ord))))

(define (sort-balls/compare balls) 

 (sort balls (order<? dutch-colors)))

(define (test sort) 

 (define balls (random-balls))
 (define sorted (sort balls))
 (printf "Testing ~a:\n  Random: ~s\n  Sorted: ~s\n      ==> ~s\n"
         (object-name sort)
         balls sorted (if (dutch-order? sorted) 'OK 'BAD)))

(for-each test (list sort-balls/key sort-balls/compare)) </lang>

Sample output: 

Testing sort-balls/order:
  Random: (red blue blue white red blue red red blue blue red red white blue)
  Sorted: (red red red red red red white white blue blue blue blue blue blue)
      ==> OK
Testing sort-balls/compare:
  Random: (red blue white blue white white white blue red blue blue blue white)
  Sorted: (red red white white white white white blue blue blue blue blue blue)
      ==> OK

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.

Ruby

<lang ruby>module Dutch 

 # Could use a class for the balls, but that's a little heavy.
 # We'll just use symbols.

 # List of colors, in order
 Symbols = [:red, :white, :blue]

 # Reverse map from symbol to numeric value
 Values  = Hash[Symbols.each_with_index.to_a]

 # Pick a color at random
 def self.random_ball
   Symbols[rand 3]
 end

 # But we will use a custom subclass of Array for the list of balls
 class Balls < Array

   # Generate a given-sized list of random balls
   def self.random(n)
     self.new(n.times.map { Dutch.random_ball })
   end

   # Test to see if the list is already in order
   def dutch?
      return true if length < 2
      Values[self[0]] < Values[self[1]] && slice(1..-1).dutch?
   end

   # Traditional in-place sort
   def dutch!
     lo = -1
     hi = length
     i = 0
     while i < hi do
       case self[i]
         when :red
           lo += 1
           self[lo], self[i] = self[i], self[lo]
           i += 1
         when :white
           i += 1
         when :blue
           hi -= 1
           self[hi], self[i] = self[i], self[hi]
       end
     end
     self
   end

   # Recursive, non-self-modifying version
   def dutch(acc = { :red => 0, :white => 0, :blue => 0})
     return self.class.new(
       Symbols.map { |c| [c] * acc[c] }.inject(&:+)
     ) if length == 0
     acc[first]+=1
     return slice(1..-1).dutch( acc )
   end
 end

end</lang>

Driver/test code: <lang ruby>balls = nil while balls.nil? or balls.dutch? do 

 balls = Dutch::Balls.random 8

end puts "Start: #{balls}" puts "Sorted: #{balls.dutch}" puts "Intact: #{balls}" puts "In-place: #{balls.dutch!}" puts "Modified: #{balls}"</lang>

Output: 

Start: [:red, :blue, :red, :white, :red, :red, :white, :blue]
Sorted: [:red, :red, :red, :red, :white, :white, :blue, :blue]
Intact: [:red, :blue, :red, :white, :red, :red, :white, :blue]
In-place: [:red, :red, :red, :red, :white, :white, :blue, :blue]
Modified: [:red, :red, :red, :red, :white, :white, :blue, :blue]

Run BASIC

<lang runbasic>flag$ = "Red,White,Blue"

print "Random: |"; for i = 1 to 10 color = rnd(0) * 3 + 1 balls$(i) = word$(flag$,color,",") print balls$(i);" |"; next i

print :print "Sorted: |"; for i = 1 to 3 

color$ = word$(flag$,i,",")
for j = 1 to 10
 if balls$(j) = color$ then 
   print balls$(j);" |";
 end if

next j next i</lang> 

Random: |White |Blue |White |Red |Red |White |Red |Blue |Red |White |
Sorted: |Red |Red |Red |Red |White |White |White |White |Blue |Blue |

SQL

<lang SQL>-- Create and populate tables create table colours (id integer primary key, name varchar(5)); insert into colours (id, name) values ( 1, 'red' ); insert into colours (id, name) values ( 2, 'white'); insert into colours (id, name) values ( 3, 'blue' );

create table balls ( colour integer references colours ); insert into balls ( colour ) values ( 2 ); insert into balls ( colour ) values ( 2 ); insert into balls ( colour ) values ( 3 ); insert into balls ( colour ) values ( 2 ); insert into balls ( colour ) values ( 1 ); insert into balls ( colour ) values ( 3 ); insert into balls ( colour ) values ( 3 ); insert into balls ( colour ) values ( 2 );

-- Show the balls are unsorted select colours.name from balls join colours on balls.colour = colours.id;

-- Show the balls in dutch flag order select colours.name from balls join colours on balls.colour = colours.id order by colours.id;

-- Tidy up drop table balls; drop table colours;</lang>

Output:
COLOUR
------
white
white
blue
white
red
blue
blue
white


COLOUR
------
red
white
white
white
white
blue
blue
blue
  1. Generating a randomized order of balls ensuring that they are not in the order of the Dutch national flag. Hmm - just loaded some data - could do better here...
  2. Sort the balls in a way idiomatic to your language. Yup!
  3. Check the sorted balls are in the order of the Dutch national flag. Not checked beyond eyeballing - is there a db implementation that gets order by wrong??

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

UNIX Shell

Works with: Bash

<lang bash>COLORS=(red white blue)

  1. to go from name to number, we make variables out of the color names (e.g. the
  2. variable "$red" has value "1").

for (( i=0; i<${#COLORS[@]}; ++i )); do 

 eval ${COLORS[i]}=$i

done

  1. Make a random list

function random_balls { 

 local -i n="$1"
 local -i i
 local balls=()
 for (( i=0; i < n; ++i )); do
   balls+=("${COLORS[RANDOM%${#COLORS[@]}]}")
 done
 echo "${balls[@]}"

}

  1. Test for Dutchness

function dutch? { 

 if (( $# < 2 )); then
    return 0
 else
   local first="$1"
   shift
   if eval "(( $first > $1 ))"; then
     return 1
   else
     dutch? "$@"
   fi
 fi

}

  1. Sort into order

function dutch { 

 local -i lo=-1 hi=$# i=0
 local a=("$@")
 while (( i < hi )); do
   case "${a[i]}" in
     red)
       let lo+=1
       local t="${a[lo]}"
       a[lo]="${a[i]}"
       a[i]="$t"
       let i+=1
       ;;
     white) let i+=1;;
     blue)
       let hi-=1
       local t="${a[hi]}"
       a[hi]="${a[i]}"
       a[i]="$t"
       ;;
   esac
 done
 echo "${a[@]}"

}</lang>

Test code: <lang bash>declare -i len=${1:-10} balls=() while (( ${#balls[@]} < len )) || dutch? "${balls[@]}"; do 

 balls=($(random_balls "$len"))

done echo "Initial list: ${balls[@]}" balls=($(dutch "${balls[@]}")) echo "Sorted: ${balls[@]}"</lang>

Sample output: 

Initial list: blue blue red blue red blue blue white blue red
Sorted: red red red white blue blue blue blue blue blue
Retrieved from "https://rosettacode.org/wiki/Dutch_national_flag_problem?oldid=216375"