Qbasicnews.com

QbasicNews.Com => Challenges => Topic started by: Agamemnus on August 22, 2005, 01:25:09 AM



Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on August 22, 2005, 01:25:09 AM
I got interested when this puzzle was integrated into a certain game I play(Don't ask, it's addictive then after 2 yrs boring as hell)

Su doku/sudoku is a (Japanese?) numbers game. In the version I played 1 through 9 represent magical runes.

There is a 81x81 2D box. When the puzzle is complete, it must be filled with numbers, 1-9. Each number cannot repeat in 3 different circumstances:

In the same 3x3 grid. There are 9 non-overlapping grids in the box.
In the same column.
In the same row.

The solver should take a set of numbers from a file as input and output a set of numbers to another file, with the option to print results and progress something like this: (0s represent initial blank spaces)

Code:


(input shown)

124000563
050050000
007000090
013800600
000647012
200000357
789000001
000005200
000310000


I have a working version of a puzzle solver that I made that I can upload after the first few posts or in a few days.

The puzzle description can be found all over the net. Furthermore, some newspapers (especially British), have these in their puzzle pages.

Edit:
Yetifoot gets the "prize" for this challenge: a lifetime supply of free qbasicnews posts and recognition on this first thread!


Title: Make a solver for Su Doku in freebasic.
Post by: Mr Match on August 22, 2005, 02:52:12 PM
Sudoku is Japanese for "single number"

dont ask, i just know.

i play it once and awhile in a local newspaper here in MN, its pretty fun when you have absolutly nothing to do  :o

well, i'll give it my best shot if i have some time left in the day  :wink:

Edit: wow i had alot of typos  :lol:


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on August 23, 2005, 01:35:47 AM
It's kind of difficult... i'll try cleaning up my code a bit later and then I'll submit it.

It takes practically forever for my program to do one with just 1 initial number....


Title: Make a solver for Su Doku in freebasic.
Post by: rdc on August 23, 2005, 10:57:05 AM
I think a genetic algorithm would work very well for this problem.


Title: Make a solver for Su Doku in freebasic.
Post by: KiZ on August 23, 2005, 07:01:55 PM
Quote from: "rdc"
I think a genetic algorithm would work very well for this problem.

Thats just what I was thinking last night. I was brainstorming about using a Genetic Algo to solve it. The main thing is I cant be bothered programing in the tedious ruleset for checking wether the puzzle is legal.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on August 24, 2005, 12:23:57 AM
A genetic algorithm would be interesting but difficult. I still need to clean up my code. I'll post it tomorrow and then feel free to add suggestions..


Title: Make a solver for Su Doku in freebasic.
Post by: rdc on August 24, 2005, 10:50:30 AM
Quote from: "dark_prevail"
Thats just what I was thinking last night. I was brainstorming about using a Genetic Algo to solve it. The main thing is I cant be bothered programing in the tedious ruleset for checking wether the puzzle is legal.


