Code archives/Algorithms/Sudoku solver
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
This is a sudoku solver. I've written it in ~45 minutes and now here it is. have fun :) replace Select 1with Select 2to 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
| ||
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 |
| ||
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 |
| ||
lol I think it should only count as a sudoku if it can be solved by pure logic no guessing involved |
| ||
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 |
| ||
Guesswork would either mean the problem is undecidable (unlikely), or there are multiple solutions, which I think would make a puzzle easier... |
| ||
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. :) |
| ||
@ 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. |
| ||
I'm pretty sure a true Sudoku only has one solution. |
Code Archives Forum