sudoku_DLX.apl

#!apl --script
⍝
⍝ Author: Jürgen Sauermann
⍝ Date: 24.12.2016
⍝ Copyright: Copyright (C) 2016 by Jürgen Sauermann
⍝ License: GPL see http://www.gnu.org/licenses/gpl-3.0.en.html
⍝ email: bug-apl@gnu.org
⍝ Portability: L3 (GNU APL)
⍝
⍝ Purpose:
⍝ This workspace solves sudokus by using ⎕DLX (aka. Knuth's Dancing Links) and
⍝ the contraints matrix described at:
⍝ http://www.stolaf.edu/people/hansonr/sudoku/exactcovermatrix.htm
⍝
⍝ Description:
⍝
⍝ )LOAD ./sudoku_DLX.apl
⍝
⍝ -or-
⍝
⍝ apl -f ./sudoku_DLX.apl
⍝
⍝ You can override the sudokus below with the one that you would like to solve
⍝
 ⎕PW←400 ⍝ for displaying many constraints columns
SUDO_p5 ← ⊃⎕INP '▄' ⍝ page 4
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ 2 │ │ ║ │ │ 5 ║ │ │ 7 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 4 │ ║ 6 │ │ 8 ║ │ 9 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ 1 │ │ 9 ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ 8 │ 3 ║ │ │ ║ 7 │ 4 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 1 │ 7 │ 9 ║ │ │ ║ 6 │ 5 │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ 9 │ │ 4 ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 5 │ ║ 8 │ │ 3 ║ │ 1 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 4 │ │ ║ │ │ ║ │ │ 8 ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
SUDO_sdk_10 ← ⊃⎕INP '▄' ⍝ page 10
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ │ 9 │ ║ │ │ 8 ║ 1 │ 6 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ 1 ║ 7 │ │ ║ 9 │ 2 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 2 │ │ ║ │ │ ║ │ │ 3 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 3 │ │ 8 ║ 4 │ │ 1 ║ 5 │ │ 6 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 4 │ 9 ║ 8 │ │ ║ 2 │ 3 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 6 │ │ ║ │ │ 7 ║ 8 │ │ 4 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 8 │ │ ║ 6 │ 4 │ ║ │ │ 9 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ 7 │ 2 ║ 6 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 6 │ 7 ║ 1 │ 8 │ ║ │ 5 │ 2 ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
SUDO_sdk_16 ← ⊃⎕INP '▄' ⍝ page 12
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ 2 │ │ 7 ║ │ 4 │ ║ 6 │ │ 8 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 4 │ 3 │ 5 ║ 9 │ 6 │ 8 ║ 7 │ 1 │ 2 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 6 │ 8 ║ 7 │ │ ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 5 │ 4 │ 1 ║ 6 │ 3 │ 9 ║ 2 │ 8 │ 7 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 6 │ 7 │ 2 ║ │ 8 │ ║ │ │ 3 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 3 │ 8 │ 9 ║ 2 │ 7 │ 5 ║ 4 │ 6 │ 1 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ │ │ 6 ║ │ 7 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 8 │ 5 │ 6 ║ 3 │ │ 7 ║ 1 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 7 │ │ ║ │ 1 │ ║ │ │ 6 ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
SUDO_sdk_23 ← ⊃⎕INP '▄' ⍝ page 26
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ 5 │ │ 2 ║ │ │ ║ 4 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ 7 │ 1 │ ║ │ │ 3 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ │ │ 4 ║ 6 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 7 │ ║ 2 │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 1 │ ║ │ │ ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 6 │ │ ║ │ │ 2 ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ 3 │ ║ │ 1 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 4 │ │ ║ │ │ ║ │ │ ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
 SUDO_5←⊃⎕INP '▄'
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ │ │ 9 ║ 5 │ │ 6 ║ 1 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 6 │ 7 ║ │ 1 │ ║ │ 9 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 1 │ │ 8 ║ │ │ ║ 5 │ 4 │ 6 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 7 │ │ ║ 4 │ │ 2 ║ │ │ 5 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 5 │ ║ │ 8 │ ║ │ 7 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 4 │ │ ║ 7 │ │ 9 ║ │ │ 8 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 2 │ 3 │ 4 ║ │ │ ║ 8 │ │ 1 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 9 │ ║ │ 3 │ ║ 7 │ 2 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ 1 ║ 2 │ │ 8 ║ 3 │ │ ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
 SUDO_Xtian←⊃⎕INP '▄'
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ 4 │ │ 5 ║ │ │ 2 ║ │ 7 │ 1 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ 9 ║ │ 4 │ ║ │ │ 6 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ 9 │ │ ║ 8 │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 3 │ ║ │ │ 6 ║ │ 4 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ 3 │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ 1 │ ║ │ 6 │ ║ │ 8 │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ 7 │ ║ │ 2 │ 1 ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ 8 ║ │ │ ║ │ │ ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
 SUDO_EMPTY←⊃⎕INP '▄'
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ │ │ ║ │ │ ║ │ │ ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝▄
∇Z←DECORATE SUDO;ROWS;COLS
 ⍝
 ⍝ A raw sudoko is a ×ばつ9 numeric matrix with values 0 (for empty fields) and
 ⍝ 1-9 for placed digits.
 ⍝
 ⍝ A decorated sudoku is a ×ばつ37 character matrix which also contains line
 ⍝ graphic characters between the ×ばつ9 fields (like the sudokus shown above).
 ⍝
 ⍝ This function converts a raw sudoko into a decorated sudoku, and vice versa.
 ⍝
 DX←37⍴0 0 1 0 ◊ DY←19⍴0 1 ⍝ the relevant columns and rows
 →(9 9≡⍴SUDO)⍴RAW_TO_DECORATED ◊ Z←' 123456789'⍳DY⌿DX/SUDO ◊ →0