Actually, the rule set would not be all that difficult. You would mainly just have to check a row, column and region and assign a fitness value to each area. The real problem I see is that it may take a long time to arrive at a solution, since a GA starts with a random ruleset. According to the Wikipedia (http://en.wikipedia.org/wiki/Sodoku) there can be 6,670,903,752,021,072,936,960 valid solutions in a 9x9 grid.

That being said, it might be fun to try it anyway.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on August 24, 2005, 11:14:22 PM
Dancing links? Nice.

Still can't post my own program.

Got this off of qb45.com:

http://www.qb45.com/index.php?page=downloads&action=comments&id=1392

Code:

DIM gr$(18, 9), rg$(18, 9): SCREEN 7: CLS : FOR a = 1 TO 9: FOR b = 1 TO 9: gr$(a, b) = " ": LINE (((a - 1) * 32), ((b - 1) * 16) + 11)-STEP(32, 16), 8, B
IF a / 3 = INT(a / 3) AND b / 3 = INT(b / 3) THEN LINE (((a - 3) * 32), ((b - 3) * 16) + 11)-STEP(96, 48), 15, B
NEXT b, a: x = 5: y = 5: vv = 1: c = 0: fl = 0: COLOR 10: LOCATE 21, 2: PRINT "CURSORS"; : COLOR 2: PRINT "=move"; : COLOR 10: PRINT " 1-9"; : COLOR 2
PRINT "=number"; : COLOR 10: PRINT " ENTER"; : COLOR 2: PRINT "=solve": COLOR 10: PRINT " SPACE"; : COLOR 2: PRINT "=clear number"; : COLOR 10
PRINT " DELETE"; : COLOR 2: PRINT "=wipe grid": COLOR 1: PRINT " *SuDoKu SoLVeR*  (c)David Hall 2005";
cc: LOCATE (y * 2) + 1, (x * 4) - 1: COLOR 11: i$ = CHR$(2): IF fl = 0 AND gr$(x, y) <> " " THEN i$ = gr$(x, y)
PRINT i$: COLOR 15: i$ = "": c = c + 1: IF c > 2400 THEN c = 0: fl = fl XOR 1
i$ = RIGHT$(INKEY$, 1): IF VAL(i$) > 0 THEN GOSUB hh: IF fl = 0 THEN gr$(x, y) = i$: GOSUB ff: x = x + 1: IF x > 9 THEN x = 1: y = y + 1: IF y > 9 THEN y = 1
IF i$ = " " THEN gr$(x, y) = " ": GOSUB ff: x = x + 1: IF x > 9 THEN x = 1: y = y + 1: IF y > 9 THEN y = 1
IF i$ = CHR$(13) THEN GOSUB ff: GOTO rn
IF i$ = CHR$(75) AND x > 1 THEN GOSUB ff: x = x - 1 ELSE IF i$ = CHR$(77) AND x < 9 THEN GOSUB ff: x = x + 1
IF i$ = CHR$(72) AND y > 1 THEN GOSUB ff: y = y - 1 ELSE IF i$ = CHR$(80) AND y < 9 THEN GOSUB ff: y = y + 1
IF i$ = CHR$(83) THEN RUN ELSE GOTO cc
ff: LOCATE (y * 2) + 1, (x * 4) - 1: PRINT gr$(x, y): RETURN
hh: fl = 0: a = 1: WHILE a < 10: IF gr$(a, y) = i$ OR gr$(x, a) = i$ THEN fl = 1: RETURN
a = a + 1: WEND: a = INT((x - 1) / 3): a = (a * 3) + 1: b = INT((y - 1) / 3): b = (b * 3) + 1
FOR c = a TO a + 2: FOR d = b TO b + 2: IF gr$(c, d) = i$ THEN fl = 1
NEXT d, c: RETURN
rn: COLOR 7: lf = 0: o = 49: a = 1: b = 1: FOR j = 49 TO 57: FOR y = 1 TO 9: FOR x = 1 TO 9: IF j = 49 THEN rg$(x, y) = ""
IF gr$(x, y) <> " " THEN GOTO zz
i$ = CHR$(j): GOSUB hh: IF fl = 0 THEN rg$(x, y) = rg$(x, y) + i$
IF j = 57 AND LEN(rg$(x, y)) = 1 THEN gr$(x, y) = rg$(x, y): GOSUB ff: lf = 1: rg$(x, y) = ""
zz: NEXT x, y, j: IF lf = 1 THEN GOTO rn
pip: i$ = CHR$(o): y = 1: WHILE y < 10: ct = 0: FOR x = 1 TO 9: IF rg$(x, y) = "" THEN GOTO ra
IF INSTR(1, rg$(x, y), i$) > 0 THEN ct = ct + 1: v = x
ra: NEXT x: IF ct = 1 THEN x = v: gr$(x, y) = i$: GOSUB ff: GOTO rn
y = y + 1: WEND: x = 1
WHILE x < 10: tc = 0: FOR y = 1 TO 9: IF rg$(x, y) = "" THEN GOTO ri
IF INSTR(1, rg$(x, y), i$) > 0 THEN tc = tc + 1: v = y
ri: NEXT y: IF tc = 1 THEN y = v: gr$(x, y) = i$: GOSUB ff: GOTO rn
x = x + 1: WEND
WHILE b < 10: ct = 0: FOR c = a TO a + 2: FOR d = b TO b + 2: IF rg$(c, d) = "" THEN GOTO rk
IF INSTR(1, rg$(c, d), i$) > 0 THEN ct = ct + 1: v = c: w = d
rk: NEXT d, c: IF ct = 1 THEN x = v: y = w: gr$(x, y) = i$: GOSUB ff: GOTO rn
a = a + 3: IF a > 7 THEN a = 1: b = b + 3
WEND: o = o + 1: IF o < 58 THEN GOTO pip
IF vv = 1 THEN vv = 2: j = 0: m = 9: GOSUB kl
mf = 0: co = 0: FOR y = 1 TO 9: FOR x = 1 TO 9: i$ = gr$(x, y): IF i$ = " " THEN co = 1: GOTO bl
gr$(x, y) = " ": GOSUB hh: gr$(x, y) = i$: IF fl = 1 OR (gr$(x, y) = " " AND rg$(x, y) = "") THEN mf = 1
bl: NEXT x, y: IF co = 0 AND mf = 0 THEN COLOR 15: FOR y = 1 TO 9: FOR x = 1 TO 9: GOSUB ff: NEXT x, y: END
IF mf = 1 THEN j = 9: m = 0: GOSUB kl
rb: x = INT(RND(1) * 9) + 1: y = INT(RND(1) * 9) + 1: IF LEN(rg$(x, y)) < 2 THEN GOTO rb
gr$(x, y) = MID$(rg$(x, y), INT(RND(1) * LEN(rg$(x, y))) + 1, 1): GOTO rn
kl: FOR y = 1 TO 9: FOR x = 1 TO 9: gr$(x + m, y) = gr$(x + j, y): rg$(x + m, y) = rg$(x + j, y): NEXT x, y: RETURN


Title: Make a solver for Su Doku in freebasic.
Post by: Neo on August 25, 2005, 09:21:06 AM
Quote from: "Agamemnus"
124000563
050050000
007000090
013800600
000647012
200000357
789000001
000005200
000310000

This example Su Doku you posted is inconsistent because it has two 5's on the 2nd row.

*making solver now*


Title: Make a solver for Su Doku in freebasic.
Post by: Neo on August 25, 2005, 12:53:47 PM
Here's what I made today:
http://qbnz.com/harsoft/SuDoku.zip

It's in FreeBasic, and can solve Su Doku's. Comes with 3 su doku files too to test.
On my computer (2 GHz) it takes about ~9 ms to solve a Su Doku this way (which is pretty slow, but still, it seems to work).


Title: Make a solver for Su Doku in freebasic.
Post by: rdc on August 25, 2005, 01:26:20 PM
Quote from: "Neo"
It's in FreeBasic, and can solve Su Doku's.


Very impressive.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on August 25, 2005, 02:03:16 PM
This is mine, but it has a slight problem still with rolling back moves.

Instead of numbers it uses letters that stand for runes in this game that I mentioned earlier...
W = water = 1
E = earth = 2
F = fire = 3
A = air = 4
B = body = 5
M = mind = 6
C = chaos = 7
L = law = 8
D = death = 9


Code:

DECLARE FUNCTION round3%(n%)
DECLARE SUB setupASCIIScreen ()
DECLARE SUB refreshASCIIscreen ()
DECLARE SUB inputPuzzlefromfile (n$)
DECLARE SUB outputPuzzletofile (n$)
declare function puzzleiscorrect% ()
declare function puzzleisfull% ()

'variables for the basic game structure
DIM SHARED runepuzzle%(1 TO 9, 1 TO 9)       'x, y. Values range from 1 to 9.
DIM SHARED invalid%(1 to 9, 1 TO 9, 1 TO 9)  'curtype%, x, y. Each value is 0 or 1.

'e.g.: runelocX%(1, 1) = 0: the first rune type is present on the first row.
DIM SHARED runelocX%(1 TO 9, 1 TO 9)     'type, location. Each value is 0 or 1.
DIM SHARED runelocY%(1 TO 9, 1 TO 9)     'type, location. Each value is 0 or 1.
DIM SHARED exists%(1 TO 9)               'row/column (X/Y) location.
DIM SHARED exists3x3%(9, 1 tO 3, 1 TO 3) 'type, X Y location. Each value is 0 or 1.
dim shared curx%, cury%

'variables for game "visuals"
DIM SHARED initialplaces%(1 TO 9, 1 TO 9) 'x, y
dim shared offsetx%, offsety%
dim shared pausetooutput%: pausetooutput% = 1
dim shared showoutput%: showoutput% = 1
dim shared showOutputFrequency%: showOutputFrequency% = 100 'Internal variable.

'extra variables for the decision tree.
dim shared decisionRuneX%(1 to 81)         '1 to 9.
dim shared decisionRuneY%(1 to 81)         '1 to 9.
dim shared decisionRuneType%(1 to 81)      '1 to 9.
dim shared decisionTreeBranch%(1 to 81)    '1 to 81.
dim shared decisionTreeBranchMax%(1 to 81) '1 to 81.
dim shared decisionTreeRune2%(1 to 81)     '1 to 81.
dim shared decisionTreeX%(1 to 81)         '1 to 9.
dim shared decisionTreeY%(1 to 81)         '1 to 9.
dim shared currentStep%: currentStep% = 1  '1 to 81.

'variables for loading and saving.
dim shared puzzleLoadname$
dim shared puzzleSavename$

'This program needs 3 text files to function:
'agasudoku.txt (must be in same location as agasudoku.exe/.bas),
'and input and output files whose names can be specified inside
'agasudoku.txt.

'example agasudoku.txt:

'example testpuzzle.txt: (not case sensitive)
'
'     WF  
' MEF   C
'A   B  L
'E      M
'  F   W  
' L      B
' B  L   F
' C   ABE
'  DW

'testpuzzleoutput.txt can be a blank file.

close
open "agasudoku.txt" FOR INPUT AS #1
line input #1, puzzleLoadname$
line input #1, puzzleSavename$
for i% = 1 to 2
if eof(1) then exit for
line input #1, p1$
p1$ = lcase(p1$)
if p1$ = "pausetooutput" then pausetooutput% = 1 else pausetooutput% = 1
if p1$ = "showoutput" then showoutput% = 1 else showoutput% = 1
next i%
close

'Load in puzzle from a file.
inputpuzzlefromfile puzzleLoadName$

'sets up the initial conditions for the ASCII screen
setupASCIIScreen




redo1: 'main loop
'Refresh the ASCII rune screen

if puzzleiscorrect% = 0 then gosub undostep': goto redo2

redo2: 'sub-loop used to bypass the undostep if necessary (and it will be).

if showoutput% = 1 then
count1% = count1% + 1
if count1% = showOutputFrequency then count1% = 0: RefreshASCIIScreen
end if

curvalidmax% = 1
currentBranch% = 1


'fill in 8/9 horizontal line. (X)
FOR y1% = 1 TO 9
empties% = 0
FOR x1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN empties% = empties% + 1
NEXT x1%

IF empties% = 1 THEN
FOR i% = 1 TO 9: exists%(i%) = 0:NEXT i%
FOR x1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN placeruneatX% = x1%
exists%(runepuzzle%(x1%, y1%)) = 1
NEXT x1%
FOR curtype% = 1 TO 9
IF exists%(curtype%) = 0 THEN exit for
NEXT curtype%
if exists3x3(curtype%, placeruneatX%, y1%) = 0 then
curx% = placeruneatX%: cury% = y1%
decisionTreeBranch%(currentStep%) = 1
gosub rowcolumnmatch: GOTO redo1
end if
END IF
NEXT y1%


'fill in 8/9 vertical line. (Y)
FOR x1% = 1 TO 9
empties% = 0
FOR y1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN empties% = empties% + 1
NEXT y1%

IF empties% = 1 THEN
FOR i% = 1 TO 9: exists%(i%) = 0:NEXT i%
FOR y1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN placeruneatY% = y1%
exists%(runepuzzle%(x1%, y1%)) = 1
NEXT y1%

FOR curtype% = 1 TO 9
IF exists%(curtype%) = 0 THEN exit for
NEXT curtype%
if exists3x3(curtype%, x1%, placeruneatY%) = 0 then
curx% = x1%
cury% = placeruneatY%
decisionTreeBranch%(currentStep%) = 1
gosub rowcolumnmatch: GOTO redo1
end if
END IF
NEXT x1%




'This loop is used to find a place where a rune must be located
'using the rules of Sudoku as a process of elimination.
FOR curtype% = 1 TO 9
'clear the invalid list. make all spaces valid (valid=0, invalid = 1).
'The invalid list shows where the rune CANNOT be placed.
FOR x1% = 1 TO 9: FOR y1% = 1 TO 9: invalid%(curtype%, x1%, y1%) = 0: NEXT y1%, x1%

'Vertical check.
'Cannot place a rune in a column if one already exists there.
FOR x1% = 1 TO 9
IF runelocx%(curtype%, x1%) = 1 THEN
FOR y1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN invalid%(curtype%, x1%, y1%) = 1
NEXT y1%
END IF
NEXT x1%

'Horizontal check.
'Cannot place a rune in a row if one already exists there.
FOR y1% = 1 TO 9
IF runelocy%(curtype%, y1%) = 1 THEN
FOR x1% = 1 TO 9
IF runepuzzle%(x1%, y1%) = 0 THEN invalid%(curtype%, x1%, y1%) = 1
NEXT x1%
END IF
NEXT y1%

'Go through in 3x3 cells and find valid locations.
'If there is only one valid location in a 3x3 square,
'then set its location as the current rune.
'This also happens to find instances of 8/9 cells and fills them.
FOR x1% = 0 TO 6 STEP 3
FOR y1% = 0 TO 6 STEP 3
curvalidmax% = 0

FOR x2% = 1 TO 3
FOR y2% = 1 TO 3
IF runepuzzle%(x1%+x2%, y1%+y2%) = 0 THEN
IF invalid%(curtype%, x1%+x2%, y1%+y2%) = 0 THEN
if exists3x3(curtype%, round3%(x1+x2%), round3%(y1+y2%)) = 0 then
curvalidmax%=curvalidmax%+1
curx% = x1% + x2%
cury% = y1% + y2%
end if
end if
END IF
NEXT y2%, x2%
IF curvalidmax% = 1 THEN
decisionTreeBranchMax%(currentStep%) = 1
gosub rowcolumnmatch: GOTO redo1
END IF
NEXT y1%, x1%

NEXT curtype%

'This is the multi-branch, or multi-option part of the program.
'So far, every decision has been "mechanical" and 100% correct.
'This part guesses where to go starting with the first choice.
'...If that choice doesn't produce a valid answer it tries the next one.
'It is similar to the previous "FOR curtype% = 1 to 9...NEXT curtype%" loop.
FOR curtype% = 1 TO 9
'clear the invalid list. make all spaces valid (valid=0, invalid = 1).
'The invalid list shows where the rune CANNOT be placed.
FOR x1% = 1 TO 9: FOR y1% = 1 TO 9: invalid%(curtype%, x1%, y1%) = 0: NEXT y1%, x1%

'Vertical check.
'Cannot place a rune in a column if one already exists there.
FOR x1% = 1 TO 9
IF runelocx%(curtype%, x1%) = 1 THEN
FOR y1% = 1 TO 9
invalid%(curtype%, x1%, y1%) = 1
NEXT y1%
END IF
NEXT x1%

'Horizontal check.
'Cannot place a rune in a row if one already exists there.
FOR y1% = 1 TO 9
IF runelocy%(curtype%, y1%) = 1 THEN
FOR x1% = 1 TO 9
invalid%(curtype%, x1%, y1%) = 1
NEXT x1%
END IF
NEXT y1%
next curtype%

'Go through in 3x3 cells and find valid locations.
'If there is only one valid location in a 3x3 square,
'then set its location as the current rune.
'This also happens to find instances of 8/9 cells and fills them.
'Find valid locations for all runes in each square first.
FOR x1% = 0 TO 6 STEP 3
FOR y1% = 0 TO 6 STEP 3
curvalidmax% = 0
for curtype% = 1 to 9
FOR x2% = 1 TO 3
FOR y2% = 1 TO 3
IF runepuzzle%(x1%+x2%, y1%+y2%) = 0 THEN
IF invalid%(curtype%, x1%+x2%, y1%+y2%) = 0 THEN
if exists3x3(curtype%, round3%(x1+x2%), round3%(y1+y2%)) = 0 then
curvalidmax%=curvalidmax%+1
decisionTreeX%(curvalidmax%) = x1% + x2%
decisionTreeY%(curvalidmax%) = y1% + y2%
decisionTreeRune2%(curvalidmax%) = curtype%
end if
end if
END IF
NEXT y2%, x2%
next curtype%

IF curvalidmax% >= 1 THEN
currentBranch% = decisionTreeBranch%(currentStep%)
if currentbranch% = 0 then currentbranch% = 1
curtype% = decisionTreeRune2%(currentBranch%)

curx% = decisionTreeX%(currentBranch%)
cury% = decisionTreeY%(currentBranch%)
decisionTreeBranch%(currentStep%) = currentBranch%
decisionTreeBranchMax%(currentStep%) = curvalidmax%
gosub rowcolumnmatch: GOTO redo1
END IF

NEXT y1%, x1%


justadded% = 0
n2%=n2%+1
locate 3,1: PRINT n2%
if puzzleisfull% = 0 then gosub undostep: goto redo2
RefreshASCIIScreen


locate 3,2: PRINT "Solution below. PRESS <ESC> to exit."
system
do:if inkey$ = CHR$(27) THEN EXIT DO
LOOP

SYSTEM

rowcolumnmatch:
exists3x3%(curtype%, round3%(curx%),round3%(cury%)) = exists3x3%(curtype%, round3%(curx%),round3%(cury%)) + 1
runelocx%(curtype%, curx%) = 1
runelocy%(curtype%, cury%) = 1
runepuzzle%(curx%, cury%) = curtype%
decisionRuneX%(currentStep%) = curx%
decisionRuneY%(currentStep%) = cury%
decisionRuneType%(currentStep%) = curtype%
decisionTreeBranch%(currentStep%) = currentBranch%
decisionTreeBranchMax%(currentStep%) = curvalidmax%

currentStep% = currentStep% + 1
justadded% = 1
return

undostep:
if justadded% = 1 then currentStep% = currentStep% - 1:
justadded%  =0
do
curtype% = decisionRuneType%(currentStep%)
curx% = decisionRuneX%(currentStep%)
cury% = decisionRuneY%(currentStep%)
exists3x3%(curtype%, round3%(curx%),round3%(cury%)) = 0
runelocx%(curtype%, curx%) = 0
runelocy%(curtype%, cury%) = 0
runepuzzle%(curx%, cury%) = 0

if decisionTreeBranch%(currentStep%) <> decisionTreeBranchMax%(currentStep%) then exit do
currentStep% = currentStep% - 1
loop

decisionTreeBranch%(currentStep%) = decisionTreeBranch%(currentStep%) + 1
return

FUNCTION round3%(n%)
SELECT CASE n%
CASE 1 TO 3: round3% = 1
CASE 4 TO 6: round3% = 2
CASE 7 TO 9: round3% = 3
END SELECT
END FUNCTION


SUB inputPuzzlefromfile (n$)
'open the rune puzzle info file.
CLOSE
OPEN n$ FOR INPUT AS #1
FOR y1% = 1 TO 9
LINE INPUT #1, st1$
FOR x1% = 1 TO 9
rune1$ = ucase$(MID$(st1$, x1%, 1))
SELECT CASE rune1$
CASE " ": runepuzzle%(x1%, y1%) = 0
CASE "W": runepuzzle%(x1%, y1%) = 1
CASE "E": runepuzzle%(x1%, y1%) = 2
CASE "F": runepuzzle%(x1%, y1%) = 3
CASE "A": runepuzzle%(x1%, y1%) = 4
CASE "B": runepuzzle%(x1%, y1%) = 5
CASE "M": runepuzzle%(x1%, y1%) = 6
CASE "C": runepuzzle%(x1%, y1%) = 7
CASE "L": runepuzzle%(x1%, y1%) = 8
CASE "D": runepuzzle%(x1%, y1%) = 9
END SELECT
curtype% = runepuzzle%(x1%, y1%)
IF curtype% <> 0 THEN
initialplaces%(x1%, y1%) = 1
runelocX%(curtype%, x1%) = 1
runelocY%(curtype%, y1%) = 1
END IF
exists3x3(curtype%, round3(x1%),round3%(y1%)) = 1
NEXT x1%, y1%
CLOSE
END SUB

sub outputPuzzletofile (n$)
OPEN n$ FOR OUTPUT AS #1
FOR y1% = 1 TO 9: st1$ = ""
FOR x1% = 1 TO 9
SELECT CASE runepuzzle%(x1%, y1%)
CASE 0: runename$ = "-"
CASE 1: runename$ = "W"
CASE 2: runename$ = "E"
CASE 3: runename$ = "F"
CASE 4: runename$ = "A"
CASE 5: runename$ = "B"
CASE 6: runename$ = "M"
CASE 7: runename$ = "C"
CASE 8: runename$ = "L"
CASE 9: runename$ = "D"
END SELECT
st1$ = st1$ + runename$
NEXT x%
PRINT #1, st1$
NEXT y%
end sub

'setup of the screen in ASCII format.
SUB setupASCIIScreen ()
CLS
offsetx% = 10
offsety% = 10
COLOR , 15
PRINT STRING$(2600, " ");
FOR i% = 1 TO 9
LOCATE offsety% + i% + 3, offsetx% + 2: PRINT str$(i%)
LOCATE offsety% + i% + 3, offsetx% + 14: PRINT str$(i%)
LOCATE offsety% + 2, offsetx% + i% + 3: PRINT str$(i%)
LOCATE offsety% + 14, offsetx% + i% + 3: PRINT str$(i%)
NEXT i%
locate 1,3: print ""
end sub


'refresh of the screen in ASCII format.
sub refreshASCIIscreen ()
FOR x1% = 1 TO 9
FOR y1% = 1 TO 9
LOCATE offsety% + y1% + 3, offsetx% + x1% + 3
IF x1% = curx% AND y1% = cury% THEN COLOR 2 ELSE IF initialplaces%(x1%,y1%) = 1 THEN COLOR 7 ELSE COLOR 1
SELECT CASE runepuzzle%(x1%, y1%)
CASE 0: runename$ = "-"
CASE 1: runename$ = "W"
CASE 2: runename$ = "E"
CASE 3: runename$ = "F"
CASE 4: runename$ = "A"
CASE 5: runename$ = "B"
CASE 6: runename$ = "M"
CASE 7: runename$ = "C"
CASE 8: runename$ = "L"
CASE 9: runename$ = "D"
END SELECT

PRINT runename$

NEXT y1%
next x1%
if pausetooutput% then sleep
end sub


'verification function.
function puzzleiscorrect% ()
for y1% = 1 to 9
for x1% = 1 to 9
if runepuzzle%(x1%, y1%) <> 0 then
for x2% = 1 to 9
if x2% <> x1% then
if runepuzzle%(x1%, y1%) = runepuzzle%(x2%, y1%) then exit function
end if
next x2%
end if
next x1%
next y1%

for y1% = 1 to 9
for x1% = 1 to 9
if runepuzzle%(x1%, y1%) <> 0 then
for y2% = 1 to 9
if y2% <> y1% then
if runepuzzle%(x1%, y1%) = runepuzzle%(x1%, y2%) then exit function
end if
next y2%
end if
next x1%
next y1%

for runetype% = 1 to 9
for x1% = 1 to 3
for y1% = 1 to 3
if exists3x3%(x1%, y1%, runetype%) > 1 then exit function
next y1%, x1%
next runetype%
puzzleiscorrect% = -1
end function


'"full table?" function.
function puzzleisfull% ()
for x1% = 1 to 9
for y1% = 1 to 9
if runepuzzle%(x1%, y1%) = 0 then exit function
next y1%, x1%
puzzleisfull% = -1
end function


Title: Make a solver for Su Doku in freebasic.
Post by: Anonymous on August 25, 2005, 04:34:46 PM
format your code for once in your life !! XD !!


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on September 06, 2005, 09:42:31 PM
Code:


C:\>

C:\> FORMAT

This will erase all data in your hard disk. Proceed? (Y/N)

> Y

Erasing... 1% complete... hit ESC to exit erase procedure.
Erasing...99% complete...hit ESC to exit erase procedure.
Erasing... Well it looks a bit too bloody late now, isn't it?


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 20, 2006, 12:43:39 PM
This is an(other) updated version.

Code:
' Sudoku Solver (lib) v1.0b by yetifoot
' PUBLIC DOMAIN
' This is setup to run as a regular program, to demonstrate.
' In order to use this in a program, just remove the code afer 'Example Usage',
' then declare the 'board_solve' sub in your code.

Option Explicit

' Needed for memory functions
#include "crt.bi"

' Formulas used when determing board position/row/column
#define GetPos(x,y,b) (x + (y * 9) + (b * 3) + ((b \ 3) * 18))
#define GetCol(x,y,b) (GetPos(x,y,b) mod 9)
#define GetRow(x,y,b) (GetPos(x,y,b) \ 9)

' Enable using True/False
Enum Bool
  False
  True = NOT False
End Enum

' Structure used when determining valid candidates in the board
Type CANDIDATE_TYPE
  x As Integer
  y As Integer
  b As Integer
  num_possible_values As Integer
  possible_values(9) As Integer
End Type

' ---------------------------------------------------------------------------- '
' Functions for checking if a number is in any given row, cell or box

Function InRow(board As uByte ptr, r As Integer, n As Integer) As Integer
  Dim As Integer c
    For c = 0 To 8
      If board[c + (r * 9)] = n Then Return True
    Next c
    Return False
End Function

Function InCol(board As uByte ptr, c As Integer, n As Integer) As Integer
  Dim As Integer r
    For r = 0 To 8
      If board[c + (r * 9)] = n Then Return True
    Next r
    Return False
End Function

Function InBox(board As uByte ptr, b As Integer, n As Integer) As Integer
  Dim As Integer x, y
    For y = 0 To 2
      For x = 0 To 2
        If board[GetPos(x, y, b)] = n Then Return True
      Next x
    Next y
    Return False
End Function

' ---------------------------------------------------------------------------- '
' Functions to check a boards validity, and if its filled

Function IsValid(board As uByte ptr) As Integer
  Dim As Integer r, c, b, i, x, y, p, n
  Dim As Integer numseen(10)
 
  '!!!!!!!!!!!!!!!!!!!!!
  '  NOTE :
  '    Check Rows and Check Cols can be combined
  '    (in inner loop swap r and c, and repeat)
  '!!!!!!!!!!!!!!!!!!!!!
 
    'Check Rows
    For r = 0 To 8
      For i = 0 To 9
        numseen(i) = 0
      Next i
      For c = 0 To 8
        p = c + (r * 9)
        n = board[p]
        numseen(n) += 1
        If (numseen(n) > 1) AND (n <> 0) Then
          Return False
        End If
      Next c
    Next r
   
    'Check Cols
    For c = 0 To 8
      For i = 0 To 9
        numseen(i) = 0
      Next i
      For r = 0 To 8
        p = c + (r * 9)
        n = board[p]
        numseen(n) += 1
        If (numseen(n) > 1) AND (n <> 0) Then        
          Return False
        End If
      Next r      
    Next c
   
    'Check Boxes
    For b = 0 To 8
      For i = 0 To 9
        numseen(i) = 0
      Next i
      For y = 0 To 2
        For x = 0 To 2
          p = GetPos(x, y, b)
          n = board[p]
          numseen(n) += 1
          If (numseen(n) > 1) AND (n <> 0) Then
            Return False      
          End If
        Next x
      Next y
    Next b
    ' If we've got this far, it must be valid
    Return True
End Function

Function IsFull(board As uByte ptr) As Integer
  Dim i As Integer
    For i = 0 To 80
      If board[i] = 0 Then Return False
    Next i
    Return True
End Function

'-------------------------------------------------------------------------------
' Functions for safe logic solving

Function Solve_Rows(board As uByte ptr) As Integer
  Dim As Integer n, r, c, NumPotentials, NumSolved
  Dim As Integer px, py
    For n = 1 To 9
      For r = 0 To 8
        If NOT InRow(board, r, n) Then
          NumPotentials = 0
          For c = 0 To 8
            If board[c + (r * 9)] = 0 Then
              If NOT InCol(board, c, n) Then
                NumPotentials +=1
                px = c
                py = r
              End If
            End If
          Next c
          If NumPotentials = 1 Then
            If board[px + (py * 9)] = 0 Then
              NumSolved += 1              
              board[px + (py * 9)] = n
            End If
          End If
        End If
      Next r
    Next n
    Return NumSolved
End Function

Function Solve_Cols(board As uByte ptr) As Integer
  Dim As Integer n, r, c, NumPotentials, NumSolved
  Dim As Integer px, py
    For n = 1 To 9
      For c = 0 To 8
        If NOT InCol(board, c, n) Then
          NumPotentials = 0
          For r = 0 To 8
            If board[c + (r * 9)] = 0 Then
              If NOT InRow(board, r, n) Then
                NumPotentials += 1
                px = c
                py = r
              End If
            End If
          Next r
          If NumPotentials = 1 Then
            If board[px + (py * 9)] = 0 Then
              NumSolved += 1              
              board[px + (py * 9)] = n
            End If
          End If
        End If
      Next c
    Next n
    Return NumSolved
End Function

Function Solve_Boxes(board As uByte ptr) As Integer
  Dim As Integer n, b, x, y, r, c, NumPotentials, NumSolved
  Dim As Integer px, py
    For n = 1 To 9
      For b = 0 To 8
        If NOT InBox(board, b, n) Then
          NumPotentials = 0
          For y = 0 To 2
            For x = 0 To 2
              If Board[GetPos(x, y, b)] = 0 Then
                r = GetRow(x, y, b)
                c = GetCol(x, y, b)
                If (NOT InRow(board, r, n)) AND (NOT InCol(board, c, n)) Then
                  NumPotentials += 1
                  px = c
                  py = r
                End If
              End If
            Next x
          Next y
          If NumPotentials = 1 Then
            If board[px + (py * 9)] = 0 Then
              NumSolved += 1              
              board[px + (py * 9)] = n
            End If
          End If
        End If
      Next b
    Next n
    Return NumSolved
End Function

Sub Safe_Solve(board As uByte ptr)
  Dim As Integer q
    Do
      q = 0
      q += Solve_Rows(board)
      q += Solve_Cols(board)
      q += Solve_Boxes(board)
      If q = 0 Then Exit Do
    Loop
End Sub

' ---------------------------------------------------------------------------- '
' The main solving function, is recursive

Sub board_solve_inner(board_in As uByte ptr, board_out As uByte ptr, _
                      mode As Integer, NumSolutions As Integer)
  Dim candidates(81) As CANDIDATE_TYPE
  Dim num_candidates As Integer
  Dim As Integer i, b, y, x, r, c, n, lowest_prob, lowest_candidate
  Dim board_backup As uByte ptr
 
    Select Case mode
      Case 0
        If NumSolutions > 0 Then Exit Sub
      Case 1
        If NumSolutions > 1 Then Exit Sub
    End Select
 
    ' By performing this safe logical solve, we can often speed up execution
    Safe_Solve(board_in)
 
    If IsValid(board_in) AND IsFull(board_in) Then
      NumSolutions +=1
      memcpy(board_out, board_in, 81)
    End If
 
    If IsFull(board_in) Then Exit Sub
 
    ' work through board finding empty cells, and remembering the numbers that are
    ' valid in each cell.  This means we can then choose a cell with the lowest
    ' number of possibilities.
    lowest_prob = 9
   
    For b = 0 to 8
      For y = 0 To 2
        For x = 0 To 2
          r = GetRow(x, y, b)
          c = GetCol(x, y, b)
          If board_in[c + (r * 9)] = 0 Then
            candidates(num_candidates).x = x
            candidates(num_candidates).y = y
            candidates(num_candidates).b = b
            For n = 1 To 9
              If (NOT InRow(board_in, r, n)) AND _
                 (NOT InCol(board_in, c, n)) AND _
                 (NOT InBox(board_in, b, n)) Then
                candidates(num_candidates).possible_values(candidates(num_candidates).num_possible_values) = n
                candidates(num_candidates).num_possible_values += 1
              End If
            Next n
            If candidates(num_candidates).num_possible_values = 0 Then
              ' A 'bad' cell has been discovered, that cannot contain any number
              Exit Sub
            Else
              If lowest_prob > candidates(num_candidates).num_possible_values Then
                lowest_prob = candidates(num_candidates).num_possible_values
                lowest_candidate = num_candidates
              End If
            End If
            num_candidates += 1
          End If
        Next x
      Next y
    Next b
   
    ' Recurse with the new boards created by applying the possible values in turn
    ' to our chosen cell.
    For i = 1 To candidates(lowest_candidate).num_possible_values
      board_in[GetPos(candidates(lowest_candidate).x, _
                      candidates(lowest_candidate).y, _
                      candidates(lowest_candidate).b)] = _
                      candidates(lowest_candidate).possible_values(i - 1)
      board_backup = malloc(81)
      memcpy(board_backup, board_in, 81)
      board_solve_inner(board_in, board_out, mode, NumSolutions)
      memcpy(board_in, board_backup, 81)
      free(board_backup)
    Next i
End Sub

' ---------------------------------------------------------------------------- '
' The public sub that is called by program

Public Sub board_solve(board_in As uByte ptr, board_out As uByte ptr, _
                       mode As Integer, NumSolutions As Integer)
  Dim board_backup As uByte ptr

    NumSolutions = 0

    If NOT IsValid(board_in) Then Exit Sub
    If IsFull(board_in) Then Exit Sub
   
    board_backup = malloc(81)
    memcpy(board_backup, board_in, 81)    
    board_solve_inner(board_in, board_out, mode, NumSolutions)
    memcpy(board_in, board_backup, 81)
    free(board_backup)
End Sub

' ---------------------------------------------------------------------------- '
' Example usage
' ---------------------------------------------------------------------------- '

'------------
' Test boards

  ' 1905 SOLUTIONS (FROM WIKIPEDIA PAGE FOR SUDOKU)
  Dim TestBoard1(81) As uByte =  _
  { _
    5, 0, 6,  0, 2, 0,  9, 0, 3, _
    0, 0, 8,  0, 0, 0,  5, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
  _
    6, 0, 0,  2, 8, 5,  0, 0, 9, _
    0, 0, 0,  9, 0, 3,  0, 0, 0, _
    8, 0, 0,  7, 6, 1,  0, 0, 4, _
  _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 4,  0, 0, 0,  3, 0, 0, _
    2, 0, 1,  0, 5, 0,  6, 0, 7  _
  }
 
  ' NO SOLUTIONS
  Dim TestBoard2(81) As uByte =  _
  { _
    0, 1, 0,  0, 0, 0,  0, 0, 0, _
    0, 2, 0,  0, 0, 0,  0, 0, 0, _
    0, 3, 0,  0, 0, 0,  0, 0, 0, _
  _
    0, 4, 0,  0, 0, 0,  0, 0, 0, _
    0, 5, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
  _
    0, 0, 0,  0, 0, 6,  7, 8, 9, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0  _
  }
 
  ' 1 SOLUTIONS
  Dim TestBoard3(81) As uByte =  _
  { _
    0, 0, 5,  0, 8, 0,  0, 0, 7, _
    0, 8, 7,  0, 0, 0,  0, 0, 0, _
    9, 0, 2,  1, 0, 0,  0, 8, 0, _
  _
    0, 0, 9,  0, 0, 4,  8, 1, 0, _
    0, 2, 6,  8, 9, 0,  0, 0, 0, _
    8, 0, 3,  0, 0, 0,  6, 7, 9, _
  _
    0, 0, 4,  7, 1, 8,  2, 9, 0, _
    0, 0, 8,  0, 0, 0,  7, 0, 1, _
    0, 0, 1,  3, 0, 0,  4, 6, 8  _
  }

  ' O SOLUTIONs - Slow
  Dim TestBoard4(81) As uByte =  _
  { _
    1, 0, 0,  2, 0, 0,  3, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 2,  0, 0, 4,  0, 9, 0, _
  _
    3, 0, 0,  1, 0, 0,  2, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 9, 4,  0, 0, 2,  0, 0, 0, _
  _
    2, 0, 0,  3, 0, 0,  1, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 0,  0, 9, 0,  0, 0, 4  _
  }

' -----------------------------------
' Sub that PRINT's a board to console
 
  Sub Board_Print(board As uByte ptr)
    Dim As Integer x, y, v
      Cls
      For y = 0 To 8
        For x = 0 To 8
          If (x mod 3 = 0) AND (x <> 0) Then Print " ";
          v = board[x + (y * 9)]
          If v <> 0 Then
            Print Str(v);
          Else
            Print "-";
          End If
        Next x
        Print
        If (y + 1) mod 3 = 0 Then Print
      Next y
  End Sub

' ---------------------------------------------------------------------------- '
' Main example code
' ---------------------------------------------------------------------------- '

  Dim NumSolutions As Integer ' Is passed to board_solve, when board_solve
                              ' returns, will contain the number of solutions.
                              ' This depends on the mode chosen.
                             
  Dim board_out(81) As ubyte  ' A buffer that is passed to board_solve, when
                              ' board_solvereturns, will contain the last found
                              ' valid boardor will be unmodified if there are no
                              ' solutions
                             
  Dim t As Double             ' For clocking the time taken

    t = Timer ' Start Time
      ' MAIN CALL HERE!
      ' board_solve is *the* sub
      ' The first argument is a pointer to an array of 81 uBytes, that makes up
      '   the board.
      ' The second argument is a pointer to an array of 81 uBytes, that will be
      '   filled with the completed board, or unmodified if no solutions
      ' The third argument sets the mode.  
      '   0 will just find the first solved board
      '   1 will find the first two solutions, therefore this can be used to
      '     check if a board is valid (only one solution)
      '   2 will look for all possible solutions.  This can be very slow on
      '     some inputs, so should be used with care.
      ' The forth argument is an Integer, that will contain the number of
      '   possible solutions when board_solve returns.
      board_solve(@TestBoard3(0), @board_out(0), 0, NumSolutions)
    t = Timer - t ' Total Time
   
    Board_Print(@board_out(0)) ' Show solution
   
    Print NumSolutions & " Solutions"
    Print Int(t * 1000) & "ms"
   
    Sleep
   


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 21, 2006, 12:17:45 PM
Gotta start somewhere.  :king:

Now try to implement a decision tree...


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 22, 2006, 12:15:20 PM
could you explain a little of the theory behind your method agamenmnus? i've been working on a more effective method than the random one i posted, but it has seemed to get too complex so i'm sure i must be doing something wrong.


Title: Make a solver for Su Doku in freebasic.
Post by: Xerol on January 22, 2006, 06:04:51 PM
I've been meaning to write one eventually, but here's the general idea I had:

1) Check all cells for "possible numbers". So take every non-filled cell. Check the row, column, and box for placed numbers, and eliminate those. If there's only 1 number left, it has to go in there.
2) Check each row for each number - if only 1 box can have a number, it has to go there.
3) Repeat #2 for each column & box.

