NewsForumsCodeLogsGallerySpecsSearch

Code archives/Algorithms/Sudoku solver

This code has been declared by its author to be Public Domain code.

Download source code

Sudoku solver by bytecode772008
This is a sudoku solver. I've written it in ~45 minutes and now here it is. have fun :)

replace
Select 1
with
Select 2
to see slow motion!

Please use this level file:
Level1.txt:
53..7....
6..195...
.98....6.
8...6...3
4..8.3..1
7...2...6
.6....28.
...419..5
....8..79
Graphics 900, 900, 32, 2
SetBuffer BackBuffer()
AppTitle "Sudoku solver"
SetFont LoadFont("Arial Black", 90, True)

Dim Grid(9, 9), Pos(9, 9, 9)
LoadLevel("Level1.txt")

Select 1 ;<========== set to '2' to see slow motion!
	Case 1
		ms = MilliSecs()
		Repeat
			UpdatePos()
			ApplyPos()
		Until IsSolved()
		ms = MilliSecs() - ms
		AppTitle "SOLVED in " + ms + " ms."
		DrawLevel()
	Case 2
		Repeat
			Cls
			DrawLevel()
			UpdatePos()
			ApplyPos()
			Delay 300
		Until IsSolved()
		AppTitle "SOLVED."
		DrawLevel()
End Select

WaitKey()
End

Function LoadLevel(path$)
file = ReadFile(path$)
For y = 1 To 9
	l$ = ReadLine(file)
	For x = 1 To 9
		Grid(x, y) = Mid(l$, x, 1)
		For i = 1 To 9
			Pos(x, y, i) = True
		Next
	Next
Next
CloseFile file
End Function

Function DrawLevel()
Cls
Color 255, 255, 255
For x = 1 To 9
	For y = 1 To 9
		ch$ = Grid(x, y)
		If ch$ = 0 Then ch$ = " "
		Text x * 90 - 30, y * 90 - 30, ch$
	Next
Next
Color 127, 127, 127
For x = 0 To 2
	For y = 0 To 2
		Rect 40 + x * 270, 55 + y * 270, 271, 271, False
	Next
Next
Flip 0
End Function

Function UpdatePos()
;Rows
For y = 1 To 9
	For x = 1 To 9
		For i = 1 To 9
			If Grid(i, y) Then
				Pos(x, y, Grid(i, y)) = False
			EndIf
		Next
	Next
Next
;Cols
For x = 1 To 9
	For y = 1 To 9
		For i = 1 To 9
			If Grid(x, i) Then
				Pos(x, y, Grid(x, i)) = False
			EndIf
		Next
	Next
Next
;Fields
For y = 1 To 9
	Select y
		Case 1, 2, 3: fy = 1
		Case 4, 5, 6: fy = 4
		Case 7, 8, 9: fy = 7
	End Select
	For x = 1 To 9
		Select x
			Case 1, 2, 3: fx = 1
			Case 4, 5, 6: fx = 4
			Case 7, 8, 9: fx = 7
		End Select
		For i = fx To fx + 2
			For a = fy To fy + 2
				If Grid(i, a) Then
					Pos(x, y, Grid(i, a)) = False
				EndIf
			Next
		Next
	Next
Next
End Function

Function ApplyPos()
For x = 1 To 9
	For y = 1 To 9
		cnt = 0
		For i = 1 To 9
			If Pos(x, y, i) Then
				cnt = cnt + 1
				res = i
			EndIf
		Next
		If cnt = 1 And Grid(x, y) = 0 Then
			Grid(x, y) = res
		EndIf
	Next
Next
End Function

Function IsSolved()
For x = 1 To 9
	For y = 1 To 9
		If Grid(x, y) = 0 Then Return False
	Next
Next
Return True
End Function

Comments

GIB3D2008
MWAHAHAHA

I have crippled your Sudoku answerer with this Challenger diffuclty sudoku puzzle that I got out of "Dell Original Sudoku" book

...1..8.6
.8...2.1.
3.1.6....
8.39...5.
4...7...8
.2...81.9
....1.4.2
.9.3...7.
1.5..4...


;) I guess I'm not the only one completely confused at how to complete some of the harder sudoku puzzles


bytecode772008
i guess your one is where i have to guess in some cases. my program is simple and just makes an entry if its clearly


Nate the Great2008
lol I think it should only count as a sudoku if it can be solved by pure logic no guessing involved


Subirenihil2009
My solver solved it (yes, it is a logical sudoku solver)

I'm considering whether to post my solver or not.

My program even writes out a *.txt file telling the order it filled in the spaces. (It leaves it up to you to figure out how it could tell that that is the correct number)

lol I think it should only count as a sudoku if it can be solved by pure logic no guessing involved
Very true. If you look at the star ratings for the puzzles 1-5 star puzzles are solvable by logic, 6 star puzzles have guesswork.

P.S. I refuse to do anything less than a 4 star (and I don't do 4 stars much either) - they're too easy :P


Warpy2009
Guesswork would either mean the problem is undecidable (unlikely), or there are multiple solutions, which I think would make a puzzle easier...


TaskMaster2009
I made a brute force solver a while back. It just starts at the first empty square checks if a 1 fits, if so, moves to the next square, checks if a one fits, if not place a 2, etc. If it gets to nine and it doesn't fit, it backs up one square and increments it.

It was actually quite fun to watch it work, as it would get nearly done, find a out that the entire combination didn't work and go all the way back to one of the first few empty squares and start over. Almost felt sorry for it when that happened. :)


Nate the Great2009
@ taskmaster - sometimes you just have to feel sorry for poor programs like that even though they really dont have feelings, it seems like such a downer for it to start over on something it worked so hard on.


Chroma2009
I'm pretty sure a true Sudoku only has one solution.


Code Archives Forum