Sudoku in Dyalog APL
Introduction
by Adrian Smith
This note summarises two approaches to the Sudoku puzzle which were posted on the Dfns newgroup. Ellis Morgan has a recursive puzzle solver, and John Clark has a backtracking solver and a simple puzzle-generator. The contrast in coding styles is interesting in itself, as is the contrast with the J solution from Roger Hui. div>
Interestingly, John was also the lead name on the credits on the marvellous panel discussion film (circa 1974) with Ken Iverson, Adin Falkoff, Larry Breed and others discussing the origins of APL.
John Clark’s Generator and Solver
SOLVE mat is the call. If you don’t have a matrix there are several in the workspace. EASY, MEDIUM, HARD, and VERY_HARD were taken from the Times of London. e.g. type SOLVE MEDIUM.
PUZZLE nn will generate a SuDoku matrix with nn zeros to be replaced.
SOLVE PUZZLE 56 will solve a puzzle with 56 random placed open slots ...
BACKTRACKS REQUIRED 44
┌───────────────────────────┐ ┌───────────────────────────┐
│ ┌─────┐ ┌─────┐ ┌─────┐ │ │ ┌─────┐ ┌─────┐ ┌─────┐ │
│ │⎕ 3 4│ │⎕ ⎕ 5│ │⎕ ⎕ ⎕│ │ │ │1 3 4│ │8 7 5│ │9 2 6│ │
│ │⎕ 7 5│ │⎕ 2 ⎕│ │1 ⎕ ⎕│ │ │ │8 7 5│ │9 2 6│ │1 3 4│ │
│ │⎕ ⎕ ⎕│ │⎕ ⎕ ⎕│ │8 7 5│ │ │ │6 2 9│ │1 3 4│ │8 7 5│ │
│ └─────┘ └─────┘ └─────┘ │ │ └─────┘ └─────┘ └─────┘ │
│ ┌─────┐ ┌─────┐ ┌─────┐ │ │ ┌─────┐ ┌─────┐ ┌─────┐ │
│ │3 4 ⎕│ │⎕ ⎕ ⎕│ │⎕ ⎕ 9│ │ => │ │3 4 8│ │7 5 1│ │2 6 9│ │
│ │⎕ ⎕ ⎕│ │2 6 ⎕│ │3 4 ⎕│ │ │ │7 5 1│ │2 6 9│ │3 4 8│ │
│ │⎕ 6 ⎕│ │3 4 ⎕│ │⎕ ⎕ ⎕│ │ │ │9 6 2│ │3 4 8│ │5 1 7│ │
│ └─────┘ └─────┘ └─────┘ │ │ └─────┘ └─────┘ └─────┘ │
│ ┌─────┐ ┌─────┐ ┌─────┐ │ │ ┌─────┐ ┌─────┐ ┌─────┐ │
│ │⎕ ⎕ 3│ │5 8 ⎕│ │⎕ 9 ⎕│ │ │ │4 1 3│ │5 8 7│ │6 9 2│ │
│ │⎕ ⎕ ⎕│ │⎕ ⎕ ⎕│ │⎕ ⎕ 3│ │ │ │5 9 6│ │4 1 2│ │7 8 3│ │
│ │⎕ ⎕ ⎕│ │⎕ ⎕ ⎕│ │⎕ ⎕ ⎕│ │ │ │2 8 7│ │6 9 3│ │4 5 1│ │
│ └─────┘ └─────┘ └─────┘ │ │ └─────┘ └─────┘ └─────┘ │
└───────────────────────────┘ └───────────────────────────┘
SOURCE SOLUTION CHECKS OUT
0.301 seconds
ORDERUP is the main working function. It examines each open slot in a matrix and returns an n-tuple of (row, col, value(s)) that may be place in that cell. The CHERRYPICK function will place the value referenced by each 3-tuple. The puzzle HARD may be solved by just looping CHERRYPICK.
SUDO is the function that either loops CHERRYPICK or goes to a backtracking system if there are no 3 tuples generated by ORDERUP. Essentially the backtracking is done by a push pop stack where the state is stored as an array of arrays in BT.
I first saw APL in 1967 when you could only have 1 character names for functions and variables. From then to now this is the first application that forced me to write a backtracking system in APL. Here is the code:
∇ Z←PUZZLE ZC;A;SOL
[1] SOL←BUILDONE ⍝ BUILD RAMDOM FILLED IN PUZZLE
[2] A←81⍴1 ⋄ ZC←ZC?81 ⋄ A[ZC]←0 ⍝ VECTOR TO SET ZEROS
[3] ZC←,SOL ⍝ RAVEL PERFECT SOLUTION
[4] Z←9 9⍴A\A/ZC ⍝ PUT IN THE ZEROS.
∇
∇ Z←BUILDONE;A;B;C;D;E
[1] A←3 3⍴B←9?9 ⍝ SET UP A RANDOM BOX
[2] Z←A,(1⊖A),2⊖A ⍝ SET UP A ROW
[3] A←1⌽A ⍝ GO FOR 2ND ROW
[4] Z←Z,[⎕IO]A,(1⊖A),2⊖A ⍝ BUILD 2ND ROW
[5] A←(3 3⍴B)[;3 1 2] ⍝ SET FOR 3RD ROW
[6] Z←Z,[⎕IO]A,(1⊖A),2⊖A ⍝ BUILD 3RD ROW AND EXIT
∇
∇ SOLVE MAT;A;B;J;M;B1;B2;B3;B4;B5;B6;B7;B8;B9;BKC;BT;BX;R;Tin
[1] TIMEIN ⋄ SUDO MAT ⋄ TIMEOUT
∇
∇ Z←SUDO MAT
[1] BKC←0 ⋄ BT←⍬ ⋄ SM←MAT ⍝ INITIALIZE COUNTERS SAVE ARGUMENT
[2] LP0:CHERRYPICK ⍝ GET THE EASY ONES
[3] →(0⍴≠A)⍴LP0 ⍝ LOOP BACK FOR MORE EASY ONES
[4] →(0∊MAT)⍴DMN ⍝ CHECK IF MORE TO DO
[5] →0×⍴Z←PCHECK ⍝ EXIT IF COMPLETE
[6] DMN:→(3≤⍴B←1⊃J)⍴NXT ⍝ GO TO BACKTRACKING
[7] ∘∘∘ ⍝ IF YOU GET HERE IT IS TIME TO CATCH FIRE AND BLOW UP
[8] NXT:MARKIT ⍝ MARK STATUS TO START
[9] LP1:CHERRYPICK ⍝ WORK ON THE EASY ONES
[10] ⍎(~0∊MAT)/'→0,⍴Z←PCHECK' ⍝ FINISH CHECK
[11] →(3=⍴1⊃J)⍴LP1 ⍝ CHECK FOR MORE EASY ONES
[12] →(2≥⍴1⊃J)⍴FAP ⍝ HAVE TO GO FOR BACKTRACKING
[13] →DMN ⍝ FORWARD ON NEXT STATE
[14] FAP:BACKTRACK ⍝ GO BACK TO LAST WORKING CONDITION
[15] →LP1
∇
∇ CHERRYPICK
[1] J←ORDERUP MAT ⍝ GET LIST OF POSSIBLE CHOICES
[2] →(0=⍴A←(3=+/¨⍴¨J)/J)⍴0 ⍝ EXIT IF NO CHERRIES TO PICK
[3] SET¨A ⍝ PICK THE CHERRIES
∇
∇ Z←ORDERUP M;A;B;C
[1] Z←⍬ ⍝ LOOK FOR ALL CHOICES FOR EACH CELL
[2] :For C :In ⍳9 ⍝ CHECK EACH SUB MATRIX
[3] →(0=⍴A←M ZEROBOX C)⍴NXT ⍝ EMPTY CELL PRESENT
[4] Z←Z,(⊂M)PZERO¨A ⍝ CHOICES FOR EMPTY CELLS
[5] NXT: :End
[6] Z←Z[⍋+/¨⍴¨Z] ⍝ SORT TO PUT CHERRIES UP FRONT
∇
∇ Z←M ZEROBOX N;A;B
[1] A←M BOXOUT N ⍝ PULL SUB BOXES
[2] Z←(0=,A)/,R∘.,C
[3] ⍎'B',(⍕N),'←A'
[4] BX←A
∇
∇ Z←MAT BOXOUT N;A;B;⎕IO
[1] ⎕IO←0 ⋄ R C←,3 3⊤N-1 ⍝ INITIALIZE
[2] R←R⊃(1 2 3)(4 5 6)(7 8 9) ⍝ GET THE ROW SET
[3] C←C⊃(1 2 3)(4 5 6)(7 8 9) ⍝ GET THE COLUMN SET
[4] ⎕IO←1 ⍝ GO BACK TO THE REAL WORLD
[5] Z←MAT[R;C] ⍝ RETURN THE BOX VALUES
∇
∇ Z←M PZERO RC;A;B;C
[1] R C←RC ⍝ FIND POSSIBLE VALUES
[2] A←M[R;] ⋄ A←(A≠0)/A ⍝ ROW VALUES
[3] B←M[;C] ⋄ B←(B≠0)/B ⍝ COLUMN VALUES
[4] Z←(A,B),,BX ⋄ Z←Z[⍋Z] ⋄ Z←1↓(Z≠1⌽Z)/Z ⍝ COMBINE BOX
[5] Z←RC,(⍳9)~Z ⍝ (ROW, COL, POSSIBLE VALUES)
∇
∇ SET LOC;R;C;X
[1] R C←2↑LOC ⍝ GET THE ROW AND COLUMN
[2] X←+/¯1↑LOC ⍝ GET THE VALUE TO SET
[3] →((X∊MAT[R;])∨X∊MAT[;C])⍴0 ⍝ EXIT IF VALUE IS NOT USABLE
[4] MAT[R;C]←X ⍝ SET THE VALUE IN THE MATRIX
∇
∇ Z←PCHECK;A
[1] ⍝ FOR A PRETTY PRINT OUT OF SOURCE AND SOLUTION
[2] Z←(FRAME SQZERO ¯1 0↓CKMAT SM)MAB' SOURCE' ⍝ SET THE SOURCE
[3] Z←(Z(1⊖8 4↑1 5⍴' => ')) ⍝ ADD IN A NICE ARROW
[4] B←¯1 35↑A←CKMAT MAT ⍝ CHECK THE SOLUTION
[5] A←(FRAME ¯1 0↓A)MAB B ⍝ FRAME THE SOLUTION
[6] Z←(Z)(A) ⍝ RETURN FANCY PRINT OUT
[7] ' BACKTRACKS REQUIRED ',BKC ⍝ SHOW BACK COUNT ON TOP
∇
∇ Z←CKMAT MAT;A;B;C;D;I
[1] Z←^/45=+/MAT ⋄ Z←Z^^/45=+⌿MAT ⍝ CHECK ROW AND COLUMN SUM
[2] :For I :In A←⍳9 ⍝ CHECK 1..9 IN EACH ROW
[3] Z←Z^^/A∊MAT[I;]
[4] :End
[5] :For I :In A
[6] Z←Z^^/A∊MAT[;I] ⍝ CHECK 1..9 IN EACH COLUMN
[7] :End
[8] I←ORDERUP MAT ⍝ BUILD THE SUB MATRICES
[9] D←⍕3 3⍴FRAME¨⍕¨B1 B2 B3 B4 B5 B6 B7 B8 B9 ⍝ FRAME EACH BOX
[10] Z←D MAB⍕1↑Z↓' BAD ' ' SOLUTION CHECKS OUT' ⍝ ADD COMMENT
∇
∇ Z←FRAME M;⎕IO
[1] ⎕IO←1 ⍝ ENCLOSE MATRIX IN A FRAME
[2] M←,Z←⎕AV[231],(⎕AV[226],[1]M,[1]⎕AV[226]),⎕AV[231]
[3] M[1,(1↓⍴Z),(⍴M)-(¯1+1↓⍴Z),0]←⎕AV[223 222 224 221]
[4] Z←(⍴Z)⍴M
∇
∇ Z←A MAB B
[1] ⍎(2≠⍴⍴A)/'A←(1,⍴A)⍴A'
[2] →((¯1↑⍴A)≠¯1↑⍴B)⍴FX
[3] OU:Z←A,[⎕IO]B
[4] →0
[5] FX:→((¯1↑⍴A)>¯1↑⍴B)⍴WB
[6] A←((1↑⍴A),¯1↑⍴B)↑A
[7] →OU
[8] WB:→(2=⍴⍴B)⍴MT
[9] B←(1↓⍴A)↑B
[10] →OU
[11] MT:B←((1↑⍴B),1↓⍴A)↑B
[12] →OU
∇
∇ MARKIT
[1] SET 3↑B ⍝ CHOOSE FIRST CHOICE
[2] BT←(⊂(MAT)((2↑B),3↓B)),BT ⍝ PUSH CONDITIONS ON BACK TRACK STACK
[3] BKC←BKC+1 ⍝ INCREMENT BACK TRACKING COUNTER
∇
∇ SET LOC;R;C;X
[1] R C←2↑LOC ⍝ GET THE ROW AND COLUMN
[2] X←+/¯1↑LOC ⍝ GET THE VALUE TO SET
[3] →((X∊MAT[R;])∨X∊MAT[;C])⍴0 ⍝ EXIT IF VALUE IS NOT USABLE
[4] MAT[R;C]←X ⍝ SET THE VALUE IN THE MATRIX
∇
∇ BACKTRACK;Y
[1] →(0≠⍴BT)⍴BKU
[2] ∘∘∘∘∘ ⍝ YOU ARE DEAD IF YOU GET HERE.
[3] BKU:MAT←1⊃1⊃BT ⍝ RESET TO PAST CONDITION
[4] SET 3↑Y←2⊃1⊃BT ⍝ SET THE NEXT VALUE
[5] (2⊃1⊃BT)←Y←(2↑Y),3↓Y ⍝ REBUILD POSSIBLE CHOICES
[6] →(3≤⍴Y)⍴0 ⍝ QUIT IF MORE CHOICES LEFT FOR THIS CELL
[7] BT←1↓BT ⍝ POP THE BACKTRACKING STACK
[8] BKC←BKC+1 ⍝ INCREMENT BACK TRACKING COUNTER
∇
Ellis Morgan’s Solver
| grid ← start 5 | Set up the problem in the London Times of 9 June 2005 |
| 2 show grid | Check that you have got it right |
| pre←result pre_solve grid | See how hard it could be |
| ans ← solve grid | Solve the problem |
| 2 show ans | See the answer |
| case9←result pre_solve start 9 | Easy probelms are solved by pre_solve |
This workspace assumes you can read APL. Look at the comments in “solve”, “start”, “show”, and the other functions to see what is going on.
The Code
grid←{left}start style;index;data
⍝ set grid for various starting points per style
⍝ style is a valid style number supported by this function
⍝ left is needed for style =0, when it is (index data) ...
⍝ ... and the values in a ravelled grid are set as grid[index]←data
grid←,9 9⍴⊂⍳9
:Select style
:Case 0 ⍝ user specified
grid[1⊃left]←2⊃left
:Case 1 ⍝ medium in paper
index←1 2 5 8 9,(9+2 8),(18+1 4 6 9),(27+4 6),(36+2 8)
index,←(45+4 6),(54+1 4 6 9),(63+2 8),72+1 2 5 8 9
data←5 7 1 4 8 2 6 9 6 2 7 4 9 4 2 1 5 7 3 4 1 3 5 6 1 9 3 4
grid[index]←data
........... lots more examples clipped ..........
:EndSelect
grid←,¨grid
grid←9 9⍴grid
∇ text←{style}show grid;row;column;mask
[1] ⍝ display the grid
[2] ⍝ style = 0 means as 27 by 27 alpha matrix
[3] ⍝ style = 1 as a 9 by 9 matrix, showing "known" cells only
[4] ⍝ style = 2 as a 9 by 9 of known cells, with the squares bordered
[5] ⍝ style = 3 as a 27 by 27, with cells and squares bordered
[6]
[7] :If 0=⎕NC'style'
[8] style←0
[9] :EndIf
[10]
[11]
[12] :Select style
[13] :CaseList 1 2 ⍝ 9 by 9 , blank if not known
[14] mask←1=⊃∘⍴¨,grid
[15] text←9 9⍴mask\(⊂'')⍴¨1 0⍕mask/⊃¨,grid
[16]
[17] :Else ⍝ default or style = 0
[18] text←27 27⍴' '
[19] :For row :In ⍳9
[20] :For column :In ⍳9
[21] text[(3×row-1)+⍳3;(3×column-1)+⍳3]←display⊃grid[row;column]
[22] :EndFor
[23] :EndFor
[24] :EndSelect
[25]
[26] text←style showlines text
∇
∇ text←{style}show grid;row;column;mask
[1] ⍝ display the grid
[2] ⍝ style = 0 means as 27 by 27 alpha matrix
[3] ⍝ style = 1 as a 9 by 9 matrix, showing "known" cells only
[4] ⍝ style = 2 as a 9 by 9 of known cells, with the squares bordered
[5] ⍝ style = 3 as a 27 by 27, with cells and squares bordered
[6]
[7] :If 0=⎕NC'style'
[8] style←0
[9] :EndIf
[10]
[11]
[12] :Select style
[13] :CaseList 1 2 ⍝ 9 by 9 , blank if not known
[14] mask←1=⊃∘⍴¨,grid
[15] text←9 9⍴mask\(⊂'')⍴¨1 0⍕mask/⊃¨,grid
[16]
[17] :Else ⍝ default or style = 0
[18] text←27 27⍴' '
[19] :For row :In ⍳9
[20] :For column :In ⍳9
[21] text[(3×row-1)+⍳3;(3×column-1)+⍳3]←display⊃grid[row;column]
[22] :EndFor
[23] :EndFor
[24] :EndSelect
[25]
[26] text←style showlines text
∇
∇ text←display cell;mask
[1] ⍝ display the possible cell values as 3 by 3 alphabetic block
[2] ⍝ eg "display ⊃grid[2;3]" to display the values that you ...
[3] ⍝ ... can validly put in the third column of the second ...
[4] ⍝ ... row of the current grid.
[5]
[6] cell←,cell
[7] :If 1=⊃⍴cell ⍝ cell has a single known value
[8] ⍝ mask←0 1 0 1 1 1 0 1 0 ⍝ as a cross
[9] mask←9↑¯5↑1 ⍝ in centre of 3 by 3 grid
[10] text←mask\⊃1 0⍕⊃cell
[11] :Else ⍝ cell has many (or no) possible values
[12] mask←(⍳9)∊cell
[13] text←mask\mask/1 0⍕⍳9
[14] :EndIf
[15] text←3 3⍴text
∇
∇ text←style showlines text;lines;mask
[1] ⍝ horizontal and vertical lines between cells and squares
[2] ⍝ see comments in "show"
[3]
[4] →(style∊0 1)↑0
[5]
[6] lines←'-= ⎕' ⍝ 2 horizontal (cell,square) and 2 vertical characters
[7]
[8] :If style=2 ⍝ just the squares in a 9 by 9 grid
[9] mask←13⍴0 1 1 1
[10] text←mask⍀mask\text
[11] mask←(mask=0)/⍳⍴mask
[12] text[;mask]←3⊃lines
[13] text[mask;]←1⊃lines
[14] :Else ⍝ cells and squares in a 27 by 27 display
[15] mask←37⍴0 1 1 1
[16] text←mask⍀mask\text
[17] mask←(mask=0)/⍳⍴mask
[18] text[;mask]←3⊃lines
[19] text[mask;]←1⊃lines
[20] mask←((⍴mask)⍴3↑1)/mask
[21] text[;mask]←4⊃lines
[22] text[mask;]←2⊃lines
[23] :EndIf
∇
∇ grid←pre_solve grid;found;old;row;column
[1] ⍝ "pre-solve" grid, by filling each cell with possible values
[2] ⍝ only change those cells that have more than one possible value
[3]
[4] ⍝ repeat until the number of cells whose value is known ...
[5] ⍝ fails to increase when you apply "valid"
[6]
[7] ⍝ stop if a cell has no valid values available ...
[8] ⍝ leaving that cell empty in the returned grid.
[9]
[10] ⍝ for easy problems "pre_solve" can be the solution ...
[11] ⍝ ... try "case9←result pre_solve start 9" ...
[12] ⍝ ... otherwise you will need "solve".
[13]
[14] found←+/1=⊃∘⍴¨,grid
[15] old←0
[16] :While found>old
[17] old←found
[18] :For row :In ⍳9
[19] :For column :In ⍳9
[20] grid[row;column]←grid valid row column
[21] :If 0∊⊃∘⍴¨grid
[22] →0
[23] :EndIf
[24] :EndFor
[25] :EndFor
[26] found←+/1=⊃∘⍴¨,grid
[27] :EndWhile
∇
∇ grid←result grid;shapes;choice
[1] ⍝ examine grid to see what we have got
[2] ⍝ returns the original grid ...
[3] ⍝... after displaying information about the grid in the session
[4]
[5] shapes←,⊃∘⍴¨grid
[6]
[7] :If 81=+/shapes
[8] choice←'no'
[9] :Else
[10] :If 6<+/10⍟shapes
[11] choice←'10*',(2⍕+/10⍟shapes)~' '
[12] :Else
[13] choice←⍕×/shapes
[14] :EndIf
[15] :EndIf
[16]
[17] ⍝ cell wise
[18] (⍕+/1=shapes),' cells known, ',choice,' cell choices.'
∇
∇ answer←solve grid;log
[1] ⍝ solve a grid where known cells are a single number (vec of len one),
[2] ⍝ and unknown cells are (⊂⍳9)
[3]
[4] ⍝ it is your business to make sure the grid is validly constructed ...
[5] ⍝ ... each cell is a non-empty vector of integers ...
[6] ⍝ ... only the integers 1 to 9 are allowed ...
[7] ⍝ ... integers can not be repeated within a call.
[8]
[9] ⍝ it is your business to make sure that the grid represents a valid ...
[10] ⍝ ... Su Doku problem. The program will stop in "recurse" ...
[11] ⍝ ... if it thinks there is no valid solution.
[12]
[13] ⍝ No check is made to see that the solution is unique ...
[14] ⍝ ... "solve" just returns the first one it finds.
[15]
[16] ⍝ While "solve" runs stuff will display in your session ...
[17] ⍝ ... see "recurse" for an explanation.
[18]
[19] answer log←(,⊂0 0 0)recurse,⊂pre_solve grid
∇
∇ result←left recurse grids;grid;shapes;min;row;col;log;answer;which;from
[1] ⍝ Investigate all possible cell values until a solution emerges.
[2]
[3] ⍝ "grids" is the grids investigated so far, most recent recursion is last.
[4]
[5] ⍝ "left" is the cell values investigated, most recent recursion is last.
[6] ⍝ ... each entry is a vector of three numbers: row; column; "which" ...
[7] ⍝ ... where "which" is the index number of the chosen option ...
[8] ⍝ ... from the options available foer the cell.
[9]
[10] ⍝ "result" is the grid solution and the cell values that led to it.
[11]
[12] (⍴left),⊃¯1↑left ⍝ show the depth of recursion, latest cell setting.
[13] answer←⊃¯1↑grids ⍝ current grid
[14]
[15] next_:
[16] shapes←,⊃∘⍴¨answer
[17] result←answer left
[18] →(^/1=shapes)↑0 ⍝ if the grid is all known cells, it is a solution
[19]
[20] :If 0∊shapes ⍝ have we come down a dead end with no solution?
[21] further_:
[22] :If 1<⊃⍴left ⍝⍝⍝ is this the first recursion?
[23] row col which←(⍴left)⊃left
[24] left←¯1↓left
[25] grids←¯1↓grids
[26] answer←(⍴grids)⊃grids ⍝ step back to the previous grid
[27] from←⊃answer[row;col]
[28] :If which<⊃⍴from ⍝ still some mileage in this path ...
[29] which+←1 ⍝ try the next available cell value
[30] ⍝ which,from ⍝ display for tough testing
[31] :Else
[32] →further_ ⍝ go back to the previous grid
[33] :EndIf
[34] :Else
[35] ∘∘∘ ⍝⍝⍝ stop here if no solution on the first recursion level
[36] :EndIf
[37]
[38] :Else ⍝ still on track for a possible solution
[39] min←shapes⍳⌊/shapes~1 ⍝ first cell with the fewest options
[40] row col←1+9 9⊤min-1
[41] which←1 ⍝ say we are choosing the first option ...
[42] from←⊃answer[row;col] ⍝ ... and get the options
[43] :EndIf
[44]
[45] answer[row;col]←⊂,which⊃from ⍝ set the cell to its chosen value ...
[46] ⍝ ... and call "recurse" again to set another cell
[47] answer log←(left,⊂row col which)recurse grids,⊂pre_solve answer
[48] →next_
∇