Every time a number is found, start over from the beginning(for speed - usually filling a cell allows another cell to be filled easily, and step 1 is the "quickest" one to check).

I'm pretty sure all properly constructed sudokus can be solved this way. However, lately I've been seeing some that haven't "met the rules" and require a guess at some point or another(a properly constructed one should never require a guess).


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 23, 2006, 11:56:36 AM
Right, you must consider how to structure your tree such that the decisions that it makes are reversible (so you don't get stuck) in all cases, and that it fully implements the rules of the game in the decision.

A basic decision tree is as follows:

1) Considering the rules of the game, determine all the possible moves that you can make in time t. (t would be the smallest decision you can make: in this case, placing a number on a sudoku matrix) Note the number of moves you can make c. In this case your move amount is stored in, for instance, possible%(t).

2) Make your move, starting with the Nth decision (out of c decisions in the time frame). N is initially equal to 0. (Just set your array for decisions, decision%(t) to all 0's before starting the search...) Add one to decision%(t) to record this and set t = t + 1.

2b) Before you actually do anything in 2, if you are already at your maximum amount of moves (you've tried the last move already), you must set t = t - 1.

3) Update your Sudoku matrix (or game information) to reflect the new move.

4) Check if you have reached your goal. If you have, end. If you haven't, go back to (1).



