CB Repository

// 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