Solving sudoku's in BASIC

Paragon (1038)

15-12-2005, 13:28

I never made a sudoku
I did code some C# sources that solve it
I made sudoku's by hand, ah its okay
I was bored, so went to MeitsNeardark's place
I don't have a running MSX, only openMSX.. Jelle has one
I coded a lame BASIC program that solves it, thnx Jelle

FYI: It uses backtracking, not recursive.. how would i ever recurse in basic without using assembly? and btw: recursion sucks in this case, iterations are faster because we don't call the method/function all the time.. it also prevents a segfault or stackoverflowexeption.. at least mono does segfault... bla bla bla

10 DATA 0,2,0,0,0,0,0,8,0

20 DATA 0,0,8,0,9,0,0,0,7

30 DATA 3,0,0,0,0,1,0,2,0

40 DATA 2,0,5,1,7,0,0,0,4

50 DATA 0,0,0,8,0,2,0,0,0

60 DATA 9,0,0,0,5,6,1,0,2

70 DATA 0,9,0,7,0,0,0,0,5

80 DATA 1,0,0,0,6,0,7,0,0

90 DATA 0,4,0,0,0,0,0,3,0

100 '

110 ' Create 2D array from data and count empty cells

120 '

130 PRINT "Creating 2D array..."

140 DIM GP(8, 8) ' Game pattern

150 X = 0

160 Y = 0

170 EC = 0 ' Number of empty cells

180 FOR I = 0 TO 80

190 READ A

200 GP(X, Y) = A

210 IF A = 0 THEN EC = EC + 1

220 X = X + 1

230 IF X = 9 THEN X = 0 : Y = Y + 1

240 NEXT I

250 '

260 ' Create empty cell lists

270 '

280 PRINT "Creating empty cell lists..."

290 DIM EX(EC - 1) ' Empty cell X positions

300 DIM EY(EC - 1) ' Empty cell Y positions

310 PO = 0

320 FOR Y = 0 TO 8

330 FOR X = 0 TO 8

340 IF GP(X, Y) = 0 THEN EX(PO) = X : EY(PO) = Y : PO = PO + 1

350 NEXT X

360 NEXT Y

370 '

380 ' Initialize solving loop

390 '

400 PRINT : PRINT "Initiale solving loop..."

410 EP = 0 ' Empty cell pointer

420 MP = 0 ' Previous moves pointer

430 CI = 0 ' Candidate index pointer

440 DIM CL(9) ' Candidate array

450 DIM PI(EC) ' Previous move candidate index pointer array

460 '

470 ' Start solving loop

480 '

490 PRINT "Start solving loop..."

500 PRINT

510 IF EP > EC - 1 THEN GOSUB 1240 : END

520 X = EX(EP) ' Get x location for current empty cell

530 Y = EY(EP) ' Get y location for current empty cell

540 PRINT "Investigating"; X; ","; Y; "cIndex="; CI

550 ' Obtain candidates in cl array

560 GOSUB890

570 ' Check if there are candidates

580 IF CO > 0 THEN GOTO660

590 PRINTTAB(4) "Damn, there are no candidates at all!"

600 EP = EP - 1

610 MP = MP - 1

620 CI = PI(MP) + 1

630 GP(EX(EP),EY(EP)) = 0

640 GOTO 500

650 ' Check if we haven't tried all candidates

660 IF CO > CI THEN GOTO 740

670 PRINTTAB(4) "Fuck, we already tried all candidates!"

680 EP = EP - 1

690 MP = MP - 1

700 CI = PI(MP) + 1

710 GP(EX(EP),EY(EP)) = 0

720 GOTO 500

730 ' Ah, let's put the number on the board shall we

740 PRINTTAB(4) "Yes, add";CL(CI);"to x";X;",y";Y

750 GP(X,Y) = CL(CI)

760 ' Add this move to the previous moves lists

770 PI(MP) = CI

780 MP = MP + 1

790 ' Reset cIndex

800 CI = 0

810 ' Advance to the next cell

820 EP = EP + 1

830 ' Display the pattern

840 GOSUB 1240

850 GOTO 500

860 '

870 ' Get all candidates for the specified cell

880 '

890 PRINTTAB(4) "Obtain candidate list for";X;",";Y

900 FOR I = 0 TO 9

910 CL(I) = I

920 NEXT I

930 ' Apply region constraint

940 XX = (X \ 3) * 3

950 YY = (Y \ 3) * 3

960 FOR TY = YY TO YY + 2

970 FOR TX = XX TO XX + 2

980 IF GP(TX, TY) > 0 THEN CL(GP(TX, TY)) = 0

990 NEXT TX

1000 NEXT TY

1010 ' Apply row constraint

1020 FOR XX = 0 TO 8

1030 IF GP(XX, Y) > 0 THEN CL(GP(XX, Y)) = 0

1040 NEXT XX

1050 ' Apply column constraint