The only problems with this method in solving a problem are:
1) It may take a long time to loop through all the possibilities. You can use a smarter move making decision function to narrow the possibilities. (less moves per round = faster solution)
2) For this to finish in a finite amount of time (ie: so it isn't an infinite loop), each set of choices you make must be determined in the same order as any other choice. And also the choices cannot be such that you encounter the same set in two decision trees, otherwise you will start looping. (Consider adding a function to remove a piece instead of adding it -- you will get a constant loop)



I hope this helps a bit.


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 23, 2006, 11:56:49 AM
thanks xerol but i've got that far.  pure logic is used mainly on beginner and intermediate sudokus.  Advanced sudokus however force the player to use an extra level or two of imagination, which means a different method is needed.

here's an example of an advanced puzzle.

{ _
  0, 0, 5,  0, 8, 0,  0, 0, 7, _
  0, 8, 7,  0, 0, 0,  0, 0, 0, _
  9, 0, 2,  1, 0, 0,  0, 8, 0, _
_
  0, 0, 9,  0, 0, 4,  8, 1, 0, _
  0, 2, 6,  8, 9, 0,  0, 0, 0, _
  8, 0, 3,  0, 0, 0,  6, 7, 9, _
_
  0, 0, 4,  7, 1, 8,  2, 9, 0, _
  0, 0, 8,  0, 0, 0,  7, 0, 1, _
  0, 0, 1,  3, 0, 0,  4, 6, 8  _
}

There will come points in this puzzle where a number could be valid in two or more positions, and that is the part i am having trouble with.  This is valid in sudoku and is kind of the whole point because it stretchs your brain, testing possibilities.

Agamemnus:  i made a recursive tree version, but it seems to be slower than my random version, so i must be doing something wrong.


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 23, 2006, 12:59:07 PM
i finally got it working (re-posted above) now i just need to clean it up a bit, and give it a good testing.

have you had any thought on how to check if there is more than one solution?  i guess i would just leave it running after it has discovered the solution and see what happens, but i haven't tried it yet.


Title: Make a solver for Su Doku in freebasic.
Post by: Xerol on January 23, 2006, 07:59:47 PM
The way I see it, there's various "depth levels" of logic needed. Quick examples:

Level 0 - It's the only number that can fit in that cell:

Code:

1 2 3
4 6 7
8 X 9


The X has to be 5. This is oversimplified but almost every puzzle has a few of those in it to begin with.

Level 1 - It's the only place in a row, column, or box where that number can go:

Code:

2 7 3 | 1 6 8 | 4 5 X


Once again, oversimplified case but the X has to be a 9.

Level 2 - Indirect elimination of cells.

Code:

1 2 3 | 4 X Y | 5 Z W
5 6 9 | 2 3 7 | 1 4 8
4 7 8 | 1 5 R | 2 3 9


This is really oversimplified but it gets the point across. The 6 in row 1 has to be in Z or W, so it can't be in X or Y. Therefore, R has to be a 6.

It's possible to get even deeper with this, too, but I just got up so I don't feel like coming up with examples.


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 24, 2006, 02:37:56 AM
I did some more work on my one (code posted a few threads up)

Now it seems to solve all puzzles, and can determine if it is a fully valid sudoku (having only one valid solution).  I've nearly got it working on 4x4 sudokus (Cell Values 0-F) aswell, but havent posted that yet as its even more spaghetti at the moment.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 25, 2006, 11:15:32 PM
Quote from: "Xerol"
The way I see it, there's various "depth levels" of logic needed.


Indeed the case I think. It's just a mathematical problem with one extremely efficient yet not obvious solution.


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 26, 2006, 06:43:18 AM
Do you mean Donald Knuths Dancing Links Algorithm?  I've been looking into this, but am wondering if i can use it in the case where i want to work out the number of possible solutions?  I don't really understand it yet, and on the wikipedia page for DLX it says its a brute force algorithm, so i don't see yet how it will be faster than the brute force system i currently employ.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 29, 2006, 01:41:50 AM
I don't mean any brute force algorithm. A brute force algorithm, by definition, attempts all paths given the ruleset as a way to create paths. The efficient solution will solve the problem in the smallest amount of steps possible given the current state of the puzzle....


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 29, 2006, 08:26:54 AM
What is the best way then? is it DLX as mooted by wikipedia?

it says ... is a recursive, nondeterministic, depth-first, brute-force algorithm

If i implement the noted improvement in my code to search for the next cell with the lowest probability, rather than just the next empty cell, surely this would be just as quick?


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 29, 2006, 08:54:33 PM
Well I think it uses some set of derived constraints based on the rules, while the first brute-force algorithm ignores any logic until it's apparent that a new positioning of a number violates the rules. If my vague understanding of this algorithm is correct, I would not call the "Dancing Links" algorithm a brute force algorithm (even though that's what it says..).

