report z_dutch_national_flag_problem.

interface sorting_problem.
  methods:
    generate_unsorted_sequence
      importing
        lenght_of_sequence       type int4
      returning
        value(unsorted_sequence) type string,

    sort_sequence
      changing
        sequence_to_be_sorted type string,

    is_sorted
      importing
        sequence_to_check type string
      returning
        value(sorted)     type abap_bool.
endinterface.

class dutch_national_flag_problem definition.
  public section.
    interfaces:
      sorting_problem.

    constants:
      begin of dutch_flag_colors,
        red   type char1 value 'R',
        white type char1 value 'W',
        blue  type char1 value 'B',
      end of dutch_flag_colors.
endclass.

class dutch_national_flag_problem implementation.
  method sorting_problem~generate_unsorted_sequence.
    data(random_int_generator) = cl_abap_random_int=>create(
      seed = cl_abap_random=>seed( )
      min = 0
      max = 2 ).

    do lenght_of_sequence - 1 times.
      data(random_int) = random_int_generator->get_next( ).

      data(next_color) = cond char1(
        when random_int eq 0 then dutch_flag_colors-red
        when random_int eq 1 then dutch_flag_colors-white
        when random_int eq 2 then dutch_flag_colors-blue ).

      unsorted_sequence = |{ unsorted_sequence }{ next_color }|.
    enddo.

    if strlen( unsorted_sequence ) > 0.
      random_int = random_int_generator->get_next( ).

      next_color = cond char1(
        when random_int eq 0 or random_int eq 2 then dutch_flag_colors-red
        when random_int eq 1 then dutch_flag_colors-white ).

      unsorted_sequence = |{ unsorted_sequence }{ next_color }|.
    endif.
  endmethod.

  method sorting_problem~sort_sequence.
    data(low_index) = 0.
    data(middle_index) = 0.
    data(high_index) = strlen( sequence_to_be_sorted ) - 1.

    while middle_index <= high_index.
      data(current_color) = sequence_to_be_sorted+middle_index(1).

      if current_color eq dutch_flag_colors-red.
        data(buffer) = sequence_to_be_sorted+low_index(1).

        sequence_to_be_sorted = replace(
          val = sequence_to_be_sorted
          off = middle_index
          len = 1
          with = buffer ).

        sequence_to_be_sorted = replace(
          val = sequence_to_be_sorted
          off = low_index
          len = 1
          with = current_color ).

        low_index = low_index + 1.

        middle_index = middle_index + 1.
      elseif current_color eq dutch_flag_colors-blue.
        buffer = sequence_to_be_sorted+high_index(1).

        sequence_to_be_sorted = replace(
          val = sequence_to_be_sorted
          off = middle_index
          len = 1
          with = buffer ).

        sequence_to_be_sorted = replace(
          val = sequence_to_be_sorted
          off = high_index
          len = 1
          with = current_color ).

        high_index = high_index - 1.
      else.
        middle_index = middle_index + 1.
      endif.
    endwhile.
  endmethod.

  method sorting_problem~is_sorted.
    sorted = abap_true.

    do strlen( sequence_to_check ) - 1 times.
      data(current_character_index) = sy-index - 1.
      data(current_color) = sequence_to_check+current_character_index(1).
      data(next_color) = sequence_to_check+sy-index(1).

      sorted = cond abap_bool(
        when ( current_color eq dutch_flag_colors-red and
               ( next_color eq current_color or
                 next_color eq dutch_flag_colors-white or
                 next_color eq dutch_flag_colors-blue ) )
             or
             ( current_color eq dutch_flag_colors-white and
               ( next_color eq current_color or
                 next_color eq dutch_flag_colors-blue ) )
             or
             ( current_color eq dutch_flag_colors-blue and
               current_color eq next_color )
        then sorted
        else abap_false ).

      check sorted eq abap_false.
      return.
    enddo.
  endmethod.
endclass.

start-of-selection.
  data dutch_national_flag_problem type ref to sorting_problem.

  dutch_national_flag_problem = new dutch_national_flag_problem( ).

  data(sequence) = dutch_national_flag_problem->generate_unsorted_sequence( 20 ).

  write:|{ sequence }, is sorted? -> { dutch_national_flag_problem->is_sorted( sequence ) }|, /.

  dutch_national_flag_problem->sort_sequence( changing sequence_to_be_sorted = sequence ).

  write:|{ sequence }, is sorted? -> { dutch_national_flag_problem->is_sorted( sequence ) }|, /.


object EbanNumbers {

  class ERange(s: Int, e: Int, p: Boolean) {
    val start: Int = s
    val end: Int = e
    val print: Boolean = p
  }

  def main(args: Array[String]): Unit = {
    val rgs = List(
      new ERange(2, 1000, true),
      new ERange(1000, 4000, true),
      new ERange(2, 10000, false),
      new ERange(2, 100000, false),
      new ERange(2, 1000000, false),
      new ERange(2, 10000000, false),
      new ERange(2, 100000000, false),
      new ERange(2, 1000000000, false)
    )
    for (rg <- rgs) {
      if (rg.start == 2) {
        println(s"eban numbers up to an including ${rg.end}")
      } else {
        println(s"eban numbers between ${rg.start} and ${rg.end}")
      }

      var count = 0
      for (i <- rg.start to rg.end) {
        val b = i / 1000000000
        var r = i % 1000000000
        var m = r / 1000000
        r = i % 1000000
        var t = r / 1000
        r %= 1000
        if (m >= 30 && m <= 66) {
          m %= 10
        }
        if (t >= 30 && t <= 66) {
          t %= 10
        }
        if (r >= 30 && r <= 66) {
          r %= 10
        }
        if (b == 0 || b == 2 || b == 4 || b == 6) {
          if (m == 0 || m == 2 || m == 4 || m == 6) {
            if (t == 0 || t == 2 || t == 4 || t == 6) {
              if (r == 0 || r == 2 || r == 4 || r == 6) {
                if (rg.print) {
                  print(s"$i ")
                }
                count += 1
              }
            }
          }
        }
      }
      if (rg.print) {
        println()
      }
      println(s"count = $count")
      println()
    }
  }
}


INCLUDE "D2:SORT.ACT" ;from the Action! Tool Kit

