Z<-SUDOKU.D4F
|class description
N27<-MK_N27             |rows columns boxes for each cell
CS9<-MK_S9              |rows, columns. boxes
D9<-9 9 r "."           |edit template
B9<-*\1,8r2
BOX9<-MK_BOXES 9 9
Z3SQ.MULT<- 3 3b m Z Z3SQ_MULT Z<-mi3 3
Z3SQ.ADD <- 3 3b m Z Z3SQ_ADD  Z
Z<-ADD_ALIAS SUDOKU.D4S

"SUDOKU.D4S"
edsu|WW.ED"sudoku.d4f ",ARGS
ldsu|#copy"sudoku.d4f" & SUDOKU.D4F
sudoku_info|3 #sed"X:d;$ sudoku.inf" & Z<-WW.FSCR 3
insx|0 r #sed"X$ARGS;+1";0 r #do "Z<-z", ARGS;0 r #sed"$Z"
putval|0 r #do "D4.CUT<-z ", $T[#sed"."]; 0r #sed"$D4.CUT"

"sudoku.inf" << EOF
   sudoku help.
   You must have nine rows, nine columns and nine 3x3 boxes
which must eventuallyn nine different symbols (1-9). Some of the
cells are left blank, and these must be filled in by the
puzzle solver.  A sudoku is represented by a 9x9 matrix with dots
for unknown values.

    From Ritter

EOF

