Koodia olen tavoistani poiketen kommentoinut hieman, jotta siitä saisi jotain selkoa.
Ratkaisun alussa ohjelma pyrkii seulomaan pois kaikki 'varmat' vaihtoehdot ja lähtee sen jälkeen rankkaan kokeilu-urakkaan.
Käytännössä homma hoidetaan kokeilemalla erilaisia vaihtoehtoja järjestyksessä, mutta kokeiluita on karsittu huomattavasti ehdokaslistojen avulla.
Tapa ei ole missään nimessä paras tai ainot, mutta se sattui olemaan helpoimmasta päästä toteuttaa ja nopeus riittää itselleni mainiosti.
Ratkaisunopeus riippuu pitkälti tiedettyjen numeroiden paikoista ja sijainneista sekä muun muassa Jupiterin asennosta maahan nähden.
Myös C++ version voin laittaa, jos joku tahtoo.
Koodia voi hyödyntää esimerkiksi sudokugeneraattorissa.
Tällöin olisi hyvä lätkiä satunnaisia numeroita ruudukkoon pitäen huolta että ne ovat oikeaoppisesti sijoiteltuja (ratkaisija ei tarkista tätä), täyttämällä esimerkiksi ensimmäinen (tai jokin muu) rivi numeroilla 1-9 jossain järjestyksessä ja kutsumalla sitten SolveGridiä().
Siitä sitten kaikki sudokupelejä tekemään!
EDIT:
Systeemiä optimoitu reilusti
Code: Select all
// 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