Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Make a solver for Su Doku in freebasic.
#11
Quote:It's in FreeBasic, and can solve Su Doku's.

Very impressive.
Reply
#12
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
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Reply
#13
format your code for once in your life !! XD !!
Reply
#14
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?
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Reply
#15
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
EVEN MEN OF STEEL RUST.
[Image: chav.gif]
Reply
#16
Gotta start somewhere. :king:

Now try to implement a decision tree...
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Reply
#17
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.
EVEN MEN OF STEEL RUST.
[Image: chav.gif]
Reply
#18
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).
url=http://www.lggaming.com/user/xerol/songs/recycled]Recycled CompoST[/url] - Best of 2005 Album by Xerol.
Reply
#19
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.
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Reply
#20
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.
EVEN MEN OF STEEL RUST.
[Image: chav.gif]
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)