1060 FOR YY = 0 TO 8

1070 IF GP(X, YY) > 0 THEN CL(GP(X, YY)) = 0

1080 NEXT YY

1090 ' Sequence the cl array and count instances

1100 K = 0 ' Sequencing pointer

1110 CO = 0 ' Number of instances

1120 FOR I = 1 TO 9

1130 IF CL(I) > 0 THEN A=CL(I) : CL(I)=0 : CL(K)=A : K = K + 1 : CO = CO + 1

1140 NEXT I

1150 PRINTTAB(4) "Candidate list>>";

1160 FOR I = 0 TO 9

1170 PRINT ;CL(I);

1180 NEXT I

1190 PRINT ;"Count:"; CO

1200 RETURN

1210 '

1220 ' Print the entire game pattern

1230 '

1240 FOR YY = 0 TO 8

1250 FOR XX = 0 TO 8

1260 PRINT;GP(XX,YY);

1270 NEXT XX

1280 PRINT

1290 NEXT YY

1300 RETURN

I think i will make it a bit more userfriendly and maybe it'll become a goodlooking program that does not say fuck or damn..

Well at least it works, the sudoku in the first data lines will finish in 285 iterations, it does 169 moves and 116 backtracks (28 No Candidate Errors and 88 All Candidates Tried errors resp DAMN and FUCK in the program).

have fun
but i doubt it

By ARTRAG

Prophet (3870)

15-12-2005, 13:36

Great !
I was thinking to this problem, but I haven't yet had the right idea to solve the game....
Good work

By Google

By DarQ

Paragon (1038)

15-12-2005, 13:38

ah well, backtracking isnt the best solution to the problem. but it will solve all correct sudoku's if you give it enough time to run

if you have a decent language at your disposal i advice you to try the famous Donald Knuth's Dancing LInks algorithm that will solve all NP-Complete problems including sudoku.

I haven't finished my DLX implementation on C# yet, but it'll come..

By Gilneas2

Master (234)

15-12-2005, 13:42

I tried it out, and it works perfectly

www.dioa.net/img/sodsolve.png

By DarQ

Paragon (1038)

15-12-2005, 13:43

hahaha how nice of you to test it and post a screenshot of it Gilneas2

EDIT:
oh, i see it now... i remember the first 3 digits and its the sudoku from the data lines. of course it works because i tested that one

but don't worry, i didnt test more sudoku's but my C# program solves them all, and so will this one... it has to!

By turbor

Champion (264)

15-12-2005, 16:13

Completely off-topic:

Gilneas2, which window manager/theme are you using ?!

By Gilneas2

Master (234)

15-12-2005, 17:14

Blizzard's official World of Warcraft theme for some Stardock theme manager (although I have never played WoW...)

Download site + screenshot

By dvik

Prophet (2173)

15-12-2005, 19:02

Gilneas2, Are you planning to do a sudoku generator too? Would be nice to see a Sudoku game on MSX. I love sudoku (Although I prefer to print it on paper before solving it, it would be nice to see an MSX version).

By DarQ

Paragon (1038)

15-12-2005, 19:08

please correct me if im wrong.. maybe you mistake Glineas2 for me

anyway, IF the question is for me:
i have nothing in my planning, and an MSX is far too slow to generate HUGE ammounts of sudoku's since you need a VERY fast solver for it.. there is, however, a way to quickly come up with new sudoku's...