EDIT1:
Quote

What is the best way then? is it DLX as mooted by wikipedia?


Probably.

Quote

If i implement the noted improvement in my code to search for the next cell with the lowest probability, rather than just the next empty cell, surely this would be just as quick?


I have no idea, but make sure to keep the choices always the same on each search level.

EDIT2:
Did you edit your post just now?  :???:

EDIT3:
http://spivey.oriel.ox.ac.uk/mike/comp2005/results.html (another link from Wikipedia)


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 29, 2006, 11:48:22 PM
thanks for the link.  Its a shame they dont include the submitted programs, i would of liked to see them.

no i didnt edit my post.

after reading more about dancing links, i think that is bascially what i have coded.

the constraints are checked for, by looking to see whether a number is valid in a given cell.  Also i use backtracking, which is where the name 'dancing links' apparently come from.  The only part i guess that isnt't DLX is the fact i don't look for the first cell with the least number of possible numbers, but that is something i noted in the code and will be trivial for me to implement.

I would though agree with wiki that it is brute force, as you do have to check every possible combination until you find the result (albeit within the constraints of the game)

EDIT : just found this page which has knuths papers available for d/l

http://www-cs-faculty.stanford.edu/~knuth/preprints.html

EDIT 2 : reading more about boolean matrix stuff makes me think i'm not doing it that way...

