Autor
| Solving sudoku's in BASIC
| DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 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  | | ARTRAG msx master Mensajes: 1686 | Publicado: Diciembre 15 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
| | DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 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.. | | Gilneas2 msx freak Mensajes: 177 | Publicado: Diciembre 15 2005, 13:42   | I tried it out, and it works perfectly
 | | DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 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! | | turbor msx freak Mensajes: 177 | Publicado: Diciembre 15 2005, 16:13   | Completely off-topic:
Gilneas2, which window manager/theme are you using ?!
| | Gilneas2 msx freak Mensajes: 177 | Publicado: Diciembre 15 2005, 17:14   | Blizzard's official World of Warcraft theme for some Stardock theme manager (although I have never played WoW...)
Download site + screenshot | | dvik msx master Mensajes: 1312 | Publicado: Diciembre 15 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).
| | DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 2005, 19:08   | Quote:
| 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).
|
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
| | manuel online msx guru Mensajes: 3450 | Publicado: Diciembre 15 2005, 19:18   | Glineas2: please update your openMSX!  | | AuroraMSX
 msx master Mensajes: 1248 | Publicado: Diciembre 15 2005, 19:21   | Quote:
| 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?
| | DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 2005, 19:24   | ah, thats an interesting post AuroraMSX!
but as you said... "who needs recursion(...)"
At least, there is no need to make this algorithm recurse.. especially not in basic on an 3.5MHz machine. It only gererates overhead.
| | dvik msx master Mensajes: 1312 | Publicado: Diciembre 15 2005, 19:28   | Quote:
| please correct me if im wrong.. maybe you mistake Glineas2 for me
|
Indeed I did, Sorry DarQ.
So then, do you have any plans to do a sudoku game? I know I'd play it a lot  | | POISONIC msx professional Mensajes: 883 | Publicado: Diciembre 15 2005, 19:31   | | | DarQ msx professional Mensajes: 836 | Publicado: Diciembre 15 2005, 19:33   | Quote:
| Quote:
| please correct me if im wrong.. maybe you mistake Glineas2 for me
|
Indeed I did, Sorry DarQ.
So then, do you have any plans to do a sudoku game? I know I'd play it a lot 
|
 hehe
well, i can make a generator for the MSX, thats not really an issue. But making a nice interface (GUI if you want) to play will cost me a LOT of time (i think)
i believe i will make a generator in a few weeks after i finished my C# program. then i can create a huge database so i can create even more sudoku's for you to play with  | |
| |
| |