RAW_TO_DECORATED: Z←SUDO_EMPTY ◊ (DY⌿DX/Z)←⎕UCS ×ばつSUDO=0
∇
∇Z←SETUP_CONSTRAINTS;ROW;COL;DIG;DC;I
 ⍝
 ⍝ Return the constraints matrix of the empty sudoku. This matrix uses
 ⍝ characters 1-9 and spaces instead of the "normal" integers 0 and 1 for
 ⍝ a constraints matrix.
 ⍝
 I←0 ◊ Z←729 324⍴' '
LOOP: (ROW COL DIG)←9 9 9⊤I ◊ DC←⎕UCS 49+DIG 
 Z[I;(9⊥ROW COL),(81+9⊥ROW DIG),(162+9⊥COL DIG),243+9⊥(3⊥2⍴3 3⊤ROW COL),DIG]←DC
 →(729>I←I+1)⍴LOOP
∇
∇A SHOW SOLUTION;SUDO_OUT;Q
 ⍝
 ⍝ Display the input sudoku A and its (decorated) solution
 ⍝
 SUDO_OUT←A
 ⊣{SUDO_OUT[R;C]←D+1 ⊣ (R C D)←9 9 9⊤⍵;R;C;D} ̈⊃⍬⍴SOLUTION ⍝ apply moves
 (DECORATE A) (DECORATE SUDO_OUT)
 →0
 ⍝ check result
 ⍝
 { Q[⍋Q←,SUDO_OUT[⍵;]] ≡ 1+⍳9 } ̈ ⍳9
 { Q[⍋Q←,SUDO_OUT[;⍵]] ≡ 1+⍳9 } ̈ ⍳9
 { Q[⍋Q←,SUDO_OUT[0 1 2 + ⍵[1];0 1 2 + ⍵[0]]] ≡ 1+⍳9 } ̈ ×ばつ⍳3 3
∇
∇SOLVE SUDO;⎕IO;RAW;CONSTRAINTS;WL;SOLUTIONS
 ⍝
 ⍝ solve (decorated) sudoku SUDO
 ⍝
 ⍝ Step 1: setup the constraints matrix for an empty sudoku
 ⍝
 ⎕IO←0 ⍝ this simplifies ⊥ and ⊤
 CONSTRAINTS←SETUP_CONSTRAINTS ◊ RAW←DECORATE SUDO
 ⍝ Step 2: create a worklist WL of RCDs that shall be placed
 ⍝
 WL←9⊥⍉(WL≥0)⌿(9/⍳9), (81⍴⍳9), 81 1⍴+WL←,RAW-1 ⍝ map digits 1-9 to 0-8
 'Number of digits pre-placed: ' (⍬⍴⍴WL)
 ⍝ Step 3: place every RCD in WL onto the sudoku. Placing an RCD causes some
 ⍝ rows of the constraints matrix to be cleared and some columns to be
 ⍝ removed from the matrix.
 ⍝
 CONSTRAINTS← ( ̄4, WL) ⎕DLX CONSTRAINTS≠' '
 ⍝ Step 4: solve remaining constraints matrix CONSTRAINTS using ⎕DLX
 ⍝
 'Size of the constraints matrix:' (⍴CONSTRAINTS)
 'Number of non-empty rows: ' (729-+/0=+/CONSTRAINTS)
 SOLUTIONS← ̄1 ⎕DLX CONSTRAINTS
 'Number of solutions: ' (⍬⍴⍴SOLUTIONS)
 ⍝ Step 5: display the solution(s) (if any)
 ⍝
 →(0=⍴SOLUTIONS)⍴0
 '' ◊ ' first solution:' ◊ RAW SHOW 1↑SOLUTIONS ◊ →(1=⍴SOLUTIONS)⍴0
 '' ◊ ' last solution:' ◊ RAW SHOW ̄1↑SOLUTIONS
∇
 SOLVE SUDO_p5
 SOLVE SUDO_sdk_10
 SOLVE SUDO_sdk_16
 SOLVE SUDO_sdk_23
 SOLVE SUDO_5
 SOLVE SUDO_Xtian
 )OFF
⍝
⍝ EOF