Sudokun ratkaisu

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
User avatar
KilledWhale
Tech Developer
Tech Developer
Posts:543
Joined:Sun Aug 26, 2007 2:43 pm
Location:Liminka
Sudokun ratkaisu

Post by KilledWhale » Sat Nov 06, 2010 11:08 pm

Lentomatkalla Maltalle kirjoittelin ajankuluksi sudokuratkaisimen C++:lla ja päätin kääntää sen CoolBasicille teidän ihmeteltäväksenne.
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

CoolBasic henkilökuntaa
Kehittäjä

cbFUN Kello
cbSDL
Whale.dy.fi

<@cce> miltäs tuntuu olla suomen paras

Post Reply