(FYI: the simplest/quickest way to come up with new sudoku's is permutating others, if i generate a huge database with my C# program, but it isnt able to generate YET)

anyway, i HAVE to do do it in asm them and not in basic.. at least, it is a bit faster than basic.

here is the code for the newer version: this one displays the backtracking steps visually.. so give it a try! it looks better, especially with openmsx at 500% speed !

10 DATA 0,2,0,0,0,0,0,8,0

20 DATA 0,0,8,0,9,0,0,0,7

30 DATA 3,0,0,0,0,1,0,2,0

40 DATA 2,0,5,1,7,0,0,0,4

50 DATA 0,0,0,8,0,2,0,0,0

60 DATA 9,0,0,0,5,6,1,0,2

70 DATA 0,9,0,7,0,0,0,0,5

80 DATA 1,0,0,0,6,0,7,0,0

90 DATA 0,4,0,0,0,0,0,3,0

100 ' Create 2D array from data, count empty cells and display

110 CLS

120 DIMGP(8, 8) ' Game pattern

130 X=0:Y=0:EC=0 ' Number of empty cells

140 FORI=0TO80:READA:GP(X,Y)=A

150 IFA=0THENEC=EC+1

160 LOCATE28+(X*2),2+(Y*2):PRINTCHR$(A+48)

170 X=X+1:IFX=9THENX=0:Y=Y+1

180 NEXT

190 ' Draw board lines

200 FORY=2TO18:LOCATE33,Y:PRINT"G":LOCATE39,Y:PRINT"G":NEXT

210 FORX=28TO44:LOCATEX,7:PRINT"G":LOCATEX,13:PRINT"G":NEXT

220 ' Create empty cell lists

230 DIMEX(EC-1) ' Empty cell X positions

240 DIMEY(EC-1) ' Empty cell Y positions

250 PO=0:FORY=0TO8:FORX=0TO8

260 IFGP(X,Y)=0THENEX(PO)=X:EY(PO)=Y:PO=PO+1

270 NEXTX,Y

280 ' Initialize solving loop

290 EP=0 ' Empty cell pointer

300 MP=0 ' Previous moves pointer

310 CI=0 ' Candidate index pointer

320 DIMCL(9) ' Candidate array

330 DIMPI(EC) ' Previous move candidate index pointer array

340 ' Start solving loop

350 IFEP>EC-1THENEND

360 X=EX(EP):Y=EY(EP) ' Get X,Y locations for current empty cell

370 GOSUB550 ' Obtain candidates for x,y in cl array

380 ' Check if there are candidates

390 IF CO = 0 THEN GOTO 490

400 ' Check if we haven't tried all candidates

410 IF CO < CI + 1 THEN GOTO 490

420 ' Ah, let's put the number on the board shall we

430 GP(X,Y) = CL(CI)

440 ' Add this move to the previous moves lists and advance to next cell

450 PI(MP)=CI:MP=MP+1:CI=0:EP=EP+1

460 ' Display the placed cell

470 LOCATE28+(X*2),2+(Y*2):PRINTCHR$(GP(X,Y)+48):GOTO350

480 ' Undo and revert to previous cell

490 EP=EP-1 ' Set emptyCell pointer to the previous one

500 MP=MP-1 ' Set the moves pointer to the previous one

510 CI=PI(MP)+1 ' Set cIndex to the one of the previous move and increment

520 GP(EX(EP),EY(EP))=0 ' Reset the previous value on the board

530 LOCATE28+(EX(EP)*2),2+(EY(EP)*2):PRINTCHR$(48):GOTO350

540 ' Get all candidates for the specified cell

550 FORI=0TO9:CL(I)=I:NEXTI

560 ' Apply region constraint

570 XX=(X\3)*3:YY=(Y\3)*3

580 FORTY=YYTOYY+2:FORTX=XXTOXX+2

590 IFGP(TX,TY)>0THENCL(GP(TX,TY))=0

600 NEXTTX,TY

610 ' Apply row constraint

620 FORXX=0TO8

630 IFGP(XX,Y)>0THENCL(GP(XX,Y))=0

640 NEXTXX

650 ' Apply column constraint

660 FORYY=0TO8

670 IFGP(X,YY)>0THENCL(GP(X,YY))=0

680 NEXTYY

690 ' Sequence the cl array and count instances

700 K=0:CO=0

710 FORI=1TO9

720 IFCL(I)>0THENA=CL(I):CL(I)=0:CL(K)=A:K=K+1:CO=CO+1

730 NEXTI:RETURN

By Manuel

Enlighted (7235)

15-12-2005, 19:18

Glineas2: please update your openMSX!

By AuroraMSX

Paragon (1851)

15-12-2005, 19:21

how would i ever recurse in basic without using assembly?
1. Predict how deep your algorithm will recurse (81 times would be a pretty decent upper limit in the case of sudoku :-))
2. put all parameters to the recursive algorithm in an array dimensioned to the result of step 1
(like DIM P(81))
3. create a "stack pointer" variable that will index the array
(like: SP=0)
4. create resursive calls like this:
P[SP+1] = 3 * P[SP] + 1 ' or sumthn
SP=SP+1: GOSUB 1000: SP=SP-1 ' the recursive routine starts at 1000
5. Be sure to restore variables used in the recursive routine get set back to their old values after the recursive call
6. Watch your recursion do its do...

Ob-FIB

5 DIM R[70]
10 INPUT"FIB of"; N: If N > 69 THEN PRINT "Oh, please, get real...": GOTO 10
20 R=0: SP=0: GOSUB 100
30 PRINT R
40 GOTO 10
100 ' Calc FIB(N) = FIB(N-1)+FIB(N-2), for N >= 2; FIB(N) = N for N=0,1
110 IF N < 2 THEN R = N: RETURN  ' The easy case
120 SP=SP+1: N=N-1: GOSUB 100 ' Do the recursive call : FIB(N-1)
130 N=N+1: SP=SP-1: R[SP] = R ' Restore old values and save result
140 SP=SP+1: N=N-2: GOSUB 100 '  Do recursive call FIB(N-2)
150 N=N+2: SP=SP-1: R[SP] = R[SP] + R ' Restore old values and calc result
160 R = R[SP] ' set result
170 RETURN

The above example is of course for educational purposes only - it can be modified, optimized etc etc. In the end, who needs recursion to calculate Fibonacci?