Appunti di Programmazione
Creiamo una griglia Sudoku
Mi piacciono i Sudoku e ho pensato di creare un piccolo programma che mi consentisse di giocare con questo rompicapo.
Usando Visual Basic 2008 Express ho scritto questo codice che permette di generare una griglia di gioco completa in pochi millesimi di secondo, usando la tecnica del Back-Tracking. Successivamente è sufficiente applicare lo schema di gioco scelto e si può iniziare a giocare.
In questa pagina allego soltanto il codice che genera una soluzione completa.
Public Class Form1
'casella di testo dove stampare la griglia finita
Dim txtLavagna As New TextBox
'array che contiene i valori della griglia
Dim cCasella(0 To 80) As String
'array booleano per controllare se una casella è già stata variata o meno
Dim cCasellaFlag(0 To 80) As Boolean
'array che contiene l';elenco delle cifre che possono stare in ogni singola casella
Dim c(0 To 80) As String
'array che contiene l'elenco delle celle, compresi i doppioni, che sono collegate alla cella corrente
Dim celleDaVariare(0 To 26) As Integer
'array che contiene le 20 celle che sono collegate alla cella corrente, escluso i doppioni
Dim listaCelle(0 To 20) As Integer
'indice delle cella in corso di variazione
Dim indiceCella As Integer
'numero che viene inserito nella casella durante la creazione della griglia
Dim n As String = ""
'timer
Dim sw As New Stopwatch
Public Sub New()
InitializeComponent()
'titolo della Form
Me.Text = "Crea Griglia Sudoku"
'inizializzazione della casella di testo
txtLavagna.Multiline = True
txtLavagna.TextAlign = HorizontalAlignment.Center
txtLavagna.Dock = DockStyle.Fill
txtLavagna.Font = New Font("Arial", 14, FontStyle.Bold)
'inizializzazione del contenuto della griglia e i suoi flag
For i As Integer = 0 To 80
cCasella(i) = "1 2 3 4 5 6 7 8 9"
cCasellaFlag(i) = False
Next
'indice cella iniziale
indiceCella = 0
'inserimento della casella di testo nella form
Me.Controls.Add(txtLavagna)
'inizio cronometraggio
sw.Start()
Genera()
ScriviSudoku()
Visualizza()
End Sub
'Sub che crea la prima riga orizzontale
Private Sub Genera()
Randomize()
'array per controllare che i numeri non vengano ripetuti
Dim chkCifra(0 To 8) As Integer
'flag per controllare se la riga è stata completata
Dim chk As Boolean = False
'valore da inserire nella casella
Dim valore As Integer
Do
'Si estrae un numero 1-9 e lo si memorizza
valore = CInt(Int((9 * Rnd()) + 1))
'se la cifra è già uscita...
If chkCifra(valore - 1) <> 0 Then
'si pone a True il flag,
chk = True
'si scorre l';elenco delle 9 cifre per controllare se sono già uscite tutte,
For j As Integer = 0 To 8
'se una delle cifre non risulta ancora uscita si pone il flag a False.
If chkCifra(j) = 0 Then chk = False
Next
'altrimenti se la cifra NON è ancora uscita...
Else
'si aggiorna l';array
chkCifra(valore - 1) = valore
'si inserisce il valore nell'array delle caselle
cCasella(indiceCella) = valore.ToString
'si inserisce il valore nell';array che contiene le cifre che possono stare in quella casella
c(indiceCella) = valore.ToString
'si aggiorna il flag della cella
cCasellaFlag(indiceCella) = True
'si calcolano le celle che sono collegate a quella appena variata
CalcolaCelle(indiceCella)
'e si aggiorna il contenuto
AggiornaCelle(indiceCella, valore.ToString)
'si incrementa l';indice passando a quello successivo
indiceCella += 1
End If
'si esce dal ciclo quando tutte le celle ( dalla 0 alla 8) sono state riempite chkCifra(0-8)=True
Loop Until chk = True
End Sub
Private Sub ScriviSudoku()
'si genera una griglia completa di Sudoku usando la tecnica del BackTracking.
'a questo punto del gioco tutte le caselle hanno ognuna una lista di cifre che possono stare
'in quella particolare posizione.
'se l';indice della cella supera l';ultima casella si esce dalla sub
If indiceCella > 80 Then
Exit Sub
End If
'si copia il contenuto
c(indiceCella) = cCasella(indiceCella)
'se la cella NON È VUOTA...
If c(indiceCella).Trim <> "" Then
'si scorre la lista dei numeri possibili,
For Each k As Char In c(indiceCella)
'si sceglie il primo che capita,
If k = "1" OrElse k = "2" OrElse k = "3" OrElse k = "4" OrElse k = "5" OrElse k = "6" _
OrElse k = "7" OrElse k = "8" OrElse k = "9" Then
'lo si memorizza,
n = k
'e si esce dal ciclo.
Exit For
End If
Next
'si contrassegna questa casella come "aggionata",
cCasellaFlag(indiceCella) = True
'si inserisce il valore scelto nell';array,
cCasella(indiceCella) = n
'si calcolano tutte le celle che sono collegate con essa,
CalcolaCelle(indiceCella)
'se ne aggiorna il contenuto,
AggiornaCelle(indiceCella, n)
'si incrementa l';indice della cella per valutare quella successiva
indiceCella += 1
'si richiama la sub per ripetere il procedimento sulla cella seguente.
ScriviSudoku()
'altrimenti, se la cella è VUOTA:
Else
'si decrementa di una posizione l';indice della casella da valutare,
indiceCella -= 1
'se ne recupara il valore contenuto,
n = cCasella(indiceCella)
'si contrassegna la casella come "da valutare",
cCasellaFlag(indiceCella) = False
'si ripristina il contenuto della cella,
Ripristina(indiceCella)
'e dall';elenco dei valori possibili che possono stare nella casella, si toglie quello che avevamo appena provato,
'visto che ci aveva condotto ad un punto morto.
c(indiceCella) = c(indiceCella).Replace(n, "")
'si inseriscono i nuovi possibili valori nell';array,
cCasella(indiceCella) = c(indiceCella)
'e si richiama la sub per ripetere il procedimento
ScriviSudoku()
End If
End Sub
Private Sub Visualizza()
'attraverso due cicli si stampa, riga per riga, il risultato della griglia di gioco
For i As Integer = 0 To 8
For j As Integer = 0 To 8
txtLavagna.Text += cCasella(i * 9 + j) + " "
Next
txtLavagna.Text += Environment.NewLine
Next
'e il tempo necessario alla sua creazione.
txtLavagna.Text += Environment.NewLine + (sw.ElapsedMilliseconds.ToString) + " millisecondi"
End Sub
'la sub permette di ripristinare tutti i valori possibili che possono stare in una determinata casella
Private Sub Ripristina(ByVal indix As Integer)
'valori possibili
Dim valori As String = "1 2 3 4 5 6 7 8 9"
'si calcola le celle collegate
CalcolaCelle(indix)
'si cicla su tutte le celle che sono fra loro collegate con quella di riferimento, per ripristinare tutti
'i valori possibili che hanno ragione di essere.
For i As Integer = 0 To 20
'se la cella contiene un valore e il suo indice è diverso da quello delle cella di riferimento...
If cCasellaFlag(listaCelle(i)) = True AndAlso listaCelle(i) <> indix Then
'si elimina il valore
'in pratica nella stringa "valori" vengono raccolte tutte quelle cifre che possono stare nella casella di riferimento
valori = valori.Replace(cCasella(listaCelle(i)), "")
End If
Next
'si inseriscono tutti i valori nella casella corrispondente,
cCasella(indix) = valori
'si ripete il ragionamento precedente per tutte le altre celle, quelle cioè collegate alla casella di riferimento.
'si copia la liste delle celle collegate con la principale...
Dim listaPrincipale() As Integer = DirectCast(listaCelle.Clone, Integer())
'e il suo indice...
Dim indicePrincipale As Integer = indix
'si effettua il ciclo su tutte e 21 le caselle escludendo quella principale
For i As Integer = 0 To 20
'si recupera l';indice della prima casella della lista,
indix = listaPrincipale(i)
'si calcola la lista delle caselle ad essa collegate,
CalcolaCelle(indix)
'si inizializza la variabile valori,
valori = "1 2 3 4 5 6 7 8 9"
'e come prima si controlla se la casella in corso di esamina è stata aggiornata,
If cCasellaFlag(indix) = False Then
'si scorre tutto l';elenco delle sue caselle collegate per capire quali valori può contenere
For j As Integer = 0 To 20
'se la casella è stata aggiornata e non corrisponde alla casella in esame né a quella principale...
If cCasellaFlag(listaCelle(j)) = True AndAlso listaCelle(j) <> indix AndAlso _
listaCelle(j) <> indicePrincipale Then
'si elimina il valore contenuto nella casella
valori = valori.Replace(cCasella(listaCelle(j)), "")
End If
Next
'si memorizzano i valori nell';array
cCasella(indix) = valori
End If
Next
End Sub
Private Sub CalcolaCelle(ByVal indix As Integer)
'determina la riga
Dim riga As Integer
Dim indice As Integer
riga = (indix \ 9) * 9
For i As Integer = riga To riga + 8
celleDaVariare(indice) = i
indice += 1
Next
'determina la colonna
Dim colonna As Integer
colonna = indix Mod 9
For i As Integer = colonna To 80 Step 9
celleDaVariare(indice) = i
indice += 1
Next
'determina il quadrato 3x3
Dim cellabase As Integer
Select Case colonna
Case 0, 1, 2
If riga = 0 Or riga = 9 Or riga = 18 Then cellabase = 0
If riga = 27 Or riga = 36 Or riga = 45 Then cellabase = 27
If riga = 54 Or riga = 63 Or riga = 72 Then cellabase = 54
Case 3, 4, 5
If riga = 0 Or riga = 9 Or riga = 18 Then cellabase = 3
If riga = 27 Or riga = 36 Or riga = 45 Then cellabase = 30
If riga = 54 Or riga = 63 Or riga = 72 Then cellabase = 57
Case 6, 7, 8
If riga = 0 Or riga = 9 Or riga = 18 Then cellabase = 6
If riga = 27 Or riga = 36 Or riga = 45 Then cellabase = 33
If riga = 54 Or riga = 63 Or riga = 72 Then cellabase = 60
End Select
For i As Integer = 0 To 2
For j As Integer = 0 To 2
celleDaVariare(indice) = cellabase + i * 9 + j
indice += 1
Next
Next
'si riordina l';array
Array.Sort(celleDaVariare)
Dim chk As Integer = -1
Dim contatore As Integer = 0
'si crea la lista delle 21 celle che sono collegate fra loro eliminando i doppioni
For i As Integer = 0 To 26
If celleDaVariare(i) <> chk Then
listaCelle(contatore) = celleDaVariare(i)
chk = celleDaVariare(i)
contatore += 1
End If
Next
End Sub
Private Sub AggiornaCelle(ByVal indix As Integer, ByVal cifrax As String)
'variabile che conterrà TUTTI i valori che possono stare nella casella da aggiornare
Dim valori As String
'si cicla su tutte e 21 le celle della lista
For i As Integer = 0 To 20
'se la cella analizzata NON è la cella da aggiornare...
If listaCelle(i) <> indix Then
'se ne recuperano i valori
valori = cCasella(listaCelle(i))
'si inseriscono in un array ad esclusione della cifra contenuta nella casella da aggiornare
Dim strArray() As String = Split(valori, cifrax)
'si cancella il contenuto della casella
cCasella(listaCelle(i)) = ""
'attraverso un ciclo,
For Each s As String In strArray
'si inseriscono i nuovi valori nella casella in corso di aggiornamento
cCasella(listaCelle(i)) += s
Next
End If
Next
End Sub
End Class