anyhow this puzzle from the page you posted was particually useful to me

Code:
 Dim TestBoard01(81) As Integer = _
  { _
    0, 1, 0,  0, 0, 0,  0, 0, 0, _
    0, 2, 0,  0, 0, 0,  0, 0, 0, _
    0, 3, 0,  0, 0, 0,  0, 0, 0, _
  _
    0, 4, 0,  0, 0, 0,  0, 0, 0, _
    0, 5, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
  _
    0, 0, 0,  0, 0, 6,  7, 8, 9, _
    0, 0, 0,  0, 0, 0,  0, 0, 0, _
    0, 0, 0,  0, 0, 0,  0, 0, 0  _
  }


my code did not used to look for this kind of problem, so would keep searching until all possibilitys were exhausted.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 30, 2006, 07:39:49 PM
Well, I dunno. If it (Dancing Links) is brute force, what's the real efficiency/speed difference between Dancing Links and the initial brute force algorithm mentioned earlier?


I'm guessing that the puzzle you posted is an unsolvable one.... I don't see any immediate contradictions... are they there? Anyway, finding out if a puzzle is unsolvable is probably as fast as finding the solution..


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 30, 2006, 08:51:44 PM
the problem with that puzzle is that the cell two below the 5 has no answer, because all the numbers are visible to it either by col, or row.  A fairly trivial problem, but it caused my program to fail, because i wasn't checking if cells have no solution, only looking at what solutions a cell does have, if you get my meaning.

