Login Register
Frontpage Code library Pastebin

Sudoku solver

Author: KilledWhale
Added: 9.4.2011 21:30
Edited: 15.4.2011 22:19
Category: Algoritmi

Description

Valikoivaan bruteforceen perustuva sudokuratkaisin. Ratkaisee kohtuu haastavatkin sudokut alle minuuttiin :)

Code

Select all
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
// Sudokuratkaisin by Jasse 'KilledWhale' Lahdenperä
// 6.11.2010
//
// Optimointia
// - "Varmojen kohtien eliminointi" poistettu 7.11.2010

Dim grid(8, 8) As Integer
Dim cands(8, 8, 9) As Integer
Dim g(8) As String

g(0) = "0,0,0,0,0,0,0,0,0"
g(1) = "0,0,0,0,0,3,0,8,5"
g(2) = "0,0,1,0,2,0,0,0,0"
g(3) = "0,0,0,5,0,7,0,0,0"
g(4) = "0,0,4,0,0,0,1,0,0"
g(5) = "0,9,0,0,0,0,0,0,0"
g(6) = "5,0,0,0,0,0,0,7,3"
g(8) = "0,0,0,0,4,0,0,0,9"

For y = 0 To 8
	For x = 0 To 8
	  grid(x, y) = Int(GetWord(g(y), x + 1, ","))
	  If grid(x, y) <> 0 Then
		 AddCands(x, y, grid(x, y) - 1) // Laitettessa luku tauluun ON päivitettävä myös kanditaattilistoja
	  EndIf
	Next x
Next y

alku = Timer()
If SolveGrid() Then
	Text 0, 0, "Solving took: " + (Timer() - alku) / 1000.0 + " seconds!"
	For x = 0 To 8
	  For y = 0 To 8
		 Text x * 15, 25 + y * 15, grid(x, y)
	  Next y
	Next x
Else
	Text 0, 0, "Failed To solve"
EndIf

DrawScreen
WaitKey

// Merkitsee numeron pois ehdokaslistoilta
Function AddCands(x, y, i)
	For q = 0 To 8 // Käydään läpi pystyrivi, vaakarivi
	  cands(x, q, i) = cands(x, q, i) + 1
	  cands(q, y, i) = cands(q, y, i) + 1
	Next q
	sx = (x / 3) * 3
	sy = (y / 3) * 3
	ex = sx + 2
	ey = sy + 2
	
	// Käydään läpi laatikko
	For x = sx To ex
	  For y = sy To ey
		 cands(x, y, i) = cands(x, y, i) + 1
	  Next y
	Next x
EndFunction

// Merkitsee numeron takaisin ehdokaslistoille
Function DecCands(x, y, i)
	For q = 0 To 8 // Käydään läpi pystyrivi, vaakarivi
	  cands(x, q, i) = cands(x, q, i) - 1
	  cands(q, y, i) = cands(q, y, i) - 1
	Next q
	sx = (x / 3) * 3
	sy = (y / 3) * 3
	ex = sx + 2
	ey = sy + 2
	
	// Käydään läpi laatikko
	For x = sx To ex
	  For y = sy To ey
		 cands(x, y, i) = cands(x, y, i) - 1
	  Next y
	Next x	
EndFunction

// Rekursiivinen ratkaisija
// Kokeilee karsittuja vaihtoehtoja järjestyksessä
Function Solve(x, y)
	If grid(x, y) // Jos ruudussa ON jotain
	  If x < 8 Then
		 Return Solve(x + 1, y) // Hypätään askel oikealle
	  Else
		 If y = 8 Then
			Return True
		 EndIf
		 Return Solve(0, y + 1) // Hypätään seuraavan rivin alkuun
	  EndIf
	EndIf
	If x = 8 And y = 8 Then // Kulma
	  For i = 0 To 8 // Tarkistetaan löytyykö kelpaavaa numeroa
		 If cands(x, y, i) = 0 Then // Löytyi, ristikko ratkaistu
			grid(x, y) = i + 1
			Return True
		 EndIf
	  Next i
	EndIf
	For i = 0 To 8 // Etsitään sopivaa ehdokasta
	  If cands(x, y, i) = 0 Then // Löytyi
		 grid(x, y) = i + 1 // Merkataan ehdokas paikalleen
		 AddCands(x, y, i) // Päivitetään ehdokaslista
		 If x < 8 Then
			If Solve(x + 1, y) Then // Hypätään askel oikealle
				Return True
			EndIf
		 Else
			If Solve(0, y + 1) Then // Hypätään seuraavan rivin alkuun
				Return True
			EndIf
		 EndIf
		 DecCands(x, y, i) // Ehdokas ei kelvannut, poistetetaan se ehdokaslistalta ja siirrytään seuraavaan
	  EndIf
	Next i
	
	// Mikään luku ei kelvannut, palautetaan epäonnistuminen
	grid(x, y) = 0
	Return False
EndFunction

// Ratkaisufunktio
// Hakee ensin varmat vaihtoehdot ja käskee sitten kokeiluratkaisijan etsintään
Function SolveGrid()
	Return Solve(0, 0)
EndFunction

Comments

No comments. You can be first!

Leave a comment

You must be logged in to comment.