Z<-GET_SUDOKU STR;F;J
|Get named sudoku from designated file
F<-"sudoku.dat"
IF "#"e STR<-"" #ifndef "STR";J<-STRi"#";F<-JtSTR;STR<-(J+1)dSTR
Z<-3 #sed"X:r ",F,";s/#.*/& /g"
Z<-$T[#nfind "#"]
IF 0=rSTR;J<-(2 20, 20 30 f rZ) PMENU Z; STR<-#deb 1 d Z[J]
J<-#nfind "#",STR," "
IF 1 #ne rJ; Z<-""; ->0
Z<-BM_TRIM $T[J+1+i9]

Z<-BM_TRIM X;B;U
|Trim blank rows and columns of a matrix
B<-0 & IF 1 = #nc"X"; B<-" "
U<-f/B=Z<-X & U<-(f\U)c mf\mU & Z<-y(~U)/Z
U<-f/B=Z    & U<-(f\U)c mf\mU & Z<-y(~U)/Z

Z<-MK_BOXES N
|Set up dots to join and make boxes.
N<-2rN & Z<-((1+2*N[0])r 0 2) #outer + (1+2*N[1])r 0 1
Z<-"._| "[((1dr:Z)r1 2)/Z]

Z<-IN_BOX M;B;I;J
|Put matrix in ascii box
Z<-,B<-MK_BOXES rM
I<-(M #ne ".")/irM<-,M
J<-2+("| " #find Z)/irZ
Z[J[I]]<-M[I] & Z<- (rB)rZ

Z<-SU_NODE STR;IDX;M
|Bit encoding of neighbours for each cell.
M<-,STR
IDX<-,(27/y10*i81)+"123456789" i M[N27]
Z<-,81 10r0 & Z[IDX]++
Z<-(9r2) b m 0 = 81 9 t 81 10rZ
Z[(M #ne ".")/irM]<-0

Z<-SU_TEST STR;IDX;M
|Test a running position
|0 for possible, 1 for complete, 2 for impossible
M<-,STR
IDX<-,(9/y10*i27)+"123456789" i M[CS9]
Z<-,27 10r0 & Z[IDX]++
Z<-27 9t27 10rZ
IF 1<c/,Z; Z<-2; ->0
Z<-1=f/,Z

Z<-SU_TAB STR;M;U
|Build move table
U<-, m(9r2) n SU_NODE M<-,STR
Z<-(i 81 9)[U/i9*81]

Z<-SUGO STR;I;J;M
|Fill in one step deductions
M<-,STR
WHILE 1
BREAKIF 0 < SU_TEST M
BREAKIF 9=f/I<-B9 i Z<-SU_NODE M
J<-(M=".")/irM
M[J]<-"123456789."[I[J]]
WEND
Z<-9 9rM

Z<-SU_TAHLIA STR;I;K;M;R;TAB;TX;X
|Solve a sudoku puzzle
Z<-SUGO M<-,STR
IF 1=R<-SU_TEST Z; ->0
TAB<-SU_TAB Z
TX<-iI<-0
WHILE I<1tr:TAB
K<-TAB[I++]
M<-, Z; M[K[0]]<-"123456789"[K[1]]; X<-SUGO M
IF 1=R<-SU_TEST X; Z<-X; ->0
IF R=2; TX<-TX, K
WEND
"exclude", zTX

"SU_OPTS"
-depth   F_LEVEL<-#fi SHIFT
-cnt     SU_MAX <-#fi SHIFT
-shuffle QS<-1
-v       QV<-1

Z<-SU_BRUTE STR;F_LEVEL;QS;QV;SU_CNT;SU_LEVEL;SU_MAX
|Brute force attempt
F_LEVEL<-3;QS<-QV<-0; SU_MAX<-9000000
IF 1=rrSTR; STR<-SU_OPTS GETOPTS STR
SU_CNT<-SU_LEVEL<-0
Z<-SU_SOLVE STR
IF QV;3 #sed":d";#print 8 z SU_CNT;#print (IN_BOX 9 9 r STR)," ",IN_BOX Z
IF SU_CNT>=SU_MAX; Z<-""

Z<-SU_SOLVE STR;I;K;M;N;R;TAB;TX;X
|Solve a sudoku puzzle
|Import QS, SU_CNT, SU_LEVEL
Z<-SUGO M<-,STR
SU_CNT++
IF SU_CNT>=SU_MAX; ->0
SU_LEVEL++
IF SU_LEVEL>F_LEVEL; SU_LEVEL--; ->0
R #wput 1 40, r:R<-8 z SU_LEVEL, SU_CNT
R #wput 2 40, r:R<-"nx=",4z +/M="."
R #wput 5 40, rR<-9 9rZ
IF 1=R<-SU_TEST Z; ->0
N<-1tr:TAB<-SU_TAB Z
IF QS; TAB<-TAB[N?N]
R #wput 3 40, r:R<-"tx=",4z 1tr:TAB
TX<-iI<-0
WHILE I<N
K<-TAB[I++]
M<-, Z; M[K[0]]<-"123456789"[K[1]]; X<-SU_SOLVE M
IF 1=R<-SU_TEST X; SU_LEVEL--; Z<-X; ->0
IF R=2; TX<-TX,K
WEND
SU_LEVEL--

Z<-MK_N27;J;S;XI
|Make 81 x 27 table of rows, columns, boxes containing cell.
Z<-9/:S<-9 9ri81
Z<-Z,81 9ryS
XI<-81 9r0
J<-#sort ,3/3/:3 3ri9
XI[J]<-9/:9 9rJ
Z<-Z,XI

Z<-MK_S9
|9 rows. 9 columns, 9 squares
Z<-Z,:yZ<-9 9ri81
Z<-Z,: m 9 9r #sort ,3/3/:3 3ri9

 Z <- MK_D8 N;P;Q
|Convert rotations & reflections of NxN array into 8 permutations on NxN
 N <-(N,N)r i N * N
 Q <- #phi P <- #transpose N & Q <-,Q & P <-,P
 Z <- N <- i r P
 Z <- Z,N <- Q[N] & Z <- Z,N <- Q[N] & Z <- Z,N <- Q[N]
 Z <- Z,P
 Z <- Z,P <- Q[P] & Z <- Z,P <- Q[P] & Z <- Z,P <- Q[P]
 Z <-(8,r P)r Z

Z<-TEST_LR A;B;LUT;N;M;P
|test matrix A as a latin square or rectangle
Z<-1; M<-1tr:A; N<-1dr:A
IF M=1; ->0
IF M>N; Z<-0; ->0
B<-Nr2;P<-*\1,1dB
LUT<-A[0]
Z<-P[LUT i A]
Z<-f/M= +/y B n +/Z

Z<-MK_LR STR;LUT;NR;NC;T
NR<-9; LUT<-"123456789"
STR<-"-lut LUT<-SHIFT" GETOPTS STR<-"" #ifndef "STR"
IF 0<rSTR;NR<-#fi STR
NC<-rZ<-LUT
WHILE NR>1tr:Z;Z<-Z,:LR_ADD_ROW Z;WEND

Z<-LR_ADD_ROW A;LUT;J;NR;NC;S;XI
|Add a new row to a latin rectangle.
NR<-1tr:A; NC<-rLUT<-A[0:]
A<-LUTiA
Z<-i0; J<-0; S<-NCr1
WHILE J<NC
XI<-NCr0; XI[,A[:J]]<-1
IDX<-((XI=0)fS)/iNC
IF 0=rIDX; J<-0; Z<-i0; S<-NCr1; REPEATIF 1
IF 1<rIDX; IDX<-IDX[?rIDX]
Z<-Z,IDX
S[IDX]<-0
J++
WEND
Z<-LUT[Z]

Z<-E_PANEL;S
|Display rows columns and sub boxes
Z<-  (11 4r" "), FRAME (17r1 0)\ 9 9rS<-"123456789"
Z<-Z,(11 5r" "), FRAME (17r1 0)\y9 9rS
Z<-Z,(11 5r" "), FRAME (17r1 0)\3/3/: 3 3rS

Z<-A_PANEL STR;I;N;T
|Print 8 orthogonal 9x9 latin squares and test for sudoku
|use formula A[x,y] = x + i*y for i non zero in GF(3^2)
I<-1;N<-i9;Z<-5 #sed":d"
WHILE I<8       | non zero field elements
T<-"123456789"[9 9 r Z3SQ.ADD[N #outer + 9*Z3SQ.MULT [I+9*N]]]
Z<-9 9 r SU_CF T
#print ("    I=##  " zI),(1=SU_TEST T)/" sudoku"
#print (19 4r" "),(IN_BOX T),(19 4r" "),IN_BOX Z
I++;WEND
Z<-WW.FSCR 5

Z<-A Z3SQ_MULT B;X;Y
|Multiply pairs a+bx with x^2=3 (-1) mod 3
X<-y,(A[:0] #outer * B[:0])-A[:1] #outer * B[:1]
Y<-y,(A[:0] #outer * B[:1])+A[:1] #outer * B[:0]
Z<-(X,Y) #mod 3

Z<-A Z3SQ_ADD B;X;Y
|Add pairs a+bx with x^2=3 (-1) mod 3
X<-y, A[:0] #outer + B[:0]
Y<-y, A[:1] #outer + B[:1]
Z<-(X,Y) #mod 3

Z<-A K_ADD B
|Addition in K=GF(3^2)
Z<-Z3SQ.ADD[A+9*B]

Z<-A K_MULT B
|Multiplication in F=GF(3^2)
Z<-Z3SQ.MULT[A+9*B]

Z<-K_LINES AB;A;B;J
|Lines ax+by=c in K
A<-AB[0] K_MULT J<-i9;B<-AB[1] K_MULT J
Z<-9 9 r Z3SQ.ADD[A #outer + B]

Z<-K_QUAD AB;A;B;J;XSQ
|Values ax^2+by^2 in K
XSQ<-J K_MULT J<-i9
A<-AB[0] K_MULT XSQ;B<-AB[1] K_MULT XSQ
Z<-9 9 r Z3SQ.ADD[A #outer + B]

Z<-K_CUBE A;J;X;XSQ
|values y^2-(x^3+ax)
XSQ<-J K_MULT J<-i9
X<-2 K_MULT XSQ K_MULT A K_ADD J  | 2x = -x here
Z<-9 9 r Z3SQ.ADD[XSQ #outer + 9 * X]

Z<-MK_SUMAT STR;J;NX
|Make a sudaku stile matrix
NX<-0
IF 0<rSTR<-"" #ifndef "STR"; NX<-#fi STR
J<-0 3 6 1 4 7 2 5 8
Z<-"123456789"[(J #outer + i9) #mod 9]
IF NX=0; ->0
Z<-,Z; Z[NX?81]<-".";Z<-9 9 r Z

Z<-SU_CF STR;I;DH9;I;LUT;T;X
|Canonical form of a sudoku matrix.
|Use alphanumeric sort of 8 rotations and reflections
LUT<-"123456789"
Z<-""; I<-0; T<-(,STR)[MK_D8 9]
WHILE I<8; X<-T[I++];Z<-Z,:LUT[X[i9]iX];WEND
Z<-1 81 t Z[#sort Z]

Z<-SU2TAB STR;C;I;J;M
|Make an html table from a sudoku
M<-,STR
Z<-"\<TABLE BORDER=1>"
I<-0
WHILE I<81;C<-M[I]
IF 0 = I #mod 9; Z<-Z,"\<TR>"
IF C="."; C<-"&nbsp;"
Z<-Z, "<TD>&nbsp;", C, "&nbsp;</TD>"
IF 8 = I #mod 9; Z<-Z,"</TR>"
I++; WEND
Z<-Z,"\</TABLE>"
Z<-#sstomat Z

Z<-MK_SUB2X2;IDX;M;T;XI
|Get 2x2 squares (x0,y0), (x1,y0), (x0,y1), (x1,y1)
|with  0<=x0<x1<=8; 0<=y0<y1<=8
T<-,3/3/:3 3ri9
M<-1tr:Z<-(,Z[:0]<Z[:1])/:Z<-i9 9       | 0<=x0<x1<=8
Z<-((M*M), 4)r ,Z[,iM,M]                | x0 x1 y0 y1
Z<-Z[:0 2 1 2 0 3 1 3]
Z<-((M*M),4)r9 9 b ((4*M*M),2)rZ
XI<-,((M*M),9)  r0
IDX<-(4/y9*iM*M)+T[Z]
XI[IDX]++
XI<-((M*M),9)rXI
Z<-(2 =+/2=yXI)/:Z

Z<-SU_PERM;C;J;X
|Get a permutation with 9-box constraints
C<-,3/3/:3 3r1,*\8r2
WHILE 511 #ne +/C[J<-9 9b(yi9),yZ<-9?9]
WEND

Z<-SU_LR N;X
|Latin rectangle with sudaku constraints
N<-3 #ifndef"N"
Z<-SU_PERM
WHILE N>1tr:Z
X<-SU_PERM
REPEATIF 0<+/,Z=(rZ)rX
Z<-Z,:X
WEND

Z<-SU_LR2MAT X;I;LUT
|Build matrix from sudoku latin rectangle
Z<-81r"."; LUT<-"123456789";I<-0
WHILE I<1tr:X
Z[9 9b(yi9),yX[I:]]<-LUT[I]
I++; WEND
Z<-9 9rZ

Z<-SU_BUILD;HX;IX
|Build sudoku square
Z<-""
WHILE 0=rZ
Z<-SU_BRUTE "-cnt 600 ",,HX<-SU_LR2MAT IX<-SU_LR 6
WEND

Z<-PRINT_SUDOKU STR;CNT;E;I;X;IC;V
|List sudoku square
IC<-MK_SUB2X2
I<-0;CNT<-#fi STR<-"7" #ifndef "STR"
0 r 5 #sed":d"
WHILE CNT>I++
Z<-9 9 r SU_CF X<-SU_BUILD
5 #print V<-"I = ####" zI
V
E<-(,X)[IC]
#print V<-"IC= ####" z +/,(E[:0]=E[:3])f E[:1]=E[:2]
V
#print V<-X,"|",Z
V
WEND

Z<-IC_LIST M;E;I;SUBSQ
|List intercalates of matrix M
SUBSQ<-MK_SUB2X2
E<-(,M)[SUBSQ]
J<-(E[:0]=E[:3])f E[:1]=E[:2]
Z<-J/:SUBSQ