PROC PrintArray(BYTE ARRAY a BYTE len)
  CHAR ARRAY colors(3)=['R 'W 'B]
  BYTE i,index

  FOR i=0 TO len-1
  DO
    index=a(i)
    Put(colors(index))
  OD
RETURN

BYTE FUNC IsSorted(BYTE ARRAY a BYTE len)
  BYTE i

  IF len<=1 THEN
    RETURN (1)
  FI
  FOR i=0 TO len-2
  DO
    IF a(i)>a(i+1) THEN
      RETURN (0)
    FI
  OD
RETURN (1)

PROC Randomize(BYTE ARRAY a BYTE len)
  BYTE i

  FOR i=0 TO len-1
  DO
    a(i)=Rand(3)
  OD
RETURN

PROC Main()
  DEFINE SIZE="30"
  BYTE ARRAY a(SIZE)

  Put(125) PutE() ;clear the screen
  DO
    Randomize(a,SIZE)
  UNTIL IsSorted(a,SIZE)=0
  OD
  PrintE("Unsorted:") PrintArray(a,SIZE)
  PutE() PutE()

  SortB(a,SIZE,0)
  PrintE("Sorted:") PrintArray(a,SIZE)
  PutE() PutE()

  IF IsSorted(a,SIZE) THEN
    PrintE("Sorting is valid")
  ELSE
    PrintE("Sorting is invalid!")
  FI
RETURN


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;


Module Module1

    Structure Interval
        Dim start As Integer
        Dim last As Integer
        Dim print As Boolean

        Sub New(s As Integer, l As Integer, p As Boolean)
            start = s
            last = l
            print = p
        End Sub
    End Structure

    Sub Main()
        Dim intervals As Interval() = {
            New Interval(2, 1_000, True),
            New Interval(1_000, 4_000, True),
            New Interval(2, 10_000, False),
            New Interval(2, 100_000, False),
            New Interval(2, 1_000_000, False),
            New Interval(2, 10_000_000, False),
            New Interval(2, 100_000_000, False),
            New Interval(2, 1_000_000_000, False)
        }
        For Each intv In intervals
            If intv.start = 2 Then
                Console.WriteLine("eban numbers up to and including {0}:", intv.last)
            Else
                Console.WriteLine("eban numbers between {0} and {1} (inclusive):", intv.start, intv.last)
            End If

            Dim count = 0
            For i = intv.start To intv.last Step 2
                Dim b = i \ 1_000_000_000
                Dim r = i Mod 1_000_000_000
                Dim m = r \ 1_000_000
                r = i Mod 1_000_000
                Dim t = r \ 1_000
                r = r Mod 1_000
                If m >= 30 AndAlso m <= 66 Then
                    m = m Mod 10
                End If
                If t >= 30 AndAlso t <= 66 Then
                    t = t Mod 10
                End If
                If r >= 30 AndAlso r <= 66 Then
                    r = r Mod 10
                End If
                If b = 0 OrElse b = 2 OrElse b = 4 OrElse b = 6 Then
                    If m = 0 OrElse m = 2 OrElse m = 4 OrElse m = 6 Then
                        If t = 0 OrElse t = 2 OrElse t = 4 OrElse t = 6 Then
                            If r = 0 OrElse r = 2 OrElse r = 4 OrElse r = 6 Then
                                If intv.print Then
                                    Console.Write("{0} ", i)
                                End If
                                count += 1
                            End If
                        End If
                    End If
                End If
            Next
            If intv.print Then
                Console.WriteLine()
            End If
            Console.WriteLine("count = {0}", count)
            Console.WriteLine()
        Next
    End Sub

End Module


BEGIN # Dutch national flag problem: sort a set of randomly arranged red, white and blue balls into order #
      # ball sets are represented by STRING items, red by "R", white by "W" and blue by "B" #
    # returns the balls sorted into red, white and blue order #
    PROC sort balls = ( STRING balls )STRING:
    BEGIN
        [ 1 : ( UPB balls + 1 ) - LWB balls ]CHAR result, white, blue;
        INT r pos := 0, w pos := 0, b pos := 0;
        # copy the red balls into the result and split the white and blue #
        # into separate lists #
        FOR pos FROM LWB balls TO UPB balls DO
            CHAR b = balls[ pos ];
            IF b = "R" THEN
                # red ball - add to the result #
                result[ r pos +:= 1 ] := b
            ELIF b = "W" THEN
                # white ball #
                white[ w pos  +:= 1 ] := b
            ELSE
                # must be blue #
                blue[ b pos   +:= 1 ] := b
            FI
        OD;
        # add the white balls to the list #
        IF w pos > 0 THEN
            # there were some white balls - add them to the result #
            result[ r pos + 1 : r pos + w pos ] := white[ 1 : w pos ];
            r pos +:= w pos
        FI;
        # add the blue balls to the list #
        IF b pos > 0 THEN
            # there were some blue balls - add them to the end of the result #
            result[ r pos + 1 : r pos + b pos ] := blue[ 1 : b pos ];
            r pos +:= b pos
        FI;
        result[ 1 : r pos ]
    END # sort balls # ;
    # returns TRUE if balls is sorted, FALSE otherwise #
    PROC sorted balls = ( STRING balls )BOOL:
    BEGIN
        BOOL result := TRUE;
        FOR i FROM LWB balls + 1 TO UPB balls
        WHILE result := (  CHAR prev = balls[ i - 1 ];
                           CHAR curr = balls[ i     ];
                           prev = curr
                        OR ( prev = "R" AND curr = "W" )
                        OR ( prev = "R" AND curr = "B" )
                        OR ( prev = "W" AND curr = "B" )
                        )
        DO SKIP OD;
        result
    END # sorted balls # ;
    # constructs an unsorted random string of n balls #
    PROC random balls = ( INT n )STRING:
    BEGIN
        STRING result := n * "?";
        WHILE FOR i TO n DO
                  result[ i ] := IF   INT r = ENTIER( next random * 3 ) + 1;
                                      r = 1
                                 THEN "R"
                                 ELIF r = 2
                                 THEN "W"
                                 ELSE "B"
                                 FI
              OD;
              sorted balls( result )
        DO SKIP OD;
        result
    END # random balls # ;
    # tests #
    FOR i FROM 11 BY 3 TO 17 DO
        STRING balls;
        balls := random balls( i );
        print( ( "before: ", balls, IF sorted balls( balls ) THEN " initially sorted??" ELSE "" FI, newline ) );
        balls := sort balls( balls );
        print( ( "after:  ", balls, IF sorted balls( balls ) THEN "" ELSE " NOT" FI, " sorted", newline ) )
    OD
END


struct Range {
    start i64
    end i64
    print      bool
}

fn main() {
    rgs := [Range{2, 1000, true},
        Range{1000, 4000, true},
        Range{2, 10000, false},
        Range{2, 100000, false},
        Range{2, 1000000, false},
        Range{2, 10000000, false},
        Range{2, 100000000, false},
        Range{2, 1000000000, false},
    ]
    for rg in rgs {
        if rg.start == 2 {
            println("eban numbers up to and including $rg.end:")
        } else {
            println("eban numbers between $rg.start and $rg.end (inclusive):")
        }
        mut count := 0
        for i := rg.start; i <= rg.end; i += 2 {
            b := i / 1000000000
            mut r := i % 1000000000
            mut m := r / 1000000
            r = i % 1000000
            mut t := r / 1000
            r %= 1000
            if m >= 30 && m <= 66 {
                m %= 10
            }
            if t >= 30 && t <= 66 {
                t %= 10
            }
            if r >= 30 && r <= 66 {
                r %= 10
            }
            if b == 0 || b == 2 || b == 4 || b == 6 {
                if m == 0 || m == 2 || m == 4 || m == 6 {
                    if t == 0 || t == 2 || t == 4 || t == 6 {
                        if r == 0 || r == 2 || r == 4 || r == 6 {
                            if rg.print {
                                print("$i ")
                            }
                            count++
                        }
                    }
                }
            }
        }
        if rg.print {
            println('')
        }
        println("count = $count\n")
    }
}


use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
-- This script uses a customisable AppleScript sort available at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
-- It's assumed that scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort"

on DutchNationalFlagProblem(numberOfBalls)
    -- A local "owner" for the potentially long 'balls' list. Speeds up references to its items and properties.
    script o
        property colours : {"red", "white", "blue"}
        -- Initialise the balls list with at least one instance of each colour — but not in Dutch flag order!
        property balls : reverse of my colours
    end script

    -- Randomly fill the list from the three colours to the required number of balls (min = 3).
    -- The task description doesn't say if there should be equal numbers of each colour, but it makes no difference to the solution.
    repeat numberOfBalls - 3 times
        set end of o's balls to some item of o's colours
    end repeat
    log o's balls -- Log the pre-sort order.

    -- Custom comparer for the sort. Decides whether or not ball 'a' should go after ball 'b'.
    script redsThenWhitesThenBlues
        on isGreater(a, b)
            return ((a is not equal to b) and ((a is "blue") or (b is "red")))
        end isGreater
    end script
    -- Sort items 1 thru -1 of the balls (ie. the whole list) using the above comparer.
    tell sorter to sort(o's balls, 1, -1, {comparer:redsThenWhitesThenBlues})

    -- Return the sorted list.
    return o's balls
end DutchNationalFlagProblem

DutchNationalFlagProblem(100)


 100  READ C$(0),C$(1),C$(2)
 110  DATARED,WHITE,BLUE,0
 120  PRINT "RANDOM:
 130  FOR N = 0 TO 9
 140      LET B%(N) =  RND (1) * 3
 150      GOSUB 250
 160  NEXT N
 170  PRINT
 180  READ S
 190  PRINT "SORTED:
 200  FOR I = 0 TO 2
 210      FOR N = 0 TO 9
 220          ON B%(N) = I GOSUB 250
 230  NEXT N,I
 240  END
 250  PRINT  SPC( S)C$(B%(N));
 260  LET S = 1
 270  RETURN


data 2, 100, true
data 1000, 4000, true
data 2, 1e4, false
data 2, 1e5, false
data 2, 1e6, false
data 2, 1e7, false
data 2, 1e8, false
REM data 2, 1e9, false  // it takes a lot of time
data 0, 0, false

do
    read start, ended, printable
    if not start break

    if start = 2 then
        Print "eban numbers up to and including ", ended
    else
        Print "eban numbers between ", start, " and ", ended, " (inclusive):"
    endif
    count = 0
    for i = start to ended step 2
        b = int(i / 1000000000)
        r = mod(i, 1000000000)
        m = int(r / 1000000)
        r = mod(i, 1000000)
        t = int(r / 1000)
        r = mod(r, 1000)
        if m >= 30 and m <= 66 m = mod(m, 10)
        if t >= 30 and t <= 66 t = mod(t, 10)
        if r >= 30 and r <= 66 r = mod(r, 10)
        if b = 0 or b = 2 or b = 4 or b = 6 then
            if m = 0 or m = 2 or m = 4 or m = 6 then
                if t = 0 or t = 2 or t = 4 or t = 6 then
                    if r = 0 or r = 2 or r = 4 or r = 6 then
                        if printable Print i;
                        count = count + 1
                    endif
                endif
            endif
        endif
    next
    if printable Print
    Print "count = ", count, "\n"
loop


rgs:=T( T(2, 1_000, True),	// (start,end,print)
        T(1_000, 4_000, True),
        T(2, 1e4, False), T(2, 1e5, False), T(2, 1e6, False), T(2, 1e7, False),
        T(2, 1e8, False), T(2, 1e9, False), // slow and very slow
      );

foreach start,end,pr in (rgs){
   if(start==2) println("eban numbers up to and including %,d:".fmt(end));
   else println("eban numbers between %,d and %,d (inclusive):".fmt(start,end));

   count:=0;
   foreach i in ([start..end,2]){
      b,r := i/100_0000_000, i%1_000_000_000;
      m,r := r/1_000_000,    i%1_000_000;
      t,r := r/1_000,	     r%1_000;
      if(30<=m<=66) m=m%10;
      if(30<=t<=66) t=t%10;
      if(30<=r<=66) r=r%10;

      if(magic(b) and magic(m) and magic(t) and magic(r)){
         if(pr) print(i," ");
	 count+=1;
      }
   }
   if(pr) println();
   println("count = %,d\n".fmt(count));
}
fcn magic(z){ z.isEven and z<=6 }


RandGen(MaxBalls){
Random,k,3,MaxBalls
Loop,% k{
	Random,k,1,3
	o.=k
}return o
}
While((!InStr(o,1)||!InStr(o,2)||!InStr(o,3))||!RegExReplace(o,"\b1+2+3+\b"))
	o:=RandGen(3)
Loop,% StrLen(o)
	F.=SubStr(o,A_Index,1) ","
F:=RTrim(F,",")
Sort,F,N D`,
MsgBox,% F:=RegExReplace(RegExReplace(RegExReplace(F,"(1)","Red"),"(2)","White"),"(3)","Blue")


#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


BEGIN {
    weight[1] = "red"; weight[2] = "white"; weight[3] = "blue";
    # ballnr must be >= 3. Using very high numbers here may make your computer
    # run out of RAM. (10 millions balls ~= 2.5GiB RAM on x86_64)
    ballnr = 10

    srand()
    # Generating a random pool of balls. This python-like loop is actually
    # a prettyfied one-liner
    do
        for (i = 1; i <= ballnr; i++)
            do
                balls[i] = int(3 * rand() + 1)
            # These conditions ensure the 3 first balls contains
            # a white, blue and red ball. Removing 'i < 4' would
            # hit performance a lot.
            while ( (i < 4 && i > 1 && balls[i] == balls[i - 1]) ||
                    (i < 4 && i > 2 && balls[i] == balls[i - 2]) )
    while (is_dnf(balls, ballnr))

    printf("BEFORE: ")
    print_balls(balls, ballnr, weight)

    # Using gawk default quicksort. Using variants of PROCINFO["sorted_in"]
    # wasn't faster than a simple call to asort().
    asort(balls)

    printf("\n\nAFTER : ")
    print_balls(balls, ballnr, weight)

    sorting = is_dnf(balls, ballnr) ? "valid" : "invalid"
    print("\n\nSorting is " sorting ".")
}

function print_balls(balls, ballnr, weight      ,i) {
    for (i = 1; i <= ballnr; i++)
        printf("%-7s", weight[balls[i]])
}

function is_dnf(balls, ballnr) {
    # Checking if the balls are sorted in the Dutch national flag order,
    # using a simple scan with weight comparison
    for (i = 2; i <= ballnr; i++)
        if (balls[i - 1] > balls[i])
            return 0
    return 1
}


DECLARE color$[] = { "red", "white", "blue" }

DOTIMES 16
    ball$ = APPEND$(ball$, 0, color$[RANDOM(3)] )
DONE

PRINT "Unsorted: ", ball$

PRINT "  Sorted: ", REPLACE$(SORT$(REPLACE$(ball$, "blue", "z")), "z", "blue")


arraybase 1
dim flag = {"Red","White","Blue"}
dim balls(9)

print "Random: |";
for i = 1 to 9
    kolor = (rand * 3) + 1
    balls[i] = flag[kolor]
    print  balls[i]; " |";
next i
print

print "Sorted: |";
for i = 1 to 3
    kolor = flag[i]
    for j = 1 to 9
        if balls[j] = kolor then print balls[j]; " |";
    next j
next i


      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!"


#include <stdio.h> //printf()
#include <stdlib.h> //srand(), rand(), RAND_MAX, qsort()
#include <stdbool.h> //true, false
#include <time.h> //time()

#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;
}


#include <algorithm>
#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);
}


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));
        }
    }
}


import ceylon.random {

	DefaultRandom
}

abstract class Colour(name, ordinal) of red | white | blue  satisfies Comparable<Colour> {
	shared String name;
	shared Integer ordinal;
	string => name;
	compare(Colour other) => this.ordinal <=> other.ordinal;
}

object red extends Colour("red", 0) {}
object white extends Colour("white", 1) {}
object blue extends Colour("blue", 2) {}

Colour[] allColours = `Colour`.caseValues;

shared void run() {

	function ordered({Colour*} colours) =>
			colours.paired.every(([c1, c2]) => c1 <= c2);

	value random = DefaultRandom();

	function randomBalls(Integer length = 15) {
		while (true) {
			value balls = random.elements(allColours).take(length);
			if (!ordered(balls)) {
				return balls.sequence();
			}
		}
	}

	function dutchSort({Colour*} balls, Colour mid = white) {
		value array = Array { *balls };
		if (array.empty) {
			return [];
		}
		variable value i = 0;
		variable value j = 0;
		variable value n = array.size - 1;
		while (j <= n) {
			assert (exists ball = array[j]);
			if (ball < mid) {
				array.swap(i, j);
				i ++;
				j ++;
			}
			else if (ball > mid) {
				array.swap(n, j);
				n --;
			}
			else {
				j ++;
			}
		}
		return array;
	}

	function idiomaticSort({Colour*} balls) =>
			balls.sort(increasing);

    value initialBalls = randomBalls();

    "the initial balls are not randomized"
    assert (!ordered(initialBalls));

    print(initialBalls);

    value sortedBalls1 = idiomaticSort(initialBalls);
    value sortedBalls2 = dutchSort(initialBalls);

    "the idiomatic sort didn't work"
    assert (ordered(sortedBalls1));

    "the dutch sort didn't work"
    assert (ordered(sortedBalls2));

    print(sortedBalls1);
    print(sortedBalls2);
}


(defn dutch-flag-order [color]
  (get {:red 1 :white 2 :blue 3} color))

(defn sort-in-dutch-flag-order [balls]
  (sort-by dutch-flag-order balls))

;; Get a collection of 'n' balls of Dutch-flag colors
(defn random-balls [num-balls]
  (repeatedly num-balls
              #(rand-nth [:red :white :blue])))

;; Get random set of balls and insure they're not accidentally sorted
(defn starting-balls [num-balls]
  (let [balls (random-balls num-balls)
        in-dutch-flag-order? (= balls
                                (sort-in-dutch-flag-order balls))]
    (if in-dutch-flag-order?
      (recur num-balls)
      balls)))


import std.stdio, std.random, std.algorithm, std.traits, std.array;

enum DutchColors { red, white, blue }

void dutchNationalFlagSort(DutchColors[] items) pure nothrow @nogc {
    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 = uniform!DutchColors;

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


defmodule Dutch_national_flag do
  defp ball(:red),   do: 1
  defp ball(:white), do: 2
  defp ball(:blue),  do: 3

  defp random_ball, do: Enum.random([:red, :white, :blue])

  defp random_ball(n), do: (for _ <- 1..n, do: random_ball())

  defp is_dutch([]), do: true
  defp is_dutch([_]), do: true
  defp is_dutch([b,h|l]), do: ball(b) < ball(h) and is_dutch([h|l])
  defp is_dutch(_), do: false

  def  dutch(list), do: dutch([], [], [], list)

  defp dutch(r, w, b, []),              do: r ++ w ++ b
  defp dutch(r, w, b, [:red   | list]), do: dutch([:red | r],  w,  b, list)
  defp dutch(r, w, b, [:white | list]), do: dutch(r, [:white | w], b, list)
  defp dutch(r, w, b, [:blue  | list]), do: dutch(r, w,  [:blue | b], list)

  def problem(n \\ 10) do
    list = random_ball(n)
    if is_dutch(list) do
      IO.puts "The random sequence #{inspect list} is already in the order of the Dutch flag!"
    else
      IO.puts "The starting random sequence is #{inspect list};"
      IO.puts "The ordered sequence is #{inspect dutch(list)}."
    end
  end
end

Dutch_national_flag.problem


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


(* Since the task description here does not impose Dijsktra's original restrictions
    * Changing the order is only allowed by swapping 2 elements
    * Every element must only be inspected once
   we have several options ...
   One way -- especially when we work with immutable data structures --
   is to scan the unordered list, collect the different
   colours on our way and append the 3 sub-lists in the correct order.
*)
let rnd = System.Random()

type color = | Red | White | Blue

let isDutch s =
    Seq.forall2 (fun last this ->
        match (last, this) with
        | (Red, Red) | (Red, White) | (White, White) | (White, Blue) | (Blue, Blue) -> true | _ -> false
    ) s (Seq.skip 1 s)

[<EntryPoint>]
let main argv =
    let n = 10
    let rec getBallsToSort n s =
        let sn = Seq.take n s
        if (isDutch sn) then (getBallsToSort n (Seq.skip 1 s)) else sn
    let balls = getBallsToSort n (Seq.initInfinite (fun _ -> match (rnd.Next(3)) with | 0 -> Red | 1 -> White | _ -> Blue))
    printfn "Sort the sequence of %i balls: %A" n (Seq.toList balls)
    let (rs,ws,bs) =
        balls
        |> Seq.fold (fun (rs,ws,bs) b ->
            match b with | Red -> (b::rs,ws,bs) | White -> (rs,b::ws,bs) | Blue -> (rs,ws,b::bs))
            ([],[],[])
    let sorted = rs @ ws @ bs
    printfn "The sequence %A is sorted: %b" sorted (isDutch sorted)
    0


USING: combinators grouping kernel math prettyprint random
sequences ;

: sorted? ( seq -- ? ) [ <= ] monotonic? ;

: random-non-sorted-integers ( length n -- seq )
    2dup random-integers
    [ dup sorted? ] [ drop 2dup random-integers ] while 2nip ;

: dnf-sort! ( seq -- seq' )
    [ 0 0 ] dip [ length 1 - ] [ ] bi
    [ 2over <= ] [
        pick over nth {
            { 0 [ reach reach pick exchange [ [ 1 + ] [email protected] ] 2dip ] }
            { 1 [ [ 1 + ] 2dip ] }
            [ drop 3dup exchange [ 1 - ] dip ]
        } case
    ] while 3nip ;

10 3 random-non-sorted-integers dup . dnf-sort! .


\ Dutch flag DEMO for CAMEL99 Forth
\ *SORTS IN PLACE FROM Video MEMORY*

 INCLUDE DSK1.GRAFIX.F
 INCLUDE DSK1.RANDOM.F
 INCLUDE DSK1.CASE.F

\ TMS9918 Video chip Specific code
HEX
FFFF FFFF FFFF FFFF PATTERN: SQUARE

\ define colors and characters
DECIMAL
24 32 *  CONSTANT SIZE     \ flag will fill GRAPHICS screen
SIZE 3 / CONSTANT #256     \ 256 chars per segment of flag
1        CONSTANT REDSQR   \ red character
9        CONSTANT WHTSQR   \ white character
19       CONSTANT BLUSQR   \ blue character

\ color constants
1        CONSTANT TRANS
7        CONSTANT RED
5        CONSTANT BLU
16       CONSTANT WHT

SQUARE REDSQR CHARDEF
SQUARE BLUSQR CHARDEF
SQUARE WHTSQR CHARDEF

\ charset  FG    BG
  0        RED TRANS COLOR
  1        WHT TRANS COLOR
  2        BLU TRANS COLOR

\ screen fillers
: RNDI    ( -- n ) SIZE 1+ RND ; \ return a random VDP screen address

: NOTRED    (  -- n ) \ return rnd index that is not RED
           BEGIN
              RNDI DUP [email protected] REDSQR =
           WHILE DROP
           REPEAT ;

: NOTREDWHT    ( -- n ) \ return rnd index that is not RED or WHITE
           BEGIN  RNDI DUP
              [email protected]  DUP REDSQR =
              SWAP WHTSQR = OR
           WHILE
              DROP
           REPEAT ;

: RNDRED  (  -- ) \ Random RED on VDP screen
          #256 0 DO   REDSQR NOTRED VC!   LOOP ;

: RNDWHT (  -- ) \ place white where there is no red or white
          #256 0 DO   WHTSQR NOTREDWHT VC!   LOOP ;

: BLUSCREEN ( -- )
           0 768 BLUSQR VFILL ;

\ load the screen with random red,white&blue squares
: RNDSCREEN ( -- )
            BLUSCREEN  RNDRED  RNDWHT ;

: CHECKERED  ( -- ) \ red,wht,blue checker board
         SIZE 0
         DO
            BLUSQR I VC!
            WHTSQR I 1+ VC!
            REDSQR I 2+ VC!
         3 +LOOP ;

: RUSSIAN  \ Russian flag
            0  0 WHTSQR 256 HCHAR
            0  8 BLUSQR 256 HCHAR
            0 16 REDSQR 256 HCHAR ;

: FRENCH  \ kind of a French flag
           0  0 BLUSQR 256 VCHAR
          10 16 WHTSQR 256 VCHAR
          21  8 REDSQR 256 VCHAR ;

\ =======================================================
\ Algorithm Dijkstra(A)  \ A is an array of three colors
\ begin
\   r <- 1;
\   b <- n;
\   w <- n;
\ while (w>=r)
\       check the color of A[w]
\       case 1: red
\               swap(A[r],A [w]);
\                r<-r+1;
\       case 2: white
\               w<-w-1
\       case 3: blue
\               swap(A[w],A[b]);
\               w<-w-1;
\               b<-b-1;
\ end

\ ======================================================
\ Dijkstra three color Algorithm in Forth

\ screen address pointers
VARIABLE R
VARIABLE B
VARIABLE W

: XCHG  ( vadr1 vadr2 -- ) \ Exchange chars in Video RAM
       OVER [email protected] OVER [email protected]       ( -- addr1 addr2 char1 char2)
       SWAP ROT VC! SWAP VC! ; \ exchange chars in Video RAM

: DIJKSTRA ( -- )
           0 R !
           SIZE 1- DUP  B !  W !
           BEGIN
               W @  R @  1- >
           WHILE
               W @ [email protected]  ( fetch Video char at pointer W)
               CASE
                 REDSQR OF  R @ W @  XCHG
                            1 R +!           ENDOF

                 WHTSQR OF -1 W +!           ENDOF

                 BLUSQR OF  W @ B @  XCHG
                           -1 W +!
                           -1 B +!           ENDOF
               ENDCASE
           REPEAT ;

: WAIT ( -- )  11 11 AT-XY ." Finished!" 1500 MS ;

: RUN  ( -- )
         PAGE
         CR ." Dijkstra Dutch flag Demo"  CR
         CR ." Sorted in-place in Video RAM" CR
         CR
         CR ." Using the 3 colour algorithm" CR
         CR ." Press any key to begin" KEY DROP
         RNDSCREEN  DIJKSTRA WAIT
         CHECKERED  DIJKSTRA WAIT
         RUSSIAN    DIJKSTRA WAIT
         FRENCH     DIJKSTRA WAIT
         0 23 AT-XY
         CR ." Completed"
;


!-*- 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


' El problema planteado por Edsger Dijkstra es:
' "Dado un número de bolas rojas, azules y blancas en orden aleatorio,
' ordénelas en el orden de los colores de la bandera nacional holandesa."

Dim As String c = "RBW", n = "121509"
Dim As Integer bolanum = 9
Dim As Integer d(bolanum), k, i, j
Randomize Timer

Color 15: Print "Aleatorio: ";
For k = 1 To bolanum
    d(k) = Int(Rnd * 3) + 1
    Color Val(Mid(n, d(k), 2))
    Print Mid(c, d(k), 1) & Chr(219);
Next k

Color 15: Print : Print "Ordenado:  ";
For i = 1 To 3
    For j = 1 To bolanum
        If d(j) = i Then Color Val(Mid(n, i, 2)): Print Mid(c, i, 1) & Chr(219);
    Next j
Next i
End


Public Sub Main()
Dim Red As String = "0"
Dim White As String = "1"
Dim Blue As String = "2"
Dim siCount As Short
Dim sColours As New String[]
Dim sTemp As String

For siCount = 1 To 20
  sColours.Add(Rand(Red, Blue))
Next

Print "Random: - ";

For siCount = 1 To 2
  For Each sTemp In sColours
    If sTemp = Red Then Print "Red ";
    If sTemp = White Then Print "White ";
    If sTemp = Blue Then Print "Blue ";
  Next
  sColours.Sort
  Print
  If siCount = 1 Then Print "Sorted: - ";
Next

End


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


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)


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


import java.util.Arrays;
import java.util.Random;

public class DutchNationalFlag {
    enum DutchColors {
        RED, WHITE, BLUE
    }

    public static void main(String[] args){
        DutchColors[] balls = new DutchColors[12];
        DutchColors[] values = DutchColors.values();
        Random rand = new Random();

        for (int i = 0; i < balls.length; i++)
            balls[i]=values[rand.nextInt(values.length)];
        System.out.println("Before: " + Arrays.toString(balls));

        Arrays.sort(balls);
        System.out.println("After:  " + Arrays.toString(balls));

        boolean sorted = true;
        for (int i = 1; i < balls.length; i++ ){
            if (balls[i-1].compareTo(balls[i]) > 0){
                sorted=false;
                break;
            }
        }
        System.out.println("Correctly sorted: " + sorted);
    }
}


const dutchNationalFlag = () => {

  /**
   * Return the name of the given number in this way:
   * 0 = Red
   * 1 = White
   * 2 = Blue
   * @param {!number} e
   */
  const name = e => e > 1 ? 'Blue' : e > 0 ? 'White' : 'Red';

  /**
   * Given an array of numbers return true if each number is bigger than
   * or the same as the previous
   * @param {!Array<!number>} arr
   */
  const isSorted = arr => arr.every((e,i) => e >= arr[Math.max(i-1, 0)]);

  /**
   * Generator that keeps yielding a random int between 0(inclusive) and
   * max(exclusive), up till n times, and then is done.
   * @param max
   * @param n
   */
  function* randomGen (max, n) {
    let i = 0;
    while (i < n) {
      i += 1;
      yield Math.floor(Math.random() * max);
    }
  }

  /**
   * An array of random integers between 0 and 3
   * @type {[!number]}
   */
  const mixedBalls = [...(randomGen(3, 22))];

  /**
   * Sort the given array into 3 sub-arrays and then concatenate those.
   */
  const sortedBalls = mixedBalls
    .reduce((p,c) => p[c].push(c) && p, [[],[],[]])
    .reduce((p,c) => p.concat(c), []);

  /**
   * A verbatim implementation of the Wikipedia pseudo-code
   * @param {!Array<!number>} A
   * @param {!number} mid The value of the 'mid' number. In our case 1 as
   * low is 0 and high is 2
   */
  const dutchSort = (A, mid) => {
    let i = 0;
    let j = 0;
    let n = A.length - 1;
    while(j <= n) {
      if (A[j] < mid) {
        [A[i], A[j]] = [A[j], A[i]];
        i += 1;
        j += 1;
      } else if (A[j] > mid) {
        [A[j], A[n]] = [A[n], A[j]];
        n -= 1
      } else {
        j += 1;
      }
    }
  };

  console.log(`Mixed balls       : ${mixedBalls.map(name).join()}`);
  console.log(`Is sorted: ${isSorted(mixedBalls)}`);

  console.log(`Sorted balls      : ${sortedBalls.map(name).join()}`);
  console.log(`Is sorted: ${isSorted(sortedBalls)}`);

  // Only do the dutch sort now as it mutates the mixedBalls array in place.
  dutchSort(mixedBalls, 1);
  console.log(`Dutch Sorted balls: ${mixedBalls.map(name).join()}`);
  console.log(`Is sorted: ${isSorted(mixedBalls)}`);
};
dutchNationalFlag();


const COLORS = ["red", "white", "blue"]

function dutchsort!(a::Array{ASCIIString,1}, lo=COLORS[1], hi=COLORS[end])
    i = 1
    j = 1
    n = length(a)
    while j <= n
        if a[j] == lo
            a[i], a[j] = a[j], a[i]
            i += 1
            j += 1
        elseif a[j] == hi
            a[j], a[n] = a[n], a[j]
            n -= 1
        else
            j += 1
        end
    end
    return a
end

function dutchsort(a::Array{ASCIIString,1}, lo=COLORS[1], hi=COLORS[end])
    dutchsort!(copy(a), lo, hi)
end


// version 1.1.4

import java.util.Random

enum class DutchColors { RED, WHITE, BLUE }

fun Array<DutchColors>.swap(i: Int, j: Int) {
    val temp = this[i]
    this[i] = this[j]
    this[j] = temp
}

fun Array<DutchColors>.sort() {
    var lo = 0
    var mid = 0
    var hi = this.lastIndex

    while (mid <= hi) {
        when (this[mid]) {
            DutchColors.RED   -> this.swap(lo++, mid++)
            DutchColors.WHITE -> mid++
            DutchColors.BLUE  -> this.swap(mid, hi--)
        }
    }
}

fun Array<DutchColors>.isSorted(): Boolean {
    return (1 until this.size)
        .none { this[it].ordinal < this[it - 1].ordinal }
}

const val NUM_BALLS = 9

fun main(args: Array<String>) {
    val r = Random()
    val balls  = Array(NUM_BALLS) { DutchColors.RED }
    val colors = DutchColors.values()

    // give balls random colors whilst ensuring they're not already sorted
    do {
        for (i in 0 until NUM_BALLS) balls[i] = colors[r.nextInt(3)]
    }
    while (balls.isSorted())

    // print the colors of the balls before sorting
    println("Before sorting : ${balls.contentToString()}")

    // sort the balls in DutchColors order
    balls.sort()

    // print the colors of the balls after sorting
    println("After sorting  : ${balls.contentToString()}")
}


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'))


; 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


-- "1. Generate a randomized order of balls.."
math.randomseed(os.time())
N, balls, colors = 10, {}, { "red", "white", "blue" }
for i = 1, N do balls[i] = colors[math.random(#colors)] end
-- "..ensuring that they are not in the order of the Dutch national flag."
order = { red=1, white=2, blue=3 }
function issorted(t)
  for i = 2, #t do
    if order[t[i]] < order[t[i-1]] then return false end
  end
  return true
end
local function shuffle(t)
  for i = #t, 2, -1 do
    local j = math.random(i)
    t[i], t[j] = t[j], t[i]
  end
end
while issorted(balls) do shuffle(balls) end
print("RANDOM:  "..table.concat(balls,","))

-- "2. Sort the balls in a way idiomatic to your language."
table.sort(balls, function(a, b) return order[a] < order[b] end)

-- "3. Check the sorted balls are in the order of the Dutch national flag."
print("SORTED:  "..table.concat(balls,","))
print(issorted(balls) and "Properly sorted." or "IMPROPERLY SORTED!!")


Report "Dutch Flag from Dijkstra"
const center=2
enum balls {Red, White, Blue}
fillarray=lambda a=(Red, White, Blue) (size as long=10)-> {
    if size<1 then size=1
    randomitem=lambda a->a#val(random(0,2))
    dim a(size)<<randomitem()
    =a()
}
Display$=lambda$ (s as array) ->{
    Document r$=eval$(array(s))
    if len(s)>1 then
    For i=1 to len(s)-1 {
        r$=", "+eval$(array(s,i))
    }
    end if
    =r$
}
TestSort$=lambda$ (s as array)-> {
    ="unsorted: "
    x=array(s)
    for i=1 to len(s)-1 {
        k=array(s,i)
        if x>k then break
        swap x, k
    }
    ="sorted: "
}
Positions=lambda mid=White (a as array) ->{
    m=len(a)
    dim Base 0, b(m)=-1
    low=-1
    high=m
    m--
    i=0
    medpos=stack
    link a to a()
    for i=m to 0 {
        if a(i)<=mid then exit
        high--
        b(high)=high
    }
    for i=0 to m {
        if a(i)>=mid then exit
        low++
        b(low)=low
    }
    if high-low>1 then
    for i=low+1 to high-1 {
        select case a(i)<=>Mid
        case -1
            low++ : b(low)=i
        case 1
        {
            high-- :b(high)=i
            if High<i then swap b(high), b(i)
        }
        else case
            stack medpos {data i}
        end select
    }
    end if
    if Len(medpos)>0 then
    dim c()
    c()=array(medpos)
    stock c(0) keep len(c()), b(low+1)
    for i=low+1 to high-1
           if b(i)>low and b(i)<high and b(i)<>i then swap b(b(i)), b(i)
    next i
    end if
    if low>0  then
        for i=0 to low
            if b(i)<=low and b(i)<>i then swap b(b(i)), b(i)
        next
    end if
    if High<m then
        for i=m to High
            if b(i)>=High and b(i)<>i then swap b(b(i)), b(i)
        next
    end if
    =b()
}
InPlace=Lambda (&p(), &Final()) ->{
    def i=0, j=-1, k=-1, many=0
    for i=0 to len(p())-1
        if p(i)<>i then
            j=i
            z=final(j)
            do
                final(j)=final(p(j))
                k=j
                j=p(j)
                p(k)=k
                many++
            until j=i
            final(k)=z
        end if
    next
    =many
}

Dim final(), p(), second(), p1()
Rem final()=(White,Red,Blue,White,Red, Red, Blue)
Rem final()=(white, blue, red, blue, white)

final()=fillarray(30)
Print "Items: ";len(final())
Report TestSort$(final())+Display$(final())
\\ backup for final() for second example
second()=final()
p()=positions(final())
\\ backup p() to p1() for second example
p1()=p()

Report Center,  "InPlace"
rem Print p()   ' show array items
many=InPlace(&p(), &final())
rem print p()  ' show array items
Report TestSort$(final())+Display$(final())
print "changes: "; many

Report Center, "Using another array to make the changes"
final()=second()
\\ using a second array to place only the changes
item=each(p1())
many=0
While item {
    if item^=array(item) else final(item^)=second(array(item)) : many++
}
Report TestSort$(final())+Display$(final())
print "changes: "; many
Module three_way_partition (A as array, mid as balls, &swaps) {
    Def i, j, k
    k=Len(A)
    Link A to A()
    While j < k
        if A(j) < mid Then
            Swap A(i), A(j)
            swaps++
            i++
            j++
        Else.if A(j) > mid Then
            k--
            Swap A(j), A(k)
            swaps++
        Else
            j++
        End if
    End While
}
Many=0
Z=second()
Print
Report center, {Three Way Partition
}
Report TestSort$(Z)+Display$(Z)
three_way_partition Z, White, &many
Print
Report TestSort$(Z)+Display$(Z)
Print "changes: "; many


flagSort[data_List] := Sort[data, (#1 === RED || #2 === BLUE) &]


import os, random, strutils

type Color {.pure.} = enum Red = "R", White = "W", Blue = "B"

#---------------------------------------------------------------------------------------------------

proc isSorted(a: openArray[Color]): bool =
  # Check if an array of colors is in the order of the dutch national flag.
  var prevColor = Red
  for color in a:
    if color < prevColor:
      return false
    prevColor = color
  return true

#---------------------------------------------------------------------------------------------------

proc threeWayPartition(a: var openArray[Color]; mid: Color) =
  ## Dijkstra way to sort the colors.
  var i, j = 0
  var k = a.high
  while j <= k:
    if a[j] < mid:
      swap a[i], a[j]
      inc i
      inc j
    elif a[j] > mid:
      swap a[j],  a[k]
      dec k
    else:
      inc j

#———————————————————————————————————————————————————————————————————————————————————————————————————

var n: Positive = 10

# Get the number of colors.
if paramCount() > 0:
  try:
    n = paramStr(1).parseInt()
    if n <= 1:
      raise newException(ValueError, "")
  except ValueError:
    echo "Wrong number of colors"
    quit(QuitFailure)

# Create the colors.
randomize()
var colors = newSeqOfCap[Color](n)

while true:
  for i in 0..<n:
    colors.add(Color(rand(ord(Color.high))))
  if not colors.isSorted():
    break
  colors.setLen(0)  # Reset for next try.

echo "Original: ", colors.join("")

# Sort the colors.
var sortedColors = colors
threeWayPartition(sortedColors, White)
doAssert sortedColors.isSorted()
echo "Sorted:   ", sortedColors.join("")


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)


use warnings;
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";


with javascript_semantics
function three_way_partition(sequence s, integer mid)
    integer i=1, j=1, n = length(s)
    while j <= n do
        if s[j] < mid then
            {s[i],s[j]} = {s[j],s[i]}
            i += 1
            j += 1
        elsif s[j] > mid then
            {s[j],s[n]} = {s[n],s[j]}
            n -= 1
        else
            j += 1
        end if
    end while
    return s
end function

constant colours = {"red","white","blue"}
enum /*red,*/ white = 2, blue, maxc = blue

procedure show(string msg, sequence s)
    sequence t = repeat(0,length(s))
    for i=1 to length(s) do
        t[i] = colours[s[i]]
    end for
    printf(1,"%s: %s\n",{msg,join(t)})
end procedure

sequence unsorted, sorted
while 1 do
    unsorted = sq_rand(repeat(maxc,12))
--  sorted = sort(deep_copy(unsorted)) -- (works just as well)
    sorted = three_way_partition(deep_copy(unsorted), white)
    if unsorted!=sorted then exit end if
    ?"oops"
end while
show("Unsorted",unsorted)
show("Sorted",sorted)


go =>
  _ = random2(), % random seed
  N = 21,
  Map = new_map([1=red,2=white,3=blue]),
  [Rand,Sorted] = dutch_random_sort(N,Map,Map.inverse()),
  println('rand  '=Rand),
  println(sorted=Sorted),
  nl.

% generate a random order and ensure it's not already dutch sorted
dutch_random_sort(N,Map,MapInv) = [Rand,Sorted] =>
  Rand = dutch_random1(N,Map),
  Sorted = dutch_sort(Rand,MapInv),
  while (Rand == Sorted)
    println("Randomize again"),
    Rand := dutch_random1(N,Map),
    Sorted := dutch_sort(Rand,MapInv)
  end.

dutch_random1(N,Map) = [Map.get(1+(random() mod Map.map_to_list().length)) : _I in 1..N].

dutch_sort(L,MapInv) = [R : _=R in [MapInv.get(R)=R : R in L].sort()].

inverse(Map) = new_map([V=K : K=V in Map]).


(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") )


$Colors = 'red', 'white','blue'

#  Select 10 random colors
$RandomBalls = 1..10 | ForEach { $Colors | Get-Random }

#  Ensure we aren't finished before we start. For some reason. It's in the task requirements.
While ( $RandomBalls -eq $RandomBalls | Sort { $Colors.IndexOf( $_ ) } )
    { $RandomBalls = 1..10 | ForEach { $Colors | Get-Random } }

#  Sort the colors
$SortedBalls = $RandomBalls | Sort { $Colors.IndexOf( $_ ) }

#  Display the results
$RandomBalls
''
$SortedBalls


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([]).


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 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))


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 = flat red, white, blue Zxx bag(@colors».key)<red white blue> }

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

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


/*REXX program reorders 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                               /*obtain optional arguments from the CL*/
if N='' |  N=","  then N=15                      /*Not specified?  Then use the default.*/
if colors=''  then colors= 'red white blue'      /* "      "         "   "   "      "   */
#=words(colors)                                  /*count the number of colors specified.*/
@=word(colors, #)    word(colors, 1)             /*ensure balls aren't already in order.*/

    do g=3  to N                                 /*generate a random # of colored balls.*/
    @[email protected]  word( colors, random(1, #) )            /*append a random color to the  @ list.*/
    end   /*g*/

say 'number of colored balls generated = '   N       ;  say
say center(' original ball order ', length(@), "─")
say @                                                ;  say
$=;                          do j=1  for #;
                             _=word(colors, j);      $=$  copies(_' ',   countWords(_, @))
                             end   /*j*/
say
say center(' sorted  ball order ', length(@), "─")
say space($)
say
    do k=2  to  N                                /*verify the balls are in correct 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
say 'The sorted colored ball list has been confirmed as being sorted correctly.'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
countWords:  procedure;   parse arg ?,hay;  s=1
                  do r=0  until _==0;  _=wordpos(?, hay, s);  s=_+1;  end /*r*/;  return r


# Project : Dutch national flag problem

flag = ["Red","White","Blue"]
balls = list(10)

see "Random: |"
for i = 1 to 10
     color = random(2) + 1
     balls[i] = flag[color]
     see  balls[i] + " |"
next
see nl

see "Sorted: |"
for i = 1 to 3
     color = flag[i]
     for j = 1 to 10
          if balls[j] = color
             see balls[j] + " |"
          ok
     next
next


class Ball
  FLAG = {red: 1, white: 2, blue: 3}

  def initialize
    @color = FLAG.keys.sample
  end

  def color
    @color
  end

  def <=>(other)  # needed for sort, results in -1 for <, 0 for == and 1 for >.
    FLAG[self.color] <=> FLAG[other.color]
  end

  def inspect
    @color
  end
end

balls = []
balls = Array.new(8){Ball.new} while balls == balls.sort

puts "Random: #{balls}"
puts "Sorted: #{balls.sort}"


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


extern crate rand;

use rand::Rng;

// Color enums will be sorted by their top-to-bottom declaration order
#[derive(Eq,Ord,PartialOrd,PartialEq,Debug)]
enum Color {
    Red,
    White,
    Blue
}

fn is_sorted(list: &Vec<Color>) -> bool {
    let mut state = &Color::Red;
    for current in list.iter() {
        if current < state { return false; }
        if current > state { state = current; }
    }
    true
}

fn main() {
    let mut rng = rand::thread_rng();
    let mut colors: Vec<Color> = Vec::new();

    for _ in 1..10 {
        let r = rng.gen_range(0, 3);
        if      r == 0 { colors.push(Color::Red); }
        else if r == 1 { colors.push(Color::White); }
        else if r == 2 { colors.push(Color::Blue); }
    }

    while is_sorted(&colors) {
        rng.shuffle(&mut colors);
    }

    println!("Before: {:?}", colors);
    colors.sort();
    println!("After:  {:?}", colors);
    if !is_sorted(&colors) {
        println!("Oops, did not sort colors correctly!");
    }
}


object FlagColor extends Enumeration {
    type FlagColor = Value
    val Red, White, Blue = Value
}

val genBalls = (1 to 10).map(i => FlagColor(scala.util.Random.nextInt(FlagColor.maxId)))
val sortedBalls = genBalls.sorted
val sorted = if (genBalls == sortedBalls) "sorted" else "not sorted"

println(s"Generated balls (${genBalls mkString " "}) are $sorted.")
println(s"Sorted balls (${sortedBalls mkString " "}) are sorted.")


-- 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;


# The comparison function
proc dutchflagcompare {a b} {
    set colors {red white blue}
    return [expr {[lsearch $colors $a] - [lsearch $colors $b]}]
}

# The test function (evil shimmer of list to string!)
proc isFlagSorted lst {
    expr {![regexp {blue.*(white|red)} $lst] && ![regexp {white.*red} $lst]}
}

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

# 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"
}


COLORS=(red white blue)

# to go from name to number, we make variables out of the color names
# (e.g. the variable "$red" has value "1").
for (( i=0; i<${#COLORS[@]}; ++i )); do
  eval ${COLORS[i]}=$i
done

# 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[@]}"
}

# Test for Dutchness
function dutch? {
  if (( $# < 2 )); then
     return 0
  else
    local first="$1"
    shift
    if eval "(( $first > $1 ))"; then
      return 1
    else
      dutch? "[email protected]"
    fi
  fi
}

# Sort into order
function dutch {
  local -i lo=-1 hi=$# i=0
  local a=("[email protected]")
  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[@]}"
}


'Solution derived from http://www.geeksforgeeks.org/sort-an-array-of-0s-1s-and-2s/.

'build an unsorted array with n elements
Function build_unsort(n)
	flag = Array("red","white","blue")
	Set random = CreateObject("System.Random")
	Dim arr()
	ReDim arr(n)
	For i = 0 To n
		arr(i) = flag(random.Next_2(0,3))
	Next
	build_unsort = arr
End Function

'sort routine
Function sort(arr)
	lo = 0
	mi = 0
	hi = UBound(arr)
	Do While mi <= hi
		Select Case arr(mi)
			Case "red"
				tmp = arr(lo)
				arr(lo) = arr(mi)
				arr(mi) = tmp
				lo = lo + 1
				mi = mi + 1
			Case "white"
				mi = mi + 1
			Case "blue"
				tmp = arr(mi)
				arr(mi) = arr(hi)
				arr(hi) = tmp
				hi = hi - 1
		End Select
	Loop
	sort = Join(arr,",")
End Function

unsort = build_unsort(11)
WScript.StdOut.Write "Unsorted: " & Join(unsort,",")
WScript.StdOut.WriteLine
WScript.StdOut.Write "Sorted: " & sort(unsort)
WScript.StdOut.WriteLine


CLOSE DATABASES ALL
LOCAL lcCollate As String, i As Integer, n As Integer
lcCollate = SET("Collate")
SET COLLATE TO "Machine"
*!* Colours table
CREATE CURSOR colours (id I UNIQUE, colour V(5))
INSERT INTO colours VALUES (1, "Red")
INSERT INTO colours VALUES (2, "White")
INSERT INTO colours VALUES (3, "Blue")
*!* Balls table
CREATE CURSOR balls (colour I, rowid I AUTOINC)
INDEX ON colour TAG colour
SET ORDER TO 0
*!* Make sure there is at least 1 of each colour
INSERT INTO balls (colour) VALUES(3)
INSERT INTO balls (colour) VALUES(1)
INSERT INTO balls (colour) VALUES(2)
RAND(-1)	&& Initialise random number generator
n = 24
FOR i = 4 TO n
	INSERT INTO balls (colour) VALUES (RanInt())
ENDFOR
*!* Show unsorted
SELECT bb.rowid, cc.colour FROM colours cc JOIN balls bb ON cc.id = bb.colour
*!* Select by correct order
SELECT bb.rowid, cc.colour FROM colours cc JOIN balls bb ON cc.id = bb.colour ;
ORDER BY cc.id INTO CURSOR dutchflag
*!* Show sorted records
BROWSE NOMODIFY IN SCREEN
SET COLLATE TO lcCollate

FUNCTION RanInt() As Integer
RETURN INT(3*RAND()) + 1
ENDFUNC


import "random" for Random
import "/sort" for Sort

var colors = ["Red", "White", "Blue"]
var colorMap = { "Red": 0, "White": 1, "Blue": 2 }
var colorCmp = Fn.new { |c1, c2| (colorMap[c1] - colorMap[c2]).sign }
var NUM_BALLS = 9
var r = Random.new()
var balls = List.filled(NUM_BALLS, colors[0])

while (true) {
    for (i in 0...NUM_BALLS) balls[i] = colors[r.int(3)]
    if (!Sort.isSorted(balls, colorCmp)) break
}

System.print("Before sorting : %(balls)")
Sort.insertion(balls, colorCmp)
System.print("After sorting  : %(balls)")


const RED=0, WHITE=1, BLUE=2; var BALLS=T(RED,WHITE,BLUE);
fcn colorBalls(balls){ balls.apply(T("red","white","blue").get).concat(", "); }

reg balls, sortedBalls;
do{
   balls=(0).pump(12,List,fcn{ BALLS[(0).random(3)] }); // create list of 12 random balls
   sortedBalls=balls.sort(); // balls is read only, sort creates new list
}while(balls==sortedBalls); // make sure sort does something
println("Original ball order:\n", colorBalls(balls));
println("\nSorted ball order:\n", colorBalls(sortedBalls));


10 LET r$="Red": LET w$="White": LET b$="Blue"
20 LET c$="RWB"
30 DIM b(10)
40 PRINT "Random:"
50 FOR n=1 TO 10
60 LET b(n)=INT (RND*3)+1
70 PRINT VAL$ (c$(b(n))+"$");" ";
80 NEXT n
90 PRINT ''"Sorted:"
100 FOR i=1 TO 3
110 FOR j=1 TO 10
120 IF b(j)=i THEN PRINT VAL$ (c$(i)+"$");" ";
130 NEXT j
140 NEXT i


PROC Main()
  BYTE
    CH=$02FC, ;Internal hardware value for last key pressed
    PALNTSC=$D014 ;To check if PAL or NTSC system is used

  Graphics(8+16) ;Graphics 320x192 with 2 luminances
  IF PALNTSC=15 THEN
    SetColor(1,4,6) ;Red color for NTSC
    SetColor(2,4,15)
  ELSE
    SetColor(1,2,6) ;Red color for PAL
    SetColor(2,2,15)
  FI
  Color=1
  Plot(100,100)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Draw_A_Pixel is

   Width   : constant := 320;
   Height  : constant := 200;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;

   procedure Wait is
      use type SDL.Events.Event_Types;
      Event : SDL.Events.Events.Events;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Draw a pixel",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));
   Renderer.Set_Draw_Colour ((255, 0, 0, 255));
   Renderer.Draw (Point => (100, 100));
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Draw_A_Pixel;