80 lines
1.2 KiB
Text
80 lines
1.2 KiB
Text
MODULE DutchF;
|
|
(* Dutch national flag problem *)
|
|
|
|
FROM RandomNumbers IMPORT
|
|
Rnd;
|
|
FROM STextIO IMPORT
|
|
WriteLn, WriteString;
|
|
|
|
TYPE
|
|
TColor = (Blue, White, Red);
|
|
|
|
CONST
|
|
N = 20;
|
|
|
|
VAR
|
|
T: ARRAY [0 .. N - 1] OF TColor;
|
|
I: CARDINAL;
|
|
|
|
PROCEDURE Swap(VAR A, B: TColor);
|
|
VAR
|
|
Tmp: TColor;
|
|
BEGIN
|
|
Tmp := A;
|
|
A := B;
|
|
B := Tmp
|
|
END Swap;
|
|
|
|
PROCEDURE WriteColorSeq(T: ARRAY OF TColor);
|
|
VAR
|
|
I: CARDINAL;
|
|
BEGIN
|
|
FOR I := 0 TO HIGH(T) DO
|
|
CASE T[I] OF
|
|
| Blue:
|
|
WriteString("B");
|
|
| White:
|
|
WriteString("W");
|
|
| Red:
|
|
WriteString("R");
|
|
END
|
|
END;
|
|
WriteLn;
|
|
END WriteColorSeq;
|
|
|
|
PROCEDURE SortByColor(VAR T: ARRAY OF TColor);
|
|
VAR
|
|
B, W, R: CARDINAL;
|
|
BEGIN
|
|
B := 0;
|
|
W := 0;
|
|
R := HIGH(T);
|
|
WHILE W <= R DO
|
|
CASE T[W] OF
|
|
| White:
|
|
W := W + 1;
|
|
| Blue:
|
|
Swap(T[B], T[W]);
|
|
B := B + 1;
|
|
W := W + 1;
|
|
| Red:
|
|
Swap(T[W], T[R]);
|
|
R := R - 1;
|
|
END;
|
|
END;
|
|
END SortByColor;
|
|
|
|
BEGIN
|
|
(* Set colors *)
|
|
FOR I := 0 TO N - 1 DO
|
|
T[I] := VAL(TColor, Rnd(3));
|
|
END;
|
|
WriteString("Unsorted:");
|
|
WriteLn;
|
|
WriteColorSeq(T);
|
|
SortByColor(T);
|
|
WriteLn;
|
|
WriteString("Sorted:");
|
|
WriteLn;
|
|
WriteColorSeq(T);
|
|
END DutchF.
|