Rosetta Code

Dutch national flag problem: Difference between revisions

Page Discussion

Dutch national flag problem (view source)

Revision as of 22:26, 13 February 2024

33,013 bytes added ,  3 months ago
m
→‎{{header|EasyLang}}
 
(39 intermediate revisions by 25 users not shown)
Line 23:
* [https://www.google.co.uk/search?rlz=1C1DSGK_enGB472GB472&sugexp=chrome,mod=8&sourceid=chrome&ie=UTF-8&q=Dutch+national+flag+problem#hl=en&rlz=1C1DSGK_enGB472GB472&sclient=psy-ab&q=Probabilistic+analysis+of+algorithms+for+the+Dutch+national+flag+problem&oq=Probabilistic+analysis+of+algorithms+for+the+Dutch+national+flag+problem&gs_l=serp.3...60754.61818.1.62736.1.1.0.0.0.0.72.72.1.1.0...0.0.Pw3RGungndU&psj=1&bav=on.2,or.r_gc.r_pw.r_cp.r_qf.,cf.osb&fp=c33d18147f5082cc&biw=1395&bih=951 Probabilistic analysis of algorithms for the Dutch national flag problem] by Wei-Mei Chen. (pdf)
<br><br>
 
=={{header|11l}}==
{{trans|Python: Construct from ball counts}}
 
<syntaxhighlight lang="11l">V colours_in_order = ‘Red White Blue’.split(‘ ’)
 
F dutch_flag_sort3(items)
[String] r
L(colour) :colours_in_order
r.extend([colour] * items.count(colour))
R r
 
V balls = [‘Red’, ‘Red’, ‘Blue’, ‘Blue’, ‘Blue’, ‘Red’, ‘Red’, ‘Red’, ‘White’, ‘Blue’]
print(‘Original Ball order: ’balls)
V sorted_balls = dutch_flag_sort3(balls)
print(‘Sorted Ball Order: ’sorted_balls)</syntaxhighlight>
 
{{out}}
<pre>
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]
</pre>
 
=={{header|ABAP}}==
This works for ABAP Version 7.40 and above, the color blue is excluded as an option for the last entry to insure an unsorted sequence.
 
<syntaxhighlight lang="abap">
<lang ABAP>
report z_dutch_national_flag_problem.
 
Line 186 ⟶ 208:
 
write:|{ sequence }, is sorted? -> { dutch_national_flag_problem->is_sorted( sequence ) }|, /.
</syntaxhighlight>
</lang>
 
{{output}}
Line 193 ⟶ 215:
 
RRRRRRRRWWWWWWWBBBBB, is sorted? -> X
</pre>
 
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
<syntaxhighlight lang="action!">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</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Dutch_national_flag_problem.png Screenshot from Atari 8-bit computer]
<pre>
Unsorted:
RBWBWRRRRRWBWRWRRBBWBBBRRWWRRR
 
Sorted:
RRRRRRRRRRRRRRWWWWWWWWBBBBBBBB
 
Sorting is valid
</pre>
 
=={{header|Ada}}==
 
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO, Ada.Numerics.Discrete_Random, Ada.Command_Line;
 
procedure Dutch_National_Flag is
Line 295 ⟶ 389:
 
Print("After Sorting: ", A);
end Dutch_National_Flag;</langsyntaxhighlight>
 
{{out}}
Line 309 ⟶ 403:
After Sorting: WHITE, WHITE, WHITE, WHITE, BLUE, BLUE, BLUE</pre>
 
=={{header|AppleScriptALGOL 68}}==
<syntaxhighlight lang="algol68">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</syntaxhighlight>
{{out}}
<pre>
before: BWWRWRBWBRR
after: RRRRWWWWBBB sorted
before: BBRBWWRWBRRBBW
after: RRRRWWWWBBBBBB sorted
before: WRRWRRRBBWBRRWBWB
after: RRRRRRRWWWWWBBBBB sorted
</pre>
 
=={{header|AppleScript}}==
<lang applescript>use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later.
-- This script uses a customisable AppleScript sort available at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
use sorter : script ¬
-- It's assumed that scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort" --<www.macscripter.net/t/timsort-and-nigsort/71383/3>
 
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"}
property balls : {}
-- Initialise the balls list with at least one instance of each colour — but not in Dutch flag order!
property balls : reverse of my colours
-- Custom comparison handler for the sort.
on isGreater(a, b)
return ((a ≠ b) and ((a is "blue") or (b is "red")))
end isGreater
end script
repeat numberOfBalls times
-- 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
logtell sorter to sort(o's balls, --1, LognumberOfBalls, the pre-sort order.{comparer:o})
-- 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)</langsyntaxhighlight>
 
{{output}}
<pre>Log:
(*blue, whiteblue, redblue, redwhite, redblue, white, red, white, white, red, blue, red, blue, red, redwhite, white, blue, white, blue, bluewhite, bluered, blue, white, white, blue, white, red, blue, white, white, white, blue, blue, red, whiteblue, red, red, redblue, redwhite, white, red, white, red, red, red, blue, whitered, whiteblue, bluered, blue, bluered, bluewhite, blue, white, red, white, red, red, bluewhite, white, red, blue, red, blue, blue, red, bluewhite, blue, whitered, bluewhite, blue, blue, redwhite, red, blue, redwhite, redwhite, white, blue, bluered, white, white, white, white, blue, red, bluered, white, whitered, red, red, white, white, red, blue, white, red, red, bluered, bluered, bluered, white, blue, whitered, red, blue, blue, white, red*)
 
Result:
{"red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "red", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "white", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "bluewhite", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue", "blue"}</pre>
 
In the unlikely event of this being something you'll want done often at very high speeds, Dijkstra's own algorithm for the task is somewhat faster:
 
