bulls-and-cows.a68
1 COMMENT
2
3 @section Synopsis
4
5 Break a unique code of `n' pegs and `m' colours you think of.
6
7 After the program published on Rosetta Code by Marcel van der Veer.
8
9 COMMENT
10
11 INT pegs = 4, colours = 6;
12
13 MODE LIST = FLEX [1 : 0] COMBINATION,
14 COMBINATION = [pegs] COLOUR,
15 COLOUR = INT;
16
17 OP +:= = (REF LIST u, COMBINATION v) REF LIST:
18 # Add one combination to a list. #
19 ([UPB u + 1] COMBINATION w; w[ : UPB u] := u; w[UPB w] := v; u := w);
20
21 PROC gen = (REF COMBINATION part, INT peg) VOID:
22 # Generate all unique [colours!/(colours-pegs)!] combinations. #
23 IF peg > pegs
24 THEN all combinations +:= part
25 ELSE FOR i TO colours
26 DO IF BOOL unique := TRUE;
27 FOR j TO peg - 1 WHILE unique
28 DO unique := part[j] ~= i
29 OD;
30 unique
31 THEN part[peg] := i;
32 gen (part, peg + 1)
33 FI
34 OD
35 FI;
36
37 LIST all combinations;
38 gen (LOC COMBINATION, 1);
39
40 PROC break code = (LIST sieved) VOID:
41 # Present a trial and sieve the list with the entered score. #
42 CASE UPB sieved + 1
43 IN # No elements. # printf ($l"Inconsistent scores"$),
44 # One element. # printf (($l"Solution is "4(xd)$, sieved[1]))
45 OUT printf (($l"["g(0)"]"x4(xd)": "$, UPB sieved, sieved[1]));
46 # Read the score as a sequence of "w" and "b". #
47 INT col ok := 0, pos ok := 0, STRING z := "";
48 WHILE z = ""
49 DO read ((z, new line))
50 OD;
51 FOR i TO UPB z
52 DO (z[i] = "c" | col ok |: z[i] = "b" | pos ok) +:= 1
53 OD;
54 (pos ok = pegs | stop);
55 # Survivors are combinations with score as entered. #
56 LIST survivors;
57 FOR i FROM 2 TO UPB sieved
58 DO INT col ok i := 0, pos ok i := 0;
59 FOR u TO pegs
60 DO FOR v TO pegs
61 DO IF sieved[1][u] = sieved[i][v]
62 THEN (u = v | pos ok i | col ok i) +:= 1
63 FI
64 OD
65 OD;
66 (col ok = col ok i AND pos ok = pos ok i | survivors +:= sieved[i])
67 OD;
68 # Solution must be among the survivors. #
69 break code (survivors)
70 ESAC;
71
72 break code (all combinations)
