100 REMark Sudoku puzzle solver v1.1 110 REMark (c) 2005 I. L. Pine 120 CLS 130 CLS #2 140 LET ln2=LN(2) 150 DIM grid%(8,8),cx(80),cy(80) 160 FOR i=0 TO 8 170 FOR j=0 TO 8 180 LET grid%(i,j)=511 190 END FOR j 200 END FOR i 210 INPUT #0,"Enter filename of Sudoku puzzle:"\f$ 220 REMark Load the data and check syntax 230 OPEN_IN #3,f$ 240 LET e=0 250 FOR i=0 TO 8 260 IF EOF(#3) THEN 270 LET e=1 280 EXIT i 290 END IF 300 INPUT #3,r$ 310 IF LEN(r$)=9 THEN 320 FOR j=1 TO 9 330 IF r$(j)>="0" AND r$(j)<="9" THEN 340 LET t=r$(j) 350 IF t>0 THEN LET grid%(i,j-1)=2^(t-1) 360 ELSE 370 LET e=1 380 EXIT i 390 END IF 400 END FOR j 410 ELSE 420 LET e=1 430 EXIT i 440 END IF 450 END FOR i 460 CLOSE #3 470 REMark Validate the data; check start position not 'illegal'. 480 IF e=0 THEN 490 FOR i=0 TO 8 500 FOR j=0 TO 8 510 IF NOT(OKpos(i,j)) THEN 520 LET e=1 530 EXIT i 540 END IF 550 END FOR j 560 END FOR i 570 END IF 580 IF e=1 THEN 590 PRINT #0,"Unacceptable data in puzzle file"\f$ 600 STOP 610 END IF 620 DrawGrid 630 LET changed=1 640 REPeat solve_1 650 IF changed=0 THEN EXIT solve_1 660 checks 670 DrawGrid 680 END REPeat solve_1 690 IF NOT(Finished) THEN 700 PRINT #2,"Determining remaining cells recursively..." 710 MakeList 720 IF Guess(0) THEN DrawGrid 730 END IF 740 STOP 750 : 760 DEFine PROCedure DrawGrid 770 CLS 780 FOR i=0 TO 8 790 FOR j=0 TO 8 800 LET t=LN(grid%(i,j))/ln2 810 IF t==INT(t) THEN 820 PRINT t+1;" "; 830 ELSE 840 PRINT ". "; 850 END IF 860 END FOR j 870 PRINT \ 880 END FOR i 890 END DEFine DrawGrid 900 : 910 DEFine PROCedure checks 920 LET changed=0 930 PRINT #2,"Checking horizontals..." 940 FOR i=0 TO 8 950 FOR j=0 TO 8 960 IF Confirmed(grid%(i,j)) THEN 970 FOR k=0 TO 8 980 IF k<>j THEN 990 IF grid%(i,k)&&grid%(i,j) THEN 1000 LET grid%(i,k)=grid%(i,k)&&~~grid%(i,j) 1010 LET changed=1 1020 END IF 1030 END IF 1040 END FOR k 1050 END IF 1060 END FOR j 1070 END FOR i 1080 PRINT #2,"Checking verticals..." 1090 FOR j=0 TO 8 1100 FOR i=0 TO 8 1110 IF Confirmed(grid%(i,j)) THEN 1120 FOR k=0 TO 8 1130 IF k<>i THEN 1140 IF grid%(k,j)&&grid%(i,j) THEN 1150 LET grid%(k,j)=grid%(k,j)&&~~grid%(i,j) 1160 LET changed=1 1170 END IF 1180 END IF 1190 END FOR k 1200 END IF 1210 END FOR i 1220 END FOR j 1230 PRINT #2,"Checking 3x3 squares..." 1240 FOR x=0,3,6 1250 FOR y=0,3,6 1260 FOR i=0 TO 2 1270 FOR j=0 TO 2 1280 IF Confirmed(grid%(x+i,y+j)) THEN 1290 FOR k=0 TO 2 1300 FOR l=0 TO 2 1310 IF k<>i OR l<>j THEN 1320 IF grid%(x+k,y+l)&&grid%(x+i,y+j) THEN 1330 LET grid%(x+k,y+l)=grid%(x+k,y+l)&&~~grid%(x+i,y+j) 1340 LET changed=1 1350 END IF 1360 END IF 1370 END FOR l 1380 END FOR k 1390 END IF 1400 END FOR j 1410 END FOR i 1420 END FOR y 1430 END FOR x 1440 FOR k=1,2,4,8,16,32,64,128,256 1450 FOR i=0 TO 8 1460 LET c=0 1470 FOR j=0 TO 8 1480 IF grid%(i,j)&&k THEN 1490 LET c=c+1 1500 LET t=j 1510 END IF 1520 END FOR j 1530 IF c=1 AND NOT(Confirmed(grid%(i,t))) THEN 1540 LET grid%(i,t)=k 1550 LET changed=1 1560 END IF 1570 END FOR i 1580 FOR j=0 TO 8 1590 LET c=0 1600 FOR i=0 TO 8 1610 IF grid%(i,j)&&k THEN 1620 LET c=c+1 1630 LET t=i 1640 END IF 1650 END FOR i 1660 IF c=1 AND NOT(Confirmed(grid%(t,j))) THEN 1670 LET grid%(t,j)=k 1680 LET changed=1 1690 END IF 1700 END FOR j 1710 FOR x=0,3,6 1720 FOR y=0,3,6 1730 LET c=0 1740 FOR i=0 TO 2 1750 FOR j=0 TO 2 1760 IF grid%(x+i,y+j)&&k THEN 1770 LET c=c+1 1780 LET s=i 1790 LET t=j 1800 END IF 1810 END FOR j 1820 END FOR i 1830 IF c=1 AND NOT(Confirmed(grid%(x+s,y+t))) THEN 1840 LET grid%(x+s,y+t)=k 1850 LET changed=1 1860 END IF 1870 END FOR y 1880 END FOR x 1890 END FOR k 1900 END DEFine checks 1910 : 1920 DEFine FuNction Confirmed(a%) 1930 IF a%=256 OR a%=128 OR a%=64 OR a%=32 OR a%=16 OR a%=8 OR a%=4 OR a%=2 OR a%=1 THEN RETurn 1 1940 RETurn 0 1950 END DEFine Confirmed 1960 : 1970 DEFine FuNction Finished 1980 LOCal i,j 1990 REMark Checks whether the grid is filled, i.e. puzzle solved. 2000 FOR i=0 TO 8 2010 FOR j=0 TO 8 2020 IF NOT(Confirmed(grid%(i,j))) THEN RETurn 0 2030 END FOR j 2040 END FOR i 2050 RETurn 1 2060 END DEFine Finished 2070 : 2080 DEFine PROCedure MakeList 2090 LOCal i,j 2100 REMark Make a list of the coordinates of all the remaining unconfirmed cells. 2110 LET cn=0 2120 FOR i=0 TO 8 2130 FOR j=0 TO 8 2140 IF NOT(Confirmed(grid%(i,j))) THEN 2150 LET cx(cn)=i 2160 LET cy(cn)=j 2170 LET cn=cn+1 2180 END IF 2190 END FOR j 2200 END FOR i 2210 END DEFine MakeList 2220 : 2230 DEFine FuNction Guess(m) 2240 LOCal cell%,try 2250 REMark Recursive function tries each permutation of possible solution for each unconfirmed cell until the grid is successfully filled. 2260 IF m=cn THEN RETurn 1 2270 LET cell%=grid%(cx(m),cy(m)) 2280 FOR try=1,2,4,8,16,32,64,128,256 2290 LET grid%(cx(m),cy(m))=try 2300 IF OKpos(cx(m),cy(m)) THEN 2310 AT cx(m),cy(m)*2 2320 PRINT LN(grid%(cx(m),cy(m)))/ln2+1 2330 IF Guess(m+1)=1 THEN RETurn 1 2340 END IF 2350 END FOR try 2360 LET grid%(cx(m),cy(m))=cell% 2370 AT cx(m),cy(m)*2 2380 PRINT "." 2390 RETurn 0 2400 END DEFine Guess 2410 : 2420 DEFine FuNction OKpos(x,y) 2430 LOCal p,q,po,qo 2440 REMark Checks that a digit being tried in a cell is allowable. 2450 REMark Try other cells in the column. 2460 FOR p=0 TO 8 2470 IF p<>x THEN 2480 IF Confirmed(grid%(p,y)) AND grid%(x,y)=grid%(p,y) THEN RETurn 0 2490 END IF 2500 END FOR p 2510 REMark Try other cells in the row. 2520 FOR q=0 TO 8 2530 IF q<>y THEN 2540 IF Confirmed(grid%(x,q)) AND grid%(x,y)=grid%(x,q) THEN RETurn 0 2550 END IF 2560 END FOR q 2570 REMark Try other cells in the same 3x3 square. 2580 LET po=(x DIV 3)*3 2590 LET qo=(y DIV 3)*3 2600 FOR p=po TO po+2 2610 FOR q=qo TO qo+2 2620 IF p<>x OR q<>y THEN 2630 IF Confirmed(grid%(p,q)) AND grid%(p,q)=grid%(x,y) THEN RETurn 0 2640 END IF 2650 END FOR q 2660 END FOR p 2670 RETurn 1 2680 END DEFine OKpos