sourcegames/sudoku/sudoku.xtl
1⍝!/usr/bin/env xetal
2⍝# Sudoku solved by array programs, with the rules of SudokuGrid.xtl:
3⍝# every cell's candidates at once, every single at once, rounds until
4⍝# nothing changes, and a search only when rounds stall.
5ˢ⁼u̲se< "SudokuGrid"
6
7⍝ Puzzle 1 (Wikipedia's example): 30 givens, 51 empty cells.
8g ← 1 s̲elect ˢp̲uzzles @
9ˢs̲hown g
10'+ r̲/ 0 + g = 0
11
12⍝ The 27 units as a table of cells: the first row, column and box.
13U ← ˢu̲nits @
14s̲hape U
151 10 19 s̲elect U
16
17⍝ Every cell's candidates at once, 81 by 9: a digit is open where none
18⍝ of the cell's three units holds it. How many each cell has (a placed
19⍝ cell keeps its own digit, 1):
20c ← ˢc̲andidates g
21s̲hape c
229 9 r̲eshape '+ r̲/₂ c
23⍝ Row 1, column 3 can be 1, 2 or 4.
24w̲here 3 s̲elect c
25
26⍝ One round fills every single at once: naked singles (one candidate
27⍝ left) and hidden singles (a digit with one place left in a unit).
28ˢs̲hown ˢr̲ound g
29⍝ Rounds until nothing changes: this puzzle needs no more.
30ˢr̲ounds g
31ˢs̲hown ˢp̲ropagate g
32
33⍝ Puzzle 2: 17 givens, the fewest a sudoku with one solution can have;
34⍝ singles still finish it.
35h ← 2 s̲elect ˢp̲uzzles @
36'+ r̲/ 0 + h ≠ 0
37ˢr̲ounds h
38ˢs̲hown ˢp̲ropagate h
39
40⍝ Puzzle 4 (Arto Inkala's): rounds stall at once, with 60 cells empty.
41k ← 4 s̲elect ˢp̲uzzles @
42'+ r̲/ 0 + 0 = ˢp̲ropagate k
43⍝ Then a search: guess in the cell with the fewest candidates, each
44⍝ candidate in turn, rounds after each guess, back up on a
45⍝ contradiction.
46x ← ˢs̲olve k
47ˢs̲hown x
48⍝ Every unit holds every digit once:
49'∧ r̲/ r̲avel 1 = ˢp̲erUnit ˢo̲nehot x
50
51⍝ As a game: a new game on puzzle 1 is playing (0); with the solution
52⍝ filled in it is solved (1); a hint names a row, a column and a digit.
53s ← ˢn̲ew 1
54ˢs̲tatus s
55ˢs̲tatus (ˢg̲ivens s) c̲at ˢs̲olve ˢg̲rid s
56ˢh̲int s
57
58⍝ What the game guarantees, checked by a_ssert< (the condition as
59⍝ written; silent when it holds, a line on standard error, which fails
60⍝ the tests, when it does not).
61ok ← "'& r_/ (k = 0) | x = k" a̲ssert< "the solution keeps every given"
62ok ← "'& r_/ r_avel 1 = s:p_erUnit s:o_nehot x" a̲ssert< "every unit holds every digit once"
a̲ssert< expands to
({ @ → ('∧ r̲/ (k = 0) ∨ x = k) ? @◆ ⎕E̲RR "assertion failed: '& r_/ (k = 0) | x = k (the solution keeps every given) [games/sudoku/sudoku.xtl:61]"◆ @ } @)