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

5,031 bytes added ,  3 months ago
m
→‎{{header|EasyLang}}
(Add Common Lisp (based on Clojure's structure))
 
(21 intermediate revisions by 10 users not shown)
Line 492:
 
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later.
 
use sorter : script ¬
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
-- This script uses a"Custom customisableIterative AppleScriptTernary sortMerge available atSort" --<https://www.macscripter.net/viewtopic.php?pid=194430#p194430t/timsort-and-nigsort/71383/3>.
-- 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"}
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
Line 530 ⟶ 519:
{{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}}==
Line 662 ⟶ 695:
</syntaxhighlight>
 
=={{header|BaConBASIC}}==
==={{header|BaCon}}===
<syntaxhighlight lang="qbasic">DECLARE color$[] = { "red", "white", "blue" }
 
Line 678 ⟶ 712:
</pre>
 
==={{header|BASIC256}}===
<syntaxhighlight lang="basic256">arraybase 1
dim flag = {"Red","White","Blue"}
Line 699 ⟶ 733:
next i</syntaxhighlight>
 
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB"
Line 1,296 ⟶ 1,330:
}</syntaxhighlight>
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}}==
Line 3,680 ⟶ 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}}==
Line 3,737 ⟶ 3,935:
i = i + 1 ' fairly efficient exchange
j = j + 1
Else If @(j) = 2 thenThen ' case "blue"
Push @(j) : @(j) = @(k) : @(k) = Pop()
k = k - 1 ' fairly efficient exchange
Line 3,759 ⟶ 3,957:
 
0 OK, 0:858</pre>
 
=={{header|UNIX Shell}}==
{{works with|Bash}}
Line 3,967 ⟶ 4,166:
=={{header|Wren}}==
{{libheader|Wren-sort}}
<syntaxhighlight lang="ecmascriptwren">import "random" for Random
import "./sort" for Sort
 
var colors = ["Red", "White", "Blue"]
Line 3,991 ⟶ 4,190:
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>
 
Chkas
1,978

edits

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