<syntaxhighlight lang="applescript">on threeWayPartition(theList, order) -- Dijkstra's algorithm.
script o
property lst : theList
end script
set {v1, v2, v3} to order
set {i, j, k} to {1, 1, (count o's lst)}
repeat until (j > k)
set this to o's lst's item j
if (this = v3) then
set o's lst's item j to o's lst's item k
set o's lst's item k to this
set k to k - 1
else
if (this = v1) then
set o's lst's item j to o's lst's item i
set o's lst's item i to this
set i to i + 1
end if
set j to j + 1
end if
end repeat
return -- Input list sorted in place.
end threeWayPartition
 
on DutchNationalFlagProblem(numberOfBalls)
script o
property balls : {}
end script
set colours to {"red", "white", "blue"}
repeat numberOfBalls times
set end of o's balls to some item of colours
end repeat
threeWayPartition(o's balls, colours)
return o's balls
end DutchNationalFlagProblem
 
DutchNationalFlagProblem(100)</syntaxhighlight>
 
=={{header|Applesoft BASIC}}==
{{trans|ZX_Spectrum_Basic}}
<syntaxhighlight lang="applesoftbasic"> 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 </syntaxhighlight>
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotKeylang="autohotkey">RandGen(MaxBalls){
Random,k,3,MaxBalls
Loop,% k{
Line 367 ⟶ 602:
F:=RTrim(F,",")
Sort,F,N D`,
MsgBox,% F:=RegExReplace(RegExReplace(RegExReplace(F,"(1)","Red"),"(2)","White"),"(3)","Blue")</langsyntaxhighlight>
 
=={{header|AutoIt}}==
Given each color a value in descending order ( Red = 1, White = 2 And Blue = 3)
<syntaxhighlight lang="autoit">
<lang Autoit>
#include <Array.au3>
Dutch_Flag(50)
Line 396 ⟶ 631:
_ArrayDisplay($avArray)
EndFunc ;==>Dutch_Flag
</syntaxhighlight>
</lang>
 
=={{header|AWK}}==
{{works with|gawk}}
<langsyntaxhighlight lang="awk">
BEGIN {
weight[1] = "red"; weight[2] = "white"; weight[3] = "blue";
Line 448 ⟶ 683:
return 1
}
</syntaxhighlight>
</lang>
 
Output:
 
<syntaxhighlight lang="text">
BEFORE: blue red white red white blue red white blue white
 
Line 458 ⟶ 693:
 
Sorting is valid.
</syntaxhighlight>
</lang>
 
=={{header|BaConBASIC}}==
==={{header|BaCon}}===
<lang qbasic>DECLARE color$[] = { "red", "white", "blue" }
<syntaxhighlight lang="qbasic">DECLARE color$[] = { "red", "white", "blue" }
 
DOTIMES 16
Line 469 ⟶ 705:
PRINT "Unsorted: ", ball$
 
PRINT " Sorted: ", REPLACE$(SORT$(REPLACE$(ball$, "blue", "z")), "z", "blue")</langsyntaxhighlight>
{{out}}
<pre>
Line 476 ⟶ 712:
</pre>
 
==={{header|BBC BASICBASIC256}}===
<syntaxhighlight lang="basic256">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</syntaxhighlight>
 
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB"
Sort% = FN_sortinit(0,0)
Line 515 ⟶ 772:
prev% = weight%
NEXT
IF NOT sorted% PRINT "Error: Balls are not in correct order!"</langsyntaxhighlight>
{{out}}
<pre>
Line 523 ⟶ 780:
 
=={{header|C}}==
<langsyntaxhighlight lang="c">#include <stdio.h> //printf()
#include <stdlib.h> //srand(), rand(), RAND_MAX, qsort()
#include <stdbool.h> //true, false
Line 576 ⟶ 833:
}
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>Accidentally still sorted:rrrww
Line 583 ⟶ 840:
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <iostream>
 
Line 623 ⟶ 880:
dnf_partition(balls, balls + 9, WHITE, BLUE);
print(balls, 9);
}</langsyntaxhighlight>
{{out}}
<pre>
Line 633 ⟶ 890:
 
=={{header|C_sharp|C#}}==
<langsyntaxhighlight lang="csharp">using System;
using System.Collections.Generic;
using System.Linq;
Line 708 ⟶ 965:
}
}
</syntaxhighlight>
</lang>
 
=={{header|Ceylon}}==
Be sure to add ceylon.random in your module.ceylon file.
<langsyntaxhighlight lang="ceylon">import ceylon.random {
 
DefaultRandom
Line 793 ⟶ 1,050:
print(sortedBalls1);
print(sortedBalls2);
}</langsyntaxhighlight>
 
 
=={{header|Clojure}}==
<langsyntaxhighlight Clojurelang="clojure">(defn dutch-flag-order [color]
(get {:red 1 :white 2 :blue 3} color))
 
Line 815 ⟶ 1,072:
(if in-dutch-flag-order?
(recur num-balls)
balls)))</langsyntaxhighlight>
 
{{out}}
Line 825 ⟶ 1,082:
(sort-in-dutch-flag-order balls) ; (:red :red :red :red :red :white :white :white :white :white
; :white :white :blue :blue :blue :blue :blue :blue :blue :blue)
</pre>
 
=={{header|Common Lisp}}==
{{trans|Clojure}}
<syntaxhighlight lang="lisp">
(defun dutch-flag-order (color)
(case color (:red 1) (:white 2) (:blue 3)))
 
(defun sort-in-dutch-flag-order (balls)
(sort (copy-list balls) #'< :key #'dutch-flag-order))
 
(defun make-random-balls (count)
(loop :repeat count
:collect (nth (random 3) '(:red :white :blue))))
 
(defun make-balls (count)
(loop :for balls = (make-random-balls count)
:while (equal balls (sort-in-dutch-flag-order balls))
:finally (return balls)))
 
;; Alternative version showcasing iterate's finding clause
(defun make-balls2 (count)
(iter (for balls = (make-random-balls count))
(finding balls such-that (not (equal balls (sort-in-dutch-flag-order balls))))))
</syntaxhighlight>
{{out}}
<pre>
CL-USER> (defvar *balls* (make-balls 20))
*BALLS*
CL-USER> *balls*
(:WHITE :WHITE :WHITE :WHITE :RED :BLUE :RED :RED :WHITE :WHITE :RED :BLUE :RED
:RED :BLUE :WHITE :BLUE :BLUE :BLUE :BLUE)
CL-USER> (sort-in-dutch-flag-order *balls*)
(:RED :RED :RED :RED :RED :RED :WHITE :WHITE :WHITE :WHITE :WHITE :WHITE :WHITE
:BLUE :BLUE :BLUE :BLUE :BLUE :BLUE :BLUE)
</pre>
 
=={{header|D}}==
<langsyntaxhighlight lang="d">import std.stdio, std.random, std.algorithm, std.traits, std.array;
 
enum DutchColors { red, white, blue }
Line 858 ⟶ 1,150:
writeln("\nSorted Ball Order:\n", balls);
assert(balls[].isSorted, "Balls not sorted.");
}</langsyntaxhighlight>
{{out}}
<pre>Original Ball order:
Line 867 ⟶ 1,159:
 
===Bidirectional Range Version===
<langsyntaxhighlight lang="d">import std.stdio, std.random, std.algorithm, std.range,
std.array, std.traits;
 
Line 938 ⟶ 1,230:
assert(balls[0 .. n].isSorted());
}
}</langsyntaxhighlight>
The output is the same.
 
Line 944 ⟶ 1,236:
This version uses more contract programming and asserts to verify the code correctness.
With hints from: toccata.lri.fr/gallery/flag.en.html
<langsyntaxhighlight lang="d">import std.stdio, std.random, std.algorithm, std.traits, std.range;
 
enum Color : ubyte { blue, white, red }
Line 1,036 ⟶ 1,328:
writeln("\nSorted Ball Order:\n", balls);
assert(balls[].isSorted, "Balls not sorted.");
}</langsyntaxhighlight>
The output is the same.
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|Classes,SysUtils,StdCtrls}}
Encodes the colors to strings of "1" "2" and "3" to allow them to be sorted. Then it sses Delphi TStringList to sort the colors.
 
<syntaxhighlight lang="Delphi">
 
const TestOrder: array [0..11] of string =
('Blue','Blue','White','Blue','White','Blue',
'Red','White','White','Blue','White','Red');
 
 
procedure DoDutchFlag(Memo: TMemo; Order: array of string);
{Solve dutch flag color order using TStringList component}
{Encode colors "Red", "White" and "Blue" to "1", "2", and "3" }
{This allows them to be sorted in the TString List}
var I: integer;
var SL: TStringList;
var S2: string;
 
function DecodeList(SL: TStringList): string;
{Convert encoded colors 1, 2 and 3 to Red, White and Blue}
var I: integer;
begin
Result:='';
for I:=0 to SL.Count-1 do
begin
if I>0 then Result:=Result+',';
if SL[I]='1' then Result:=Result+'Red'
else if SL[I]='2' then Result:=Result+'White'
else Result:=Result+'Blue'
end;
end;
 
begin
SL:=TStringList.Create;
try
{Encode colors from array of strings}
for I:=0 to High(TestOrder) do
begin
if Order[I]='Red' then SL.Add('1')
else if Order[I]='White' then SL.Add('2')
else SL.Add('3');
end;
Memo.Lines.Add('Original Order:');
Memo.Lines.Add('['+DecodeList(SL)+']');
SL.Sort;
Memo.Lines.Add('Original Order:');
Memo.Lines.Add('['+DecodeList(SL)+']');
finally SL.Free; end;
end;
 
 
procedure ShowDutchFlag(Memo: TMemo);
begin
DoDutchFlag(Memo,TestOrder);
end;
 
</syntaxhighlight>
{{out}}
<pre>
Original Order:
[Blue,Blue,White,Blue,White,Blue,Red,White,White,Blue,White,Red]
Original Order:
[Red,Red,White,White,White,White,White,Blue,Blue,Blue,Blue,Blue]
</pre>
 
 
=={{header|EasyLang}}==
<syntaxhighlight>
col$[] = [ "red" "white" "blue" ]
for i to 8
b[] &= randint 3
.
for b in b[]
write col$[b] & " "
if b < b0
not_sorted = 1
.
b0 = b
.
print ""
print ""
if not_sorted = 0
print "already sorted"
else
for i = 1 to len b[] - 1
for j = i + 1 to len b[]
if b[j] < b[i]
swap b[j] b[i]
.
.
.
for b in b[]
write col$[b] & " "
.
.
</syntaxhighlight>
 
=={{header|Elixir}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="elixir">defmodule Dutch_national_flag do
defp ball(:red), do: 1
defp ball(:white), do: 2
Line 1,073 ⟶ 1,464:
end
 
Dutch_national_flag.problem</langsyntaxhighlight>
 
{{out}}
Line 1,084 ⟶ 1,475:
 
=={{header|Erlang}}==
<langsyntaxhighlight lang="erlang">-module(dutch).
-export([random_balls/1, is_dutch/1, dutch/1]).
 
Line 1,109 ⟶ 1,500:
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).</langsyntaxhighlight>
 
Sample usage:
<langsyntaxhighlight 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.</langsyntaxhighlight>
 
{{out}}
Line 1,126 ⟶ 1,517:
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">(* 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
Line 1,159 ⟶ 1,550:
let sorted = rs @ ws @ bs
printfn "The sequence %A is sorted: %b" sorted (isDutch sorted)
0</langsyntaxhighlight>
{{out}}
<pre>Sort the sequence of 10 balls: [Red; White; Red; Blue; White; White; Blue; Blue; White; White]
Line 1,166 ⟶ 1,557:
=={{header|Factor}}==
{{works with|Factor|0.99 2020-01-23}}
<langsyntaxhighlight lang="factor">USING: combinators grouping kernel math prettyprint random
sequences ;
 
Line 1,185 ⟶ 1,576:
] while 3nip ;
 
10 3 random-non-sorted-integers dup . dnf-sort! .</langsyntaxhighlight>
{{out}}
<pre>
Line 1,200 ⟶ 1,591:
https://github.com/bfox9900/CAMEL99-V2/blob/master/Video/DIJKSTRAFLAG%20.mp4
 
<syntaxhighlight lang="text">\ Dutch flag DEMO for CAMEL99 Forth
\ *SORTS IN PLACE FROM Video MEMORY*
 
Line 1,348 ⟶ 1,739:
CR ." Completed"
;
</syntaxhighlight>
</lang>
 
=={{header|Fortran}}==
Line 1,354 ⟶ 1,745:
 
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.
<syntaxhighlight lang="text">
!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Mon Jun 3 11:18:24
Line 1,460 ⟶ 1,851:
 
end program Netherlands
</syntaxhighlight>
</lang>
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">
' El problema planteado por Edsger Dijkstra es:
' "Dado un número de bolas rojas, azules y blancas en orden aleatorio,
Line 1,487 ⟶ 1,878:
Next i
End
</syntaxhighlight>
</lang>
 
=={{header|Gambas}}==
'''[https://gambas-playground.proko.eu/?gist=e57a862aff12647fa80c84a595161cb9 Click this link to run this code]'''
<langsyntaxhighlight lang="gambas">Public Sub Main()
Dim Red As String = "0"
Dim White As String = "1"
Line 1,516 ⟶ 1,907:
Next
 
End</langsyntaxhighlight>
Output:
<pre>
Line 1,524 ⟶ 1,915:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,611 ⟶ 2,002:
f.sort3()
fmt.Println(f)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,628 ⟶ 2,019:
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.
<langsyntaxhighlight Haskelllang="haskell">import Data.List (sort)
import System.Random (randomRIO)
import System.IO.Unsafe (unsafePerformIO)
Line 1,653 ⟶ 2,044:
False -> do
putStrLn $ "The starting random sequence is " ++ show a ++ "\n"
putStrLn $ "The ordered sequence is " ++ show (dutch a)</langsyntaxhighlight>
{{out}}
<pre>
Line 1,664 ⟶ 2,055:
 
To understand ''why'' Dijsktra was interested in the problem, here's an example showing difficiency of using generic sort:
<langsyntaxhighlight lang="haskell">inorder n = and $ zipWith (<=) n (tail n) -- or use Data.List.Ordered
 
mk012 :: Int -> Int -> [Int] -- definitely unordered
Line 1,684 ⟶ 2,075:
-- print $ inorder $ dutch1 s -- O(n)
print $ inorder $ dutch2 s -- O(n)
where s = mk012 10000000 42</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
Line 1,696 ⟶ 2,087:
force at least one of each color ball, change "?n-1" to "?n" in the 3rd line.
 
<langsyntaxhighlight lang="unicon">procedure main(a)
n := integer(!a) | 20
every (nr|nw|nb) := ?n-1
Line 1,717 ⟶ 2,108:
every (s := "") ||:= (find(c := !cset(w),w),c)
return s
end</langsyntaxhighlight>
 
A few sample runs:
Line 1,739 ⟶ 2,130:
=={{header|J}}==
We shall define a routine to convert the values 0 1 2 to ball names:
<langsyntaxhighlight Jlang="j">i2b=: {&(;:'red white blue')</langsyntaxhighlight>
and its inverse
<langsyntaxhighlight Jlang="j">b2i=: i2b inv</langsyntaxhighlight>
Next, we need a random assortment of balls:
<langsyntaxhighlight Jlang="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│
└────┴───┴────┴───┴───┴─────┴─────┴─────┴────┴────┴─────┴────┴────┴───┴────┴───┴─────┴───┴────┴───┘</langsyntaxhighlight>
And we want to sort them in their canonical order:
<langsyntaxhighlight Jlang="j"> /:~&.b2i BALLS
┌───┬───┬───┬───┬───┬───┬───┬─────┬─────┬─────┬─────┬─────┬────┬────┬────┬────┬────┬────┬────┬────┐
│red│red│red│red│red│red│red│white│white│white│white│white│blue│blue│blue│blue│blue│blue│blue│blue│
└───┴───┴───┴───┴───┴───┴───┴─────┴─────┴─────┴─────┴─────┴────┴────┴────┴────┴────┴────┴────┴────┘</langsyntaxhighlight>
Note that if we were not using J's built in sort, we would probably want to use [[Counting_sort|bin sort]] here.
 
Anyways, we can test that they are indeed sorted properly:
<langsyntaxhighlight Jlang="j"> assert@(-: /:~)&b2i /:~&.b2i BALLS</langsyntaxhighlight>
 
=={{header|Java}}==
The elements of an <code>enum</code> implement <code>Comparable</code> so the build-in sort works. You can also use this comparability to check the sort has worked.
<langsyntaxhighlight lang="java">import java.util.Arrays;
import java.util.Random;
 
Line 1,789 ⟶ 2,180:
System.out.println("Correctly sorted: " + sorted);
}
}</langsyntaxhighlight>
 
{{out}}
Line 1,798 ⟶ 2,189:
=={{header|Javascript}}==
===ES6===
<langsyntaxhighlight lang="javascript">const dutchNationalFlag = () => {
 
/**
Line 1,879 ⟶ 2,270:
};
dutchNationalFlag();
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,888 ⟶ 2,279:
Dutch Sorted balls: Red,Red,Red,Red,Red,Red,Red,Red,Red,White,White,White,White,White,White,White,Blue,Blue,Blue,Blue,Blue,Blue
Is sorted: true
</pre>
=={{header|jq}}==
{{works with|jq}}
'''Also works with gojq, the Go implementation of jq.'''
 
'''Adapted from [[#Wren|Wren]]'''
 
In the following, /dev/random is used as a source of entropy.
In a bash or bash-like environment, a suitable invocation would
be as follows:
<pre>
< /dev/random tr -cd '0-9' | fold -w 1 | jq -Mcnr -f dnf.jq
</pre>
'''dnf.jq'''
<syntaxhighlight lang=jq>
# Output: a PRN in range(0; .)
def prn:
if . == 1 then 0
else . as $n
| (($n-1)|tostring|length) as $w
| [limit($w; inputs)] | join("") | tonumber
| if . < $n then . else ($n | prn) end
end;
 
def colors: ["Red", "White", "Blue"];
 
def colorMap: {"Red": 0, "White": 1, "Blue": 2 };
 
def task($nballs):
def sorted:
. == sort_by(colorMap[.]);
def generate:
[range(0; $nballs) | colors[ 3|prn ] ]
| if sorted then generate else . end;
generate
| "Before sorting : \(.)",
"After sorting : \(sort_by(colorMap[.]))" ;
 
task(9)
</syntaxhighlight>
{{output}}
<pre>
Before sorting : ["Blue","Red","Blue","White","Blue","White","Red","White","Blue"]
After sorting : ["Red","Red","White","White","White","Blue","Blue","Blue","Blue"]
</pre>
 
Line 1,894 ⟶ 2,329:
 
'''Function'''
<syntaxhighlight lang="julia">
<lang Julia>
const COLORS = ["red", "white", "blue"]
 
Line 1,919 ⟶ 2,354:
dutchsort!(copy(a), lo, hi)
end
</syntaxhighlight>
</lang>
 
'''Main'''
<syntaxhighlight lang="julia">
<lang Julia>
function formatdf(a::Array{ASCIIString,1})
i = 0
Line 1,953 ⟶ 2,388:
@time e = sort(d, by=x->findfirst(COLORS, x))
println(formatdf(e))
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,973 ⟶ 2,408:
=={{header|Kotlin}}==
{{trans|D}}
<langsyntaxhighlight lang="scala">// version 1.1.4
 
import java.util.Random
Line 2,025 ⟶ 2,460:
// print the colors of the balls after sorting
println("After sorting : ${balls.contentToString()}")
}</langsyntaxhighlight>
 
Sample output:
Line 2,034 ⟶ 2,469:
 
=={{header|Lasso}}==
<langsyntaxhighlight Lassolang="lasso">define orderdutchflag(a) => {
local(r = array, w = array, b = array)
with i in #a do => {
Line 2,049 ⟶ 2,484:
}
 
orderdutchflag(array('Red', 'Red', 'Blue', 'Blue', 'Blue', 'Red', 'Red', 'Red', 'White', 'Blue'))</langsyntaxhighlight>
{{out}}
<pre>array(Red, Red, Red, Red, Red, White, Blue, Blue, Blue, Blue)</pre>
 
=={{header|Logo}}==
<langsyntaxhighlight lang="logo">; We'll just use words for the balls
make "colors {red white blue}
 
Line 2,121 ⟶ 2,556:
setitem :a :array item :b :array
setitem :b :array :temp
end</langsyntaxhighlight>
 
Test code:
<syntaxhighlight lang="text">do.while [
make "list random_balls 10
] [dutch? :list]
Line 2,130 ⟶ 2,565:
print (sentence [Start list:] arraytolist :list)
print (sentence [Sorted:] arraytolist dutch :list)
bye</langsyntaxhighlight>
 
{{out}}
<pre>Start list: white blue red red red white blue red red white
Sorted: red red red red red white white white blue blue</pre>
 
=={{header|Lua}}==
The task seems to allow for some interpretation, so attempting to follow as literally as possible.
<syntaxhighlight lang="lua">-- "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!!")</syntaxhighlight>
{{out}}
<pre>RANDOM: white,white,blue,blue,red,red,blue,white,red,white
SORTED: red,red,red,white,white,white,white,blue,blue,blue
Properly sorted.</pre>
 
=={{header|M2000 Interpreter}}==
Most times the Three Way Partition makes more changed than the first algorithm. Also if the array is sorted from the start, no changes give the first algorithm and 23 changes the Three Way Partition,
 
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Report "Dutch Flag from Dijkstra"
const center=2
Line 2,273 ⟶ 2,743:
Report TestSort$(final())+Display$(final())
print "changes: "; many
Module three_way_partition (A as array, mid as balls, &swaps) {
</lang>
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
 
</syntaxhighlight>
 
{{out}}
Line 2,286 ⟶ 2,786:
sorted: Red, Red, Red, Red, Red, Red, Red, Red, Red, White, White, White, White, White, White, White, White, White, White, White, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue
changes: 20
Three Way Partition
unsorted: Red, White, White, Red, Red, White, Blue, Red, Red, Blue, Red, Blue, White, White, Red, White, Blue, Blue, White, Blue, Red, Blue, Blue, White, Blue, White, Blue, Red, White, White
sorted: Red, Red, Red, Red, Red, Red, Red, Red, Red, White, White, White, White, White, White, White, White, White, White, White, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue, Blue
changes: 19
</pre>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">flagSort[data_List] := Sort[data, (#1 === RED || #2 === BLUE) &]</langsyntaxhighlight>
{{out}}
<pre>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}</pre>
 
=={{header|Nim}}==
We have chosen to use the sorting algorithm proposed by Dijkstra. To switch from our solution to one using Nim sorting algorithm, one has to add “import algorithm” at the beginning and to replace the lines <code>var sortedColors = colors</code> and <code>threeWayPartition(sortedColors, White)</code> by the single line <code>let sortedColors = sorted(colors)</code>.
 
The number of colors may be specified as argument in the command line. By default, 10 colors are randomly chosen.
 
<syntaxhighlight lang="nim">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("")</syntaxhighlight>
 
{{out}}
With 10 colors:
<pre>Original: WWWRBRWWBW
Sorted: RRWWWWWWBB</pre>
 
=={{header|PARI/GP}}==
A [[counting sort]] might be more appropriate here, but that would conceal the details of the sort.
<langsyntaxhighlight lang="parigp">compare(a,b)={
if (a==b,
0
Line 2,310 ⟶ 2,889:
while(inorder(v), v=r(10));
v=vecsort(v,compare);
inorder(v)</langsyntaxhighlight>
 
{{out}}
Line 2,317 ⟶ 2,896:
=={{header|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:
<langsyntaxhighlight lang="perl">use warnings;
use strict;
use 5.010; # //
Line 2,388 ⟶ 2,967:
 
show($balls);
are_ordered($balls) or die "Incorrect\n";</langsyntaxhighlight>
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.
 
=={{header|Phix}}==
Minimizes the number of read and swap operations, straight translation of the wikipedia pseudocode:
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function three_way_partition(sequence s, integer mid)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
integer i=1, j=1, n = length(s)
<span style="color: #008080;">function</span> <span style="color: #000000;">three_way_partition</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">mid</span><span style="color: #0000FF;">)</span>
 
<span style="color: #004080;">integer</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
while j < n do
<span style="color: #008080;">while</span> <span style="color: #000000;">j</span> <span style="color: #0000FF;"><=</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
if s[j] < mid then
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;"><</span> <span style="color: #000000;">mid</span> <span style="color: #008080;">then</span>
{s[i],s[j]} = {s[j],s[i]}
<span style="color: #0000FF;">{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]}</span>
i += 1
<span style="color: #000000;">i</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
j += 1
<span style="color: #000000;">j</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
elsif s[j] > mid then
<span style="color: #008080;">elsif</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">></span> <span style="color: #000000;">mid</span> <span style="color: #008080;">then</span>
{s[j],s[n]} = {s[n],s[j]}
<span style="color: #0000FF;">{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]}</span>
n -= 1
<span style="color: #000000;">n</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
else
<span j +style="color: 1#008080;">else</span>
<span style="color: #000000;">j</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end while
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
return s
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
 
constant colours = {"red","white","blue"}
<span style="color: #008080;">constant</span> <span style="color: #000000;">colours</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"red"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"white"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"blue"</span><span style="color: #0000FF;">}</span>
enum /*red,*/ white = 2, blue, maxc = blue
<span style="color: #008080;">enum</span> <span style="color: #000080;font-style:italic;">/*red,*/</span> <span style="color: #000000;">white</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">blue</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">maxc</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">blue</span>
 
procedure show(string msg, sequence s)
<span style="color: #008080;">procedure</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">msg</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
for i=1 to length(s) do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">))</span>
s[i] = colours[s[i]]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">colours</span><span style="color: #0000FF;">[</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]]</span>
printf(1,"%s: %s\n",{msg,join(s)})
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end procedure
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s: %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">msg</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)})</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
sequence unsorted, sorted
while 1 do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">unsorted</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">sorted</span>
unsorted = sq_rand(repeat(maxc,12))
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
-- sorted = sort(unsorted) -- (works just as well)
<span style="color: #000000;">unsorted</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_rand</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">maxc</span><span style="color: #0000FF;">,</span><span style="color: #000000;">12</span><span style="color: #0000FF;">))</span>
sorted = three_way_partition(unsorted, white)
<span style="color: #000080;font-style:italic;">-- sorted = sort(deep_copy(unsorted)) -- (works just as well)</span>
if unsorted!=sorted then exit end if
<span style="color: #000000;">sorted</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">three_way_partition</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">unsorted</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">white</span><span style="color: #0000FF;">)</span>
?"oops"
<span style="color: #008080;">if</span> <span style="color: #000000;">unsorted</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">sorted</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end while
<span style="color: #0000FF;">?</span><span style="color: #008000;">"oops"</span>
show("Unsorted",unsorted)
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
show("Sorted",sorted)</lang>
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"Unsorted"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">unsorted</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"Sorted"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">sorted</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
<small>I thought of unsorted=shuffle(unsorted) in the "oops" loop, but of course that'd repeat forever should they all be the same colour.</small>
{{out}}
Line 2,437 ⟶ 3,019:
Sorted: red red red white white white white blue blue blue blue blue
</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">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]).</syntaxhighlight>
 
{{out}}
<pre>rand = [red,blue,white,white,white,blue,blue,blue,red,red,blue,white,blue,blue,red,white,blue,blue,white,white,red]
sorted = [red,red,red,red,red,white,white,white,white,white,white,white,blue,blue,blue,blue,blue,blue,blue,blue,blue]</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(def 'Colors
(list
(def 'RED 1)
Line 2,451 ⟶ 3,063:
(prin "Sorted balls ")
(print S)
(prinl " are sorted") )</langsyntaxhighlight>
{{out}}
<pre>Original balls (RED BLUE WHITE BLUE BLUE RED WHITE WHITE WHITE) not sorted
Line 2,458 ⟶ 3,070:
=={{header|PowerShell}}==
{{works with|PowerShell|2}}
<syntaxhighlight lang="powershell">
<lang PowerShell>
$Colors = 'red', 'white','blue'
Line 2,475 ⟶ 3,087:
''
$SortedBalls
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,504 ⟶ 3,116:
Works with SWI-Prolog 6.1.11
===Prolog spirit===
<langsyntaxhighlight Prologlang="prolog">dutch_flag(N) :-
length(L, N),
repeat,
Line 2,563 ⟶ 3,175:
 
is_dutch_flag_blue([]).
</syntaxhighlight>
</lang>
{{out}}
<pre> ?- dutch_flag(20).
Line 2,576 ⟶ 3,188:
===Functional spirit===
Use of filters.
<langsyntaxhighlight Prologlang="prolog">dutch_flag(N) :-
length(L, N),
 
Line 2,638 ⟶ 3,250:
 
is_dutch_flag_blue([]).
</syntaxhighlight>
</lang>
 
=={{header|Python}}==
===Python: Sorted===
The heart of the idiomatic Dutch sort in python is the call to function <code>sorted</code> in function <code>dutch_flag_sort</code>.
<langsyntaxhighlight lang="python">import random
 
colours_in_order = 'Red White Blue'.split()
Line 2,677 ⟶ 3,289:
 
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{out|Sample output}}
<pre>Original Ball order: ['Red', 'Red', 'Blue', 'Blue', 'Blue', 'Red', 'Red', 'Red', 'White', 'Blue']
Line 2,687 ⟶ 3,299:
 
Replace the function/function call dutch_flag_sort above, with dutch_flag_sort2 defined as:
<langsyntaxhighlight 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))</langsyntaxhighlight>
 
Or equivalently using a list comprehension (though perhaps less clear):
<langsyntaxhighlight 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]</langsyntaxhighlight>
Output follows that of the sorting solution above.
 
Line 2,703 ⟶ 3,315:
 
Replace the function/function call dutch_flag_sort above, with dutch_flag_sort3 defined as:
<langsyntaxhighlight 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], [])</langsyntaxhighlight>
Output follows that of the sorting solution above.
 
===Python: Explicit in-place sort===
<langsyntaxhighlight lang="python">import random
 
colours_in_order = 'Red White Blue'.split()
Line 2,758 ⟶ 3,370:
 
if __name__ == '__main__':
main()</langsyntaxhighlight>
Output follows that of the sorting solution above.
 
=={{header|Racket}}==
 
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 2,799 ⟶ 3,411:
balls sorted (if (dutch-order? sorted) 'OK 'BAD)))
(for-each test (list sort-balls/key sort-balls/compare))
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,816 ⟶ 3,428:
(formerly Perl 6)
Here are five ways to do it, all one liners (apart from the test apparatus).
<syntaxhighlight lang="raku" perl6line>enum NL <red white blue>;
my @colors;
 
Line 2,845 ⟶ 3,457:
 
say "Using multiple greps";
how'bout { @colors = flat (.grep(red), .grep(white), .grep(blue) given @colors) }</langsyntaxhighlight>
{{out}}
<pre>Using functional sort
Line 2,883 ⟶ 3,495:
The REXX solution could've been simplified somewhat by the use of the &nbsp; '''countstr''' &nbsp; BIF &nbsp; (but some older REXX interpreters don't have).
 
<langsyntaxhighlight lang="rexx">/*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*/
Line 2,914 ⟶ 3,526:
/*──────────────────────────────────────────────────────────────────────────────────────*/
countWords: procedure; parse arg ?,hay; s=1
do r=0 until _==0; _=wordpos(?, hay, s); s=_+1; end /*r*/; return r</langsyntaxhighlight>
'''output''' &nbsp; when using the default input:
<pre>
Line 2,931 ⟶ 3,543:
 
===colors (as letters)===
<langsyntaxhighlight lang="rexx">/*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*/
Line 2,959 ⟶ 3,571:
say
say 'The sorted colored ball list has been confirmed as being sorted correctly.'
exit /*stick a fork in it, we're all done. */</langsyntaxhighlight>
'''output''' &nbsp; when using the default input:
<pre>
Line 2,976 ⟶ 3,588:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
# Project : Dutch national flag problem
 
Line 2,999 ⟶ 3,611:
next
next
</syntaxhighlight>
</lang>
Output:
<pre>
Line 3,007 ⟶ 3,619:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">class Ball
FLAG = {red: 1, white: 2, blue: 3}
Line 3,032 ⟶ 3,644:
puts "Random: #{balls}"
puts "Sorted: #{balls.sort}"
</langsyntaxhighlight>
{{out}}
<pre>Random: [blue, red, red, red, blue, blue, white, red]
Line 3,039 ⟶ 3,651:
 
=={{header|Run BASIC}}==
<langsyntaxhighlight lang="runbasic">flag$ = "Red,White,Blue"
 
print "Random: |";
Line 3,056 ⟶ 3,668:
end if
next j
next i</langsyntaxhighlight>
<pre>Random: |White |Blue |White |Red |Red |White |Red |Blue |Red |White |
Sorted: |Red |Red |Red |Red |White |White |White |White |Blue |Blue |</pre>
Line 3,062 ⟶ 3,674:
=={{header|Rust}}==
{{libheader|rand}}
<langsyntaxhighlight lang="rust">extern crate rand;
 
use rand::Rng;
Line 3,105 ⟶ 3,717:
println!("Oops, did not sort colors correctly!");
}
}</langsyntaxhighlight>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">object FlagColor extends Enumeration {
type FlagColor = Value
val Red, White, Blue = Value
Line 3,118 ⟶ 3,730:
 
println(s"Generated balls (${genBalls mkString " "}) are $sorted.")
println(s"Sorted balls (${sortedBalls mkString " "}) are sorted.")</langsyntaxhighlight>
 
{{out}}
<pre>Generated balls (Blue Blue Blue White Blue Blue Red Red Blue White) are not sorted.
Sorted balls (Red Red White White Blue Blue Blue Blue Blue Blue) are sorted.</pre>
 
=={{header|sed}}==
The first part of the task is skipped, as there is no possibility to create random data within ''sed'' itself.
<syntaxhighlight lang="sed">:la
s/\(WW*\)\([RB].*\)/\2\1/
t la
:lb
s/\(BB*\)\([RW].*\)/\2\1/
t lb
/^RR*WW*BB*$/!d</syntaxhighlight>
{{out}}
<pre>
$ echo WRRWRRRBBWBRRWBWWB | sed -f dutch_flag_sort.sed
RRRRRRRWWWWWWBBBBB
</pre>
 
=={{header|SQL}}==
<langsyntaxhighlight SQLlang="sql">-- Create and populate tables
create table colours (id integer primary key, name varchar(5));
insert into colours (id, name) values ( 1, 'red' );
Line 3,159 ⟶ 3,786:
-- Tidy up
drop table balls;
drop table colours;</langsyntaxhighlight>
{{out}}
<pre>COLOUR
Line 3,186 ⟶ 3,813:
# ''Sort the balls in a way idiomatic to your language.'' Yup!
# ''Check the sorted balls are in the order of the Dutch national flag.'' Not checked beyond eyeballing - is there a db implementation that gets <tt>order by</tt> wrong??
 
=={{header|Swift}}==
<syntaxhighlight lang="swift">// Algorithm from https://en.wikipedia.org/wiki/Dutch_national_flag_problem
func partition3<T: Comparable>(_ a: inout [T], mid: T) {
var i = 0
var j = 0
var k = a.count - 1
while j <= k {
if a[j] < mid {
a.swapAt(i, j);
i += 1;
j += 1;
} else if a[j] > mid {
a.swapAt(j, k);
k -= 1;
} else {
j += 1;
}
}
}
 
func isSorted<T: Comparable>(_ a: [T]) -> Bool {
var i = 0
let n = a.count
while i + 1 < n {
if a[i] > a[i + 1] {
return false
}
i += 1
}
return true
}
 
enum Ball : CustomStringConvertible, Comparable {
case red
case white
case blue
var description : String {
switch self {
case .red: return "red"
case .white: return "white"
case .blue: return "blue"
}
}
}
 
var balls: [Ball] = [ Ball.red, Ball.white, Ball.blue,
Ball.red, Ball.white, Ball.blue,
Ball.red, Ball.white, Ball.blue]
balls.shuffle()
print("\(balls)")
print("Sorted: \(isSorted(balls))")
 
partition3(&balls, mid: Ball.white)
print("\(balls)")
print("Sorted: \(isSorted(balls))")</syntaxhighlight>
 
{{out}}
<pre>
[white, blue, red, red, white, blue, red, blue, white]
Sorted: false
[red, red, red, white, white, white, blue, blue, blue]
Sorted: true
</pre>
 
=={{header|Tcl}}==
This isn't very efficient in terms of the sorting itself (and it happens to use <code>lsearch</code> twice in the comparator!) but it is very simple to write like this.
<langsyntaxhighlight lang="tcl"># The comparison function
proc dutchflagcompare {a b} {
set colors {red white blue}
Line 3,218 ⟶ 3,910:
} else {
puts "sort failed\n$sorted"
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,224 ⟶ 3,916:
red red red red red red red white white white white white white white white white blue blue blue blue
</pre>
 
=={{header|uBasic/4tH}}==
This version is based on Edsger Dijkstra's original algorithm. The flag may come out a bit shredded , but it has been assembled the correct way.
<syntaxhighlight lang="text">s = 100
 
For x = 0 To s-1
@(x) = Rnd(3)
Next
' Edsger Dijkstra algorithm starts here
i = 0
j = 0
k = s-1
Do
While j < k+1
If @(j) = 0 Then ' case "red"
Push @(j) : @(j) = @(i) : @(i) = Pop()
i = i + 1 ' fairly efficient exchange
j = j + 1
Else If @(j) = 2 Then ' case "blue"
Push @(j) : @(j) = @(k) : @(k) = Pop()
k = k - 1 ' fairly efficient exchange
Else ' you'd expect case "white" here
j = j + 1
Endif Endif
Loop
' end of Dijkstra's algorithm
n = 0
 
For x = 0 To s-1 ' now show the whole shebang
If @(x) # n Then Print : n = @(x)
Print Chr(Peek ("RWB", @(x)));
Next
 
Print</syntaxhighlight>
{{Out}}
<pre>RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
 
0 OK, 0:858</pre>
 
=={{header|UNIX Shell}}==
{{works with|Bash}}
<langsyntaxhighlight lang="bash">COLORS=(red white blue)
 
# to go from name to number, we make variables out of the color names
Line 3,284 ⟶ 4,017:
done
echo "${a[@]}"
}</langsyntaxhighlight>
 
Test code:
<langsyntaxhighlight lang="bash">declare -i len=${1:-10}
balls=()
while (( ${#balls[@]} < len )) || dutch? "${balls[@]}"; do
Line 3,294 ⟶ 4,027:
echo "Initial list: ${balls[@]}"
balls=($(dutch "${balls[@]}"))
echo "Sorted: ${balls[@]}"</langsyntaxhighlight>
 
{{out}}
Line 3,301 ⟶ 4,034:
 
=={{header|VBScript}}==
<syntaxhighlight lang="vb">
<lang vb>
'Solution derived from http://www.geeksforgeeks.org/sort-an-array-of-0s-1s-and-2s/.
 
Line 3,346 ⟶ 4,079:
WScript.StdOut.Write "Sorted: " & sort(unsort)
WScript.StdOut.WriteLine
</syntaxhighlight>
</lang>
 
{{Out}}
Line 3,356 ⟶ 4,089:
=={{header|Visual FoxPro}}==
===SQL Version===
<langsyntaxhighlight lang="vfp">
CLOSE DATABASES ALL
LOCAL lcCollate As String, i As Integer, n As Integer
Line 3,391 ⟶ 4,124:
RETURN INT(3*RAND()) + 1
ENDFUNC
</syntaxhighlight>
</lang>
===Array Version===
<langsyntaxhighlight lang="vfp">
LOCAL i As Integer, n As Integer, colours As String, k As Integer
colours = "Red,White,Blue"
Line 3,429 ⟶ 4,162:
RETURN INT(3*RAND()) + 1
ENDFUNC
</syntaxhighlight>
</lang>
 
=={{header|Wren}}==
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">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)")</syntaxhighlight>
 
{{out}}
Sample run:
<pre>
Before sorting : [Blue, Blue, White, Blue, White, Blue, Red, White, White]
After sorting : [Red, White, White, White, White, Blue, Blue, Blue, Blue]
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang "XPL0">
def Red, White, Blue;
def Size = 10;
int A(Size), N;
 
proc ShowOrder;
[for N:= 0 to Size-1 do
case A(N) of
Red: Text(0, "Red ");
Blue: Text(0, "Blue ")
other Text(0, "White ");
CrLf(0);
];
 
proc Part3Ways; \Partition array A three ways (code from Wikipedia)
def Mid = White;
int I, J, K, T;
[I:= 0; J:= 0; K:= Size-1;
while J <= K do
if A(J) < Mid then
[T:= A(I); A(I):= A(J); A(J):= T;
I:= I+1;
J:= J+1;
]
else if A(J) > Mid then
[T:= A(J); A(J):= A(K); A(K):= T;
K:= K-1;
]
else J:= J+1;
];
 
[for N:= 0 to Size-1 do A(N):= Ran(3);
Text(0, "Original order : ");
ShowOrder;
Part3Ways;
Text(0, "Sorted order : ");
ShowOrder;
]</syntaxhighlight>
{{out}}
<pre>
Original order : Red Red Blue Blue White Red Red White Blue Red
Sorted order : Red Red Red Red Red White White Blue Blue Blue
</pre>
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">const RED=0, WHITE=1, BLUE=2; var BALLS=T(RED,WHITE,BLUE);
fcn colorBalls(balls){ balls.apply(T("red","white","blue").get).concat(", "); }
 
Line 3,441 ⟶ 4,247:
}while(balls==sortedBalls); // make sure sort does something
println("Original ball order:\n", colorBalls(balls));
println("\nSorted ball order:\n", colorBalls(sortedBalls));</langsyntaxhighlight>
{{out}}
<pre>
Line 3,453 ⟶ 4,259:
=={{header|ZX Spectrum Basic}}==
{{trans|Run_BASIC}}
<langsyntaxhighlight lang="zxbasic">10 LET r$="Red": LET w$="White": LET b$="Blue"
20 LET c$="RWB"
30 DIM b(10)
Line 3,466 ⟶ 4,272:
120 IF b(j)=i THEN PRINT VAL$ (c$(i)+"$");" ";
130 NEXT j
140 NEXT i</langsyntaxhighlight>
Chkas
1,979

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/216470...351592"