I'm pretty sure i've got my solving engine done now, i'm just struggling to get gfxlib to work correctly on lin/dos so i can do a nice graphical version.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 31, 2006, 12:38:30 AM
Yeah ok, but I still don't see it.


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on January 31, 2006, 04:18:48 AM
if you count the top left as (0, 0), then the cell at (1, 6) cannot contain any number.  This is because 1, 2, 3, 4 and 5 are visible in column 1,  and 6, 7, 8, and 9 are visible in row 6.  Therefore there are no numbers left that are valid in that square.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on January 31, 2006, 12:53:53 PM
I see it.  8)


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on February 01, 2006, 12:42:12 AM
I just updated to what i believe will be my final code (unless someone finds a fault)

I also have a beta of my graphical interface version, it works fine, but the interface just could be better.

http://www.streetcds.co.uk/sudoku_v0.4.zip

EDIT : board in was sometimes being returned changed, added backup

also found this sudoku

100200300
000000000
002004090
300100200
000000000
094002000
200300100
000000000
000090004

takes 19 seconds (very slow) to prove unsolvable


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on February 02, 2006, 05:10:47 PM
That is cool.


Title: Make a solver for Su Doku in freebasic.
Post by: Agamemnus on February 05, 2006, 12:42:47 AM
PS: I added your name (yetifoot) in the first post... :-)


Title: Make a solver for Su Doku in freebasic.
Post by: yetifoot on February 05, 2006, 04:12:08 AM
thanks.


Title: Make a solver for Su Doku in freebasic.
Post by: anarky on February 13, 2006, 03:46:14 AM
I am going to make a GUI for it too. I found this to be very useful, especially for Beckii, who enters competitions, and Sudoku happens to be one of these puzzles.

>anarky