YAPC::EU 2018 Glasgow Update!

Task/Dutch-national-flag-problem/Ceylon/dutch-national-flag-problem.ceylon

@@ -0,0 +1,82 @@
+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);
+}

Task/Dutch-national-flag-problem/Forth/dutch-national-flag-problem.fth

@@ -0,0 +1,148 @@
+\ 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 VC@ REDSQR =
+           WHILE DROP
+           REPEAT ;
+
+: NOTREDWHT    ( -- n ) \ return rnd index that is not RED or WHITE
+           BEGIN  RNDI DUP
+              VC@  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 VC@ OVER VC@       ( -- 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 @ VC@  ( 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"
+;

Task/Dutch-national-flag-problem/Ring/dutch-national-flag-problem.ring

@@ -1,7 +1,4 @@
 # Project : Dutch national flag problem
-# Date    : 2017/11/23
-# Author : Gal Zsolt (~ CalmoSoft ~)
-# Email   : <calmosoft@gmail.com>
 
 flag = ["Red","White","Blue"]
 balls = list(10)