Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Sudoku_Solver_DK - Sudoku_Solver.vb

Sudoku_Solver.vb

Caricato da: Ultimo
Scarica il programma completo

  1. Imports System.IO
  2. Imports System.Threading
  3.  
  4.  
  5. '***************************************************************************************************
  6. ' Programma per la soluzione del Sudoku realizzato da *** Tebaldo Ulleri *** in Data 11-Aprile-2018. ***
  7.  
  8. '***************************************************************************************************
  9. Public Class Sudoku_Solver
  10.  
  11.     '***********************************************************************************************
  12.     ' Variabili  Globali
  13.     '***********************************************************************************************
  14.     Public CelleSudoku() As Button = {}
  15.     Friend nRow As Int32 = 9
  16.     Friend nCol As Int32 = 9
  17.     Friend nBaseSudoku As Int32 = 9
  18.     Friend numeriSchemaSdku As Int32
  19.     Public MSudoku(nRow, nCol) As Int32
  20.     Public SchemaBase(nRow, nCol) As Int32
  21.     Public DictCaselle As New Dictionary(Of String, Casella)
  22.     Friend npRemovables(,) As List(Of Int32)
  23.     Friend smPossibili(,) As List(Of Int32)
  24.     Public StatoEventi As Int32
  25.     Public Esci As Boolean = False
  26.  
  27.     '*************************************************************
  28.  
  29.  
  30.     Sub New()
  31.         ' Chiamata richiesta dalla finestra di progettazione.
  32.         InitializeComponent()
  33.         ' Aggiungere le eventuali istruzioni di inizializzazione dopo la chiamata a InitializeComponent().
  34.  
  35.     End Sub
  36.  
  37.     Private Sub Sudoku_Solver_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  38.  
  39.         Call Inizializza(MSudoku, nRow, nCol)
  40.         Call CreaSudoku3X3Classic()
  41.         StatoEventi = Stato.Iniziale
  42.  
  43.     End Sub
  44.  
  45.     Public Sub Inizializza(ByRef MatrSudoku(,) As Int32, ByVal r As Int32, ByVal c As Int32)
  46.  
  47.         Dim BaseSudoku = r
  48.         ReDim smPossibili(BaseSudoku, BaseSudoku)
  49.         ReDim npRemovables(BaseSudoku, BaseSudoku)
  50.         Dim nbase As Int32 = BaseSudoku
  51.         DictCaselle.Clear()
  52.  
  53.         For i As Int32 = 1 To r
  54.             For j As Int32 = 1 To c
  55.                 'Inizializza Caselle.
  56.                 Dim pos As String = i.ToString & "-" & j.ToString
  57.                 DictCaselle.Add(pos, New Casella)
  58.                 Dim Casel As Casella
  59.                 Casel.NomeCasella = pos
  60.                 Casel.Numero = 0
  61.                 Casel.StatoCasella = Stato.Vuoto
  62.                 Casel.RigaCasella = i
  63.                 Casel.ColonnaCasella = j
  64.                 Casel.QuadroCasella = RitornaQuadrante(i, j, nbase)(4)
  65.                 Casel.nObbligato = Nothing
  66.                 Casel.NcasiPossibili = BaseSudoku
  67.                 Dim Lstpossib As New List(Of Int32)
  68.                 Dim LstRemovables As New List(Of Int32)
  69.                 For nk As Int32 = 1 To BaseSudoku
  70.                     Lstpossib.Add(nk)
  71.                 Next nk
  72.                 smPossibili(i, j) = Lstpossib.ToList
  73.                 npRemovables(i, j) = LstRemovables.ToList
  74.                 Casel.CasiPossibili = " ? " 'RitornaNumPossibili(MatrSudoku, i, j, nbase, Casel.NomeCasella)
  75.                 Casel.Eliminabili = "0"
  76.                 Casel.LstCasiPossibili = Lstpossib.ToList
  77.                 DictCaselle(pos) = Casel
  78.             Next j
  79.         Next i
  80.  
  81.     End Sub
  82.  
  83.     Public Sub CreaSudoku3X3Classic()
  84.         Panel1.Controls.Clear()
  85.         ReDim CelleSudoku(81)
  86.         Dim xP, yP, nCel As Integer
  87.         xP = 20
  88.         yP = 20
  89.         nCel = 0
  90.         For i As Int32 = 1 To 9 Step +1
  91.             xP = 20
  92.             For j As Int32 = 1 To 9 Step +1
  93.                 nCel += 1
  94.                 CelleSudoku(nCel) = New Button
  95.                 CelleSudoku(nCel).AutoSize = False
  96.                 CelleSudoku(nCel).TextAlign = ContentAlignment.MiddleCenter
  97.                 CelleSudoku(nCel).Font = New System.Drawing.Font("Arial", 12, FontStyle.Bold)
  98.                 CelleSudoku(nCel).Size = New System.Drawing.Size(40, 40)
  99.                 CelleSudoku(nCel).Location = New System.Drawing.Point(xP, yP)
  100.                 CelleSudoku(nCel).BackColor = Color.Ivory
  101.                 CelleSudoku(nCel).ForeColor = Color.Maroon
  102.                 CelleSudoku(nCel).Name = "Cella_" & i.ToString & "-" & j.ToString
  103.                 CelleSudoku(nCel).Text = j.ToString
  104.                 CelleSudoku(nCel).Tag = (i).ToString & "-" & (j).ToString
  105.                 CelleSudoku(nCel).FlatStyle = FlatStyle.Flat
  106.                 'CelleSudoku(nCel).ContextMenuStrip = CMenuStripInfo
  107.                 AddHandler CelleSudoku(nCel).Click, AddressOf Evento1DownClick
  108.                 AddHandler CelleSudoku(nCel).MouseWheel, AddressOf Evento1UPClick
  109.                 AddHandler CelleSudoku(nCel).MouseEnter, AddressOf InfoCasella
  110.                 AddHandler CelleSudoku(nCel).KeyPress, AddressOf EventoKeyboardClick
  111.                 Panel1.Controls.Add(CelleSudoku(nCel))
  112.                 If nCel Mod 3 = 0 Then
  113.                     xP = xP + 49
  114.                 Else
  115.                     xP = xP + 42
  116.                 End If
  117.             Next j
  118.             If i Mod 3 = 0 Then
  119.                 yP = yP + 49
  120.             Else
  121.                 yP = yP + 42
  122.             End If
  123.         Next i
  124.         nRow = 9
  125.         nCol = 9
  126.         nBaseSudoku = 9
  127.         ReDim MSudoku(nRow, nCol)
  128.  
  129.     End Sub
  130.  
  131.     Friend Sub InfoCasella(ByVal sender As Object, ByVal e As EventArgs)
  132.         ' casting dell'ogetto...
  133.         Dim Btn As Control = DirectCast(sender, Control)
  134.         Me.TStripTBoxInfo.Text = "Informazioni " & Btn.Name.ToString & " = " & Btn.Tag
  135.  
  136.         Btn.Focus()
  137.  
  138.     End Sub
  139.  
  140.     Private Sub Evento1UPClick(ByVal sender As Object, ByVal e As EventArgs)
  141.         ' casting dell'ogetto...
  142.         Dim Btn As Control = DirectCast(sender, Control)
  143.  
  144.         Select Case Btn.Text
  145.             Case ""
  146.                 Btn.Text = "1"
  147.             Case "1"
  148.                 Btn.Text = "2"
  149.             Case "2"
  150.                 Btn.Text = "3"
  151.             Case "3"
  152.                 Btn.Text = "4"
  153.             Case "4"
  154.                 Btn.Text = "5"
  155.             Case "5"
  156.                 Btn.Text = "6"
  157.             Case "6"
  158.                 Btn.Text = "7"
  159.             Case "7"
  160.                 Btn.Text = "8"
  161.             Case "8"
  162.                 Btn.Text = "9"
  163.             Case "9"
  164.                 Btn.Text = ""
  165.         End Select
  166.  
  167.     End Sub
  168.  
  169.     Private Sub Evento1DownClick(ByVal sender As Object, ByVal e As EventArgs)
  170.         ' casting dell'ogetto...
  171.         Dim Btn As Control = DirectCast(sender, Control)
  172.  
  173.         Select Case Btn.Text
  174.             Case ""
  175.                 Btn.Text = "9"
  176.             Case "1"
  177.                 Btn.Text = ""
  178.             Case "2"
  179.                 Btn.Text = "1"
  180.             Case "3"
  181.                 Btn.Text = "2"
  182.             Case "4"
  183.                 Btn.Text = "3"
  184.             Case "5"
  185.                 Btn.Text = "4"
  186.             Case "6"
  187.                 Btn.Text = "5"
  188.             Case "7"
  189.                 Btn.Text = "6"
  190.             Case "8"
  191.                 Btn.Text = "7"
  192.             Case "9"
  193.                 Btn.Text = "8"
  194.         End Select
  195.         Me.TStripCoBoxInfo.Items.Clear()
  196.     End Sub
  197.  
  198.     Private Sub Evento2UPClick(ByVal sender As Object, ByVal e As EventArgs)
  199.         ' casting dell'ogetto...
  200.         Dim Btn As Control = DirectCast(sender, Control)
  201.  
  202.         Select Case Btn.Text
  203.             Case ""
  204.                 Btn.Text = "1"
  205.             Case "16"
  206.                 Btn.Text = ""
  207.                 Exit Sub
  208.             Case Is <> ""
  209.                 Dim nx As Byte = CByte(Btn.Text)
  210.                 If nx < 16 Then nx += 1
  211.                 Btn.Text = nx.ToString
  212.         End Select
  213.     End Sub
  214.  
  215.     Private Sub EventoKeyboardClick(ByVal sender As Object, ByVal e As KeyPressEventArgs) 'Handles Me.KeyPress
  216.         ' casting dell'ogetto...
  217.         Dim Btn As Control = DirectCast(sender, Control)
  218.  
  219.         Select Case Btn.Text
  220.             Case ""
  221.                 If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
  222.                     Btn.Text = e.KeyChar.ToString
  223.                 Else
  224.                     Btn.Text = ""
  225.                 End If
  226.  
  227.             Case Is <> ""
  228.                 If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
  229.                     Btn.Text += e.KeyChar.ToString
  230.                 Else
  231.                     Btn.Text = ""
  232.                 End If
  233.  
  234.         End Select
  235.  
  236.     End Sub
  237.  
  238.     Private Sub Evento2DownClick(ByVal sender As Object, ByVal e As EventArgs)
  239.         ' casting dell'ogetto...
  240.         Dim Btn As Control = DirectCast(sender, Control)
  241.  
  242.         Select Case Btn.Text
  243.             Case ""
  244.                 Btn.Text = "16"
  245.             Case "1"
  246.                 Btn.Text = ""
  247.                 Exit Sub
  248.             Case Is <> ""
  249.                 Dim nx As Byte = CByte(Btn.Text)
  250.                 If nx > 1 Then nx -= 1
  251.                 Btn.Text = nx.ToString
  252.         End Select
  253.         Me.TStripCoBoxInfo.Items.Clear()
  254.     End Sub
  255.  
  256.     Private Sub ClearToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ClearToolStripMenuItem.Click
  257.  
  258.         Call ResettaSudoKu(nRow, nCol)
  259.         Tstato_eventi.Text = "Status: "
  260.         Tstato_eventi.Text &= (" New Sudoku... ")
  261.  
  262.     End Sub
  263.  
  264.     Friend Sub ResettaSudoKu(ByRef nRow As Int32, ByRef nCol As Int32)
  265.         Try
  266.             Call ClearSudoku()
  267.  
  268.             For i As Int32 = 1 To nRow
  269.                 For j As Int32 = 1 To nCol
  270.                     MSudoku(i, j) = Nothing
  271.  
  272.                 Next j
  273.             Next i
  274.             StatoEventi = Stato.Iniziale
  275.         Catch ex As Exception
  276.             MsgBox(ex.Message & " [OK] ", MsgBoxStyle.Information)
  277.         End Try
  278.  
  279.     End Sub
  280.  
  281.     Friend Sub ClearSudoku()
  282.  
  283.         For Each btn As Control In Panel1.Controls
  284.             btn.Text = ""
  285.             btn.Enabled = True
  286.             btn.BackColor = Color.Ivory
  287.             btn.ForeColor = Color.Maroon
  288.  
  289.         Next btn
  290.  
  291.         Application.DoEvents()
  292.     End Sub
  293.  
  294.     Private Sub ConfermaSchemaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ConfermaSchemaToolStripMenuItem.Click
  295.  
  296.         If StatoEventi = Stato.Iniziale Then
  297.             Call Inizializza(MSudoku, nRow, nCol)
  298.             Call ConfermaSudoku()
  299.         End If
  300.  
  301.     End Sub
  302.  
  303.     Public Sub ConfermaSudoku()
  304.  
  305.         ReDim MSudoku(nRow, nCol)
  306.         nBaseSudoku = nRow
  307.         numeriSchemaSdku = 0
  308.         For i As Int32 = 1 To nRow
  309.             For j As Int32 = 1 To nCol
  310.                 Dim pos As String = i.ToString & "-" & j.ToString
  311.                 For Each btn As Control In Panel1.Controls
  312.                     If btn.Tag = pos Then
  313.  
  314.                         If btn.Text.Trim <> "" Then
  315.                             MSudoku(i, j) = CInt(btn.Text.Trim)
  316.                             numeriSchemaSdku += 1
  317.                         Else
  318.                             MSudoku(i, j) = Nothing
  319.                         End If
  320.                     End If
  321.                 Next btn
  322.             Next j
  323.         Next i
  324.  
  325.         If VerSudokuIniziale(MSudoku, nBaseSudoku) = False Then
  326.             StatoEventi = Stato.Impossibile
  327.             MsgBox(" Sudoku Impossibile! controllare i numeri. ", MsgBoxStyle.Information, "Nupero Ripetuto!")
  328.  
  329.         Else
  330.  
  331.             Tstato_eventi.Text = (" Schema Sudoku Confermato... Numeri schema: " & numeriSchemaSdku)
  332.             StatoEventi = Stato.Confermato
  333.             'Preparo lo schema base per un eventuale ripristino.
  334.             ReDim SchemaBase(nRow, nCol)
  335.             SchemaBase = MSudoku.Clone
  336.         End If
  337.         For Each btn As Control In Panel1.Controls
  338.             If btn.Text.Trim <> "" Then
  339.                 btn.ForeColor = Color.Red
  340.                 btn.BackColor = Color.MediumTurquoise
  341.                 btn.Enabled = False
  342.             Else
  343.                 btn.BackColor = Color.NavajoWhite
  344.             End If
  345.         Next btn
  346.     End Sub
  347.  
  348.     Public Function VerSudokuIniziale(ByRef matrSbase(,) As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
  349.         Dim flag As Boolean = True
  350.         Dim r As Int32 = bs
  351.         Dim c As Int32 = bs
  352.         For i As Int32 = 1 To r Step +1
  353.             For j As Int32 = 1 To c Step +1
  354.                 If VerColonna(matrSbase, 1, j, bs, noerr) = False Then
  355.                     flag = False
  356.                     Return flag
  357.                 End If
  358.                 If VerQuadro(matrSbase, i, j, bs, noerr) = False Then
  359.                     flag = False
  360.                     Return flag
  361.                 End If
  362.             Next j
  363.             If VerRiga(matrSbase, i, 1, bs, noerr) = False Then
  364.                 flag = False
  365.                 Return flag
  366.             End If
  367.         Next i
  368.         Return flag
  369.     End Function
  370.  
  371.     Public Function VerQuadro(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
  372.         'Ricerca riquadro sudoku.
  373.         Dim LstVerQ As New List(Of Int32)
  374.         Dim flag As Boolean = True
  375.  
  376.         'valore base.
  377.         Dim vb As Int32 = Math.Sqrt(bs)
  378.         'ricerca coordinate riquadro.
  379.         Dim ax As Int32
  380.         Dim ay As Int32
  381.         Dim bx As Int32
  382.         Dim by As Int32
  383.         For a As Int32 = r To bs
  384.             If a Mod vb = 0 Then
  385.                 ay = a
  386.                 Exit For
  387.             End If
  388.         Next a
  389.         ax = (ay - vb) + 1
  390.         For b As Int32 = c To bs
  391.             If b Mod vb = 0 Then
  392.                 by = b
  393.                 Exit For
  394.             End If
  395.         Next b
  396.         bx = (by - vb) + 1
  397.         'verifico i numeri presenti nel riquadro.
  398.         For z As Int32 = ax To ay
  399.             For k As Int32 = bx To by
  400.                 If matrS(z, k) = 0 Then
  401.                     Dim knc As String = z.ToString & "-" & k.ToString
  402.                     Dim cas As Casella
  403.                     cas = DictCaselle(knc)
  404.                     cas.StatoCasella = Stato.Vuoto
  405.                     DictCaselle(knc) = cas
  406.                 End If
  407.                 If matrS(z, k) > 0 Then
  408.                     If LstVerQ.Contains(matrS(z, k)) = False Then
  409.                         LstVerQ.Add(matrS(z, k))
  410.                     Else
  411.                         flag = False
  412.                         If noerr Then Return flag
  413.                         Dim knc As String = z.ToString & "-" & k.ToString
  414.                         Dim cas As Casella
  415.                         cas = DictCaselle(knc)
  416.                         If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
  417.                             cas.StatoCasella = Stato.Errato
  418.                             DictCaselle(knc) = cas
  419.                             'matrS(z, k) = 0
  420.                         Else
  421.                             Dim err As Int32 = matrS(z, k)
  422.                             For z2 As Int32 = ax To ay
  423.                                 For k2 As Int32 = bx To by
  424.                                     Dim knc2 As String = z2.ToString & "-" & k2.ToString
  425.                                     If (Not DictCaselle(knc2).StatoCasella = Stato.Fisso) And (matrS(z2, k2) = err) Then
  426.                                         cas = DictCaselle(knc2)
  427.                                         cas.StatoCasella = Stato.Errato
  428.                                         DictCaselle(knc2) = cas
  429.                                         'matrS(z2, k2) = 0
  430.                                     End If
  431.                                 Next k2
  432.                             Next z2
  433.                         End If
  434.                     End If
  435.                 End If
  436.             Next k
  437.         Next z
  438.  
  439.         Return flag
  440.     End Function
  441.  
  442.     Public Function RitornaQuadrante(ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32) As Int32()
  443.         Dim ValoriQ As Int32() = {1, 2, 3, 4, 5}
  444.         'valore base.
  445.         Dim vb As Int32 = Math.Sqrt(bs)
  446.         'ricerca coordinate riquadro.
  447.         Dim ax As Int32
  448.         Dim ay As Int32
  449.         Dim bx As Int32
  450.         Dim by As Int32
  451.         For a As Int32 = r To bs
  452.             If a Mod vb = 0 Then
  453.                 ay = a
  454.                 Exit For
  455.             End If
  456.         Next a
  457.         ax = (ay - vb) + 1
  458.         For b As Int32 = c To bs
  459.             If b Mod vb = 0 Then
  460.                 by = b
  461.                 Exit For
  462.             End If
  463.         Next b
  464.         bx = (by - vb) + 1
  465.         Dim Qp1 As Int32 = CInt(((by - 1) / vb))
  466.         Dim Qp2 As Int32 = CInt((((ay - 1) / vb) * vb))
  467.         Dim Q As Int32 = CInt(Qp1 + Qp2 + 1) - vb
  468.         ValoriQ(0) = ax
  469.         ValoriQ(1) = ay
  470.         ValoriQ(2) = bx
  471.         ValoriQ(3) = by
  472.         ValoriQ(4) = Q
  473.  
  474.         Return ValoriQ
  475.  
  476.     End Function
  477.  
  478.     Public Function VerRiga(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
  479.  
  480.         'Ricerca Riga sudoku.
  481.         Dim LstVerR As New List(Of Int32)
  482.         Dim flag As Boolean = True
  483.  
  484.         'verifico i numeri presenti nella Riga.
  485.         For z As Int32 = 1 To bs
  486.             If matrS(r, z) = 0 Then
  487.                 Dim knc As String = r.ToString & "-" & z.ToString
  488.                 Dim cas As Casella
  489.                 cas = DictCaselle(knc)
  490.                 cas.StatoCasella = Stato.Vuoto
  491.                 DictCaselle(knc) = cas
  492.             End If
  493.             If matrS(r, z) > 0 Then
  494.                 If LstVerR.Contains(matrS(r, z)) = False Then
  495.                     LstVerR.Add(matrS(r, z))
  496.                 Else
  497.                     flag = False
  498.                     If noerr Then Return flag
  499.                     Dim knc As String = r.ToString & "-" & z.ToString
  500.                     Dim cas As Casella
  501.                     cas = DictCaselle(knc)
  502.                     If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
  503.                         cas.StatoCasella = Stato.Errato
  504.                         DictCaselle(knc) = cas
  505.                         'matrS(r, z) = 0
  506.                     Else
  507.                         Dim err As Int32 = matrS(r, z)
  508.                         For z2 As Int32 = 1 To bs
  509.                             Dim knc2 As String = r.ToString & "-" & z2.ToString
  510.                             If (Not DictCaselle(knc2).StatoCasella = Stato.Fisso) And (matrS(r, z2) = err) Then
  511.                                 cas = DictCaselle(knc2)
  512.                                 cas.StatoCasella = Stato.Errato
  513.                                 DictCaselle(knc2) = cas
  514.                                 'matrS(r, z2) = 0
  515.                             End If
  516.                         Next z2
  517.                     End If
  518.                 End If
  519.             End If
  520.  
  521.         Next z
  522.         Return flag
  523.     End Function
  524.  
  525.     Public Function VerColonna(ByRef matrS(,) As Int32, ByVal r As Int32, ByVal c As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
  526.  
  527.         'Ricerca Colonna sudoku.
  528.         Dim LstVerC As New List(Of Int32)
  529.         Dim flag As Boolean = True
  530.  
  531.         'verifico i numeri presenti nella Colonna.
  532.         For z As Int32 = 1 To bs
  533.             If matrS(z, c) = 0 Then
  534.                 Dim knc As String = z.ToString & "-" & c.ToString
  535.                 Dim cas As Casella
  536.                 cas = DictCaselle(knc)
  537.                 cas.StatoCasella = Stato.Vuoto
  538.                 DictCaselle(knc) = cas
  539.             End If
  540.             If matrS(z, c) > 0 Then
  541.                 If LstVerC.Contains(matrS(z, c)) = False Then
  542.                     LstVerC.Add(matrS(z, c))
  543.                 Else
  544.                     flag = False
  545.                     If noerr Then Return flag
  546.                     Dim knc As String = z.ToString & "-" & c.ToString
  547.                     Dim cas As Casella
  548.                     cas = DictCaselle(knc)
  549.                     If Not DictCaselle(knc).StatoCasella = Stato.Fisso Then
  550.                         cas.StatoCasella = Stato.Errato
  551.                         DictCaselle(knc) = cas
  552.                         'matrS(z, c) = 0
  553.                     Else
  554.                         Dim err As Int32 = matrS(z, c)
  555.                         For z2 As Int32 = 1 To bs
  556.                             Dim knc2 As String = z2.ToString & "-" & c.ToString
  557.                             If (Not DictCaselle(knc2).StatoCasella = Stato.Fisso) And (matrS(z2, c) = err) Then
  558.                                 cas = DictCaselle(knc2)
  559.                                 cas.StatoCasella = Stato.Errato
  560.                                 DictCaselle(knc2) = cas
  561.                                 'matrS(z2, c) = 0
  562.                             End If
  563.                         Next z2
  564.                     End If
  565.                 End If
  566.             End If
  567.  
  568.         Next z
  569.         Return flag
  570.     End Function
  571.  
  572.     '#####################################################################
  573.     'Enumeratori
  574.     Enum Stato
  575.         Iniziale  'index 0
  576.         Vuoto
  577.         Confermato
  578.         Fisso
  579.         Risolto
  580.         Impossibile
  581.         Errato
  582.         Mobile
  583.         Obbligato
  584.         Pieno
  585.         Completo
  586.         Solving  'index 11
  587.     End Enum
  588.     '#########################################################
  589.     'Strutture.
  590.     Structure Casella
  591.         Dim QuadroCasella As Int32
  592.         Dim RigaCasella As Int32
  593.         Dim ColonnaCasella As Int32
  594.         Dim Numero As Int32
  595.         Dim nObbligato As Int32
  596.         Dim NcasiPossibili As Int32
  597.         Dim StatoCasella As Int32
  598.         Dim LstCasiPossibili As List(Of Int32)
  599.         Dim CasiPossibili As String
  600.         Dim Eliminabili As String
  601.         Dim NomeCasella As String
  602.     End Structure
  603.  
  604.     Structure Riga
  605.         Dim NomeRiga As String
  606.         Dim NumeroRiga As Int32
  607.         Dim StatoRiga As Int32
  608.         Dim qNumeriR As Int32
  609.         Dim nPossibiliRiga As String
  610.         Dim LstPresentiRiga As List(Of Int32)
  611.  
  612.     End Structure
  613.  
  614.     Structure Colonna
  615.         Dim NomeColonna As String
  616.         Dim NumeroColonna As Int32
  617.         Dim StatoColonna As Int32
  618.         Dim qNumeriC As Int32
  619.         Dim nPossibiliColonna As String
  620.         Dim LstPresentiColonna As List(Of Int32)
  621.  
  622.     End Structure
  623.  
  624.     Structure QuadroX
  625.         Dim NomeQuadro As String
  626.         Dim NumeroQuadro As Int32
  627.         Dim StatoQuadro As Int32
  628.         Dim qNumeriQ As Int32
  629.         Dim nPossibiliQuadro As String
  630.         Dim LstPresentiQuadro As List(Of Int32)
  631.  
  632.     End Structure
  633.  
  634.     Public Function VerSudokuCompletato(ByRef matrS(,) As Int32, ByVal bs As Int32, Optional ByVal noerr As Boolean = False) As Boolean
  635.         Dim flag As Boolean = True
  636.         Dim r = bs
  637.         Dim c = bs
  638.         If VerZeroVuoti(matrS, bs) = False Then
  639.             flag = False
  640.         End If
  641.         If VerSudokuIniziale(matrS, bs, noerr) = False Then
  642.             flag = False
  643.         End If
  644.         Return flag
  645.     End Function
  646.  
  647.     Public Function VerZeroVuoti(ByRef matrS(,) As Int32, ByVal bs As Int32) As Boolean
  648.         Dim flag As Boolean = True
  649.         Dim r = bs
  650.         Dim c = bs
  651.         For i As Int32 = 1 To r
  652.             For j As Int32 = 1 To c
  653.                 If matrS(i, j) = 0 Then
  654.                     flag = False
  655.                 End If
  656.             Next j
  657.         Next i
  658.         Return flag
  659.     End Function
  660.  
  661.     Friend Sub Presenta_Sudoku(ByVal MSudokuSchema As Int32(,), Optional ByVal Enab As Boolean = False)
  662.         Dim SingleLinePos As Int32
  663.         'presentazione dei numeri
  664.         SingleLinePos = 0
  665.         For CC As Byte = 1 To nRow
  666.             For kk As Byte = 1 To nCol
  667.                 Dim pos As String = CC.ToString & "-" & kk.ToString
  668.                 For Each btn As Control In Panel1.Controls
  669.                     If btn.Tag = pos Then
  670.                         If btn.Enabled = True Then
  671.                             btn.Text = IIf(MSudokuSchema(CC, kk) <> 0, MSudokuSchema(CC, kk), "")
  672.                             If btn.Text <> "" Then
  673.                                 btn.BackColor = Color.Orange
  674.                                 btn.ForeColor = Color.Black
  675.                                 'btn.Enabled = False
  676.                             End If
  677.                         End If
  678.                     End If
  679.                 Next btn
  680.                 SingleLinePos += 1
  681.             Next kk
  682.         Next CC
  683.         'inserisco lo schema nella lista schemi.
  684.         'LstSchemiUnicaSoluzione.Add(MSudoku)
  685.     End Sub
  686.  
  687.     Private Sub RisolviSudokuToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RisolviSudokuToolStripMenuItem.Click
  688.         'Avvia algoritmo solutivo.
  689.         If Not StatoEventi = Stato.Confermato Then
  690.             MsgBox(" Attenzione Confermare lo Schema Sudoku! " + Environment.NewLine + Environment.NewLine +
  691.                    " Confirmation scheme Sudoku! ", MsgBoxStyle.Information)
  692.             Exit Sub
  693.         End If
  694.         Dim crono As New Stopwatch
  695.         'instanziamo la classe del Dansing-Links-Solver
  696.         Dim DLS As New Donald_Knuth_Dancing_Links_Solver(nBaseSudoku)
  697.         Me.ProgressBar1.Value = ProgressBar1.Maximum
  698.         Dim MultiS As Boolean = False
  699.         Dim np As Int32 = 1 'CInt(Me.Numero_percorsi.Text)
  700.         Dim nth As Int32 = 128 'CInt(Me.Numero_Threads.Text)
  701.         If Multi_Schema.Checked Then MultiS = True
  702.         crono.Start()
  703.         'utilizziaing-Links-Solver.
  704.         DLS.RisolviSudoku_DLX_Solver(MSudoku, nth, np, Esci, MultiS)
  705.         crono.Stop()
  706.         'recupero la soluzione.
  707.         'DLS.RitornaSoluzione(MSudoku)
  708.         'se lo schema è stato generato senza errori
  709.         If VerSudokuCompletato(MSudoku, nBaseSudoku) = True Then
  710.             'presento lo schema
  711.             Presenta_Sudoku(MSudoku)
  712.             Tstato_eventi.Text = "Status: Solve "
  713.             StatoEventi = Stato.Risolto
  714.         End If
  715.         'P.A.R. = Profondità Albero di Ricerca.
  716.         Tstato_eventi.Text += " Crono DLX= " & (crono.ElapsedMilliseconds / 1000) & " P.A.R. " & DLS.UltimoLivelloProfonditàRaggiunto & "/" & DLS.MaxProfonditàRicerca
  717.  
  718.         Me.ProgressBar1.Value = ProgressBar1.Minimum
  719.         Application.DoEvents()
  720.         'verifica dei valori delle variabili.
  721.         Try
  722.             MsgBox("Ultimo index raggiunto scala dei vincoli per tentativi = " & DLS.IndexUltimoRaggiuntoVettoreTentativi _
  723.                       & vbNewLine & " Massimo index raggiunto scala dei vincoli per tentativi = " & DLS.IndexMaxRaggiuntoVettoreTentativi _
  724.                       & vbNewLine & " Numero Totale index del vettore scala dei vincoli per tentativi = " & DLS.M_PT(0, 0) _
  725.                       & vbNewLine & " Numero Totale di vincoli in esame scansionati = " & DLS.NumeroTotale_vincoli_in_esame_scansionati _
  726.                       & vbNewLine & " Numero Totale di salti Back nei Tentativi = " & DLS.NumeroTotale_Salti_Back _
  727.                       & vbNewLine & " Numero utilizzo Funzione (Mischia vettore scala dei vincoli)  = " & DLS.Mischiate _
  728.                       & vbNewLine & " Numero di Thread avviati col Multithreading  = " & DLS.Thread_avviati _
  729.                       & vbNewLine & " Numero del Thread solutivo  = " & DLS.Numero_del_Thread_solutivo _
  730.                       & vbNewLine & " Numero livelli raggiunto dalla profondià ricerca del Thread  = " & DLS.UltimoLivelloProfonditàRaggiunto _
  731.                       & vbNewLine & " Numero dell'ultimo index del vettore scala dei vincoli per tentativi, raggiunto dal Thread  = " & DLS.MaxProfonditàRicerca _
  732.                       & vbNewLine & " Elenco dei vincoli bloccanti: " & vbNewLine, MsgBoxStyle.Information)
  733.             FormLog.Show()
  734.             FormLog.ListBoxLog.Items.Add("")
  735.             FormLog.ListBoxLog.Items.Add(" Elenco dei vincoli bloccanti: ")
  736.             For Each vincolo As String In DLS.ElencoVincolibloccanti.Keys
  737.                 FormLog.ListBoxLog.Items.Add(vincolo & "    uscito= " & DLS.ElencoVincolibloccanti(vincolo))
  738.             Next
  739.             FormLog.ListBoxLog.Items.Add("")
  740.             FormLog.ListBoxLog.Items.Add(" Elenco sequenza index lista vincoli per tentativi: ")
  741.             For Each indxv As String In DLS.Sequenza_index_vincoli
  742.                 FormLog.ListBoxLog.Items.Add("index vincolo + candidato= " & indxv)
  743.             Next
  744.         Catch ex As Exception
  745.             MsgBox(" Risolto senza Backtracking.", MsgBoxStyle.Information)
  746.         End Try
  747.  
  748.     End Sub
  749.  
  750.     Private Sub StopLoopToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles StopLoopToolStripMenuItem.Click
  751.         Esci = True
  752.         Application.DoEvents()
  753.     End Sub
  754.  
  755.     Private Sub RipristinaSchemaInizialeToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RipristinaSchemaInizialeToolStripMenuItem.Click
  756.  
  757.         Call RipristinaIniziale(SchemaBase, nRow, nCol)
  758.     End Sub
  759.  
  760.     Public Sub RipristinaIniziale(ByVal matrSchema(,) As Int32, ByVal M_row As Int32, ByVal M_col As Int32)
  761.  
  762.         Select Case StatoEventi
  763.             Case Stato.Confermato, Stato.Risolto, Stato.Impossibile, Stato.Vuoto
  764.                 For i As Int32 = 1 To M_row
  765.                     For j As Int32 = 1 To M_col
  766.                         Dim pos As String = i.ToString & "-" & j.ToString
  767.                         For Each btn As Control In Panel1.Controls
  768.                             If btn.Tag = pos Then
  769.                                 btn.Enabled = True
  770.                                 btn.BackColor = Color.Ivory
  771.                                 btn.ForeColor = Color.Maroon
  772.                                 If matrSchema(i, j) > 0 Then
  773.                                     btn.Text = matrSchema(i, j).ToString
  774.                                 Else
  775.                                     btn.Text = ""
  776.                                 End If
  777.                             End If
  778.                         Next btn
  779.                     Next j
  780.                 Next i
  781.                 StatoEventi = Stato.Iniziale
  782.  
  783.                 Tstato_eventi.Text = "Status: Sudoku Ripristinato "
  784.  
  785.             Case Else
  786.                 Return
  787.         End Select
  788.     End Sub
  789.  
  790.     '#################################################################################################################################
  791.  
  792.  
  793.  
  794. End Class