Algol 68 Genie

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)
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.