Imports System.Threading

Imports System.Threading.Tasks

 

Public Class Donald_Knuth_Dancing_Links_Solver

 

 

#Region "Variabili_e_costanti_generiche"

    'base del sudoku.

    Public nBase As Integer

    'Numero totale celle

    Public cToT As Integer = nBase * nBase

    'Variabili candidati

    Public c1, c2, c3, c4, c5, c6, c7, c8, c9

    Public c10, c11, c12, c13, c14, c15, c16

    'Matrice vettore candidati

    Public M_Cand9(0 To 9)

    Public M_Cand16(0 To 16)

    'Costanti indice simboli candidati

    Public s1 = 1, s2 = 2, s3 = 3, s4 = 4, s5 = 5, s6 = 6, s7 = 7, s8 = 8, s9 = 9, _

                 s10 = 10, s11 = 11, s12 = 12, s13 = 13, s14 = 14, s15 = 15, s16 = 16

    'Matrice Simboli

    Public M_Simb9(0 To 9)

    Public M_Simb16(0 To 16)

    'Costanti potenze di due riferite a indice simboli candidati

    Public p1 = 2, p2 = 4, p3 = 8, p4 = 16, p5 = 32, p6 = 64, p7 = 128, p8 = 256, p9 = 512, _

                 p10 = 1024, p11 = 2048, p12 = 4096, p13 = 8192, p14 = 16384, p15 = 32768, p16 = 65536

 

    'Somma Square 9  (potenze di 2)

    Public SSq9 As Int32 = p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9

    'Somma Square 16  (potenze di 2)

    Public SSq16 As Int32 = p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9 + _

                         p10 + p11 + p12 + p13 + p14 + p15 + p16

 

    'Matrici vettore Square

    Public M_Square9(0 To 9) As Int32

    Public M_Square16(0 To 16) As Int32

 

    'Matrice con indirizzi di cella stile "A1"

    Public M_Indy(0 To cToT) As String

 

    'indica se la soluzione è unica.

    Public Unica As Boolean

 

    ''' <summary>

    ''' Classe struttura dati DLX.

    ''' </summary>

    ''' <remarks></remarks>

    Public Class DatiSchemaSudoku

 

        Private _Name As String = ""

        Private _Cand As String(,) = {}        'Cand = Candidati-chiavi    C(0 To nBase * cTOT, 0 To nBase + 1)

        Private _Vinc As String(,) = {}        'Vinc = Vincoli-chiavi       V(0 To cTOT * 4, 0 To nBase + 1)

        Private _Solution As String(,) = {}    'Solution = Soluzione       S(0 To cTOT, 0 To 1)

        Private _Index_Vincolo_PT As Integer = Nothing  'Tentativi: Index del vincolo per tentativo nella lista vincoli_PT

        Private _t_CVE As Integer = Nothing        'Tentativi: Chiave Vincolo in Esame

        Private _t_IC As Integer = Nothing         'Tentativi: Inizio Conta per il backtraching  

        Private _t_UCR As Integer = Nothing        'Tentativi: Ultima Chiave Rilasciata

 

        '***** Proprietà ******

        Public Property Name As String

            Get

                Return _Name

            End Get

            Set(ByVal value As String)

                _Name = value

            End Set

        End Property

 

        Public Property Index_Vincolo_PT As Int32

            Get

                Return _Index_Vincolo_PT

            End Get

            Set(ByVal value As Int32)

                _Index_Vincolo_PT = value

            End Set

        End Property

 

        Public Property t_CVE As Int32

            Get

                Return _t_CVE

            End Get

            Set(ByVal value As Int32)

                _t_CVE = value

            End Set

        End Property

 

        Public Property t_IC As Int32

            Get

                Return _t_IC

            End Get

            Set(ByVal value As Int32)

                _t_IC = value

            End Set

        End Property

 

        Public Property t_UCR As Int32

            Get

                Return _t_UCR

            End Get

            Set(ByVal value As Int32)

                _t_UCR = value

            End Set

        End Property

 

        Public Property Cand As String(,)

            Get

                Return _Cand

            End Get

            Set(ByVal value As String(,))

                _Cand = value

            End Set

        End Property

 

        Public Property Vinc As String(,)

            Get

                Return _Vinc

            End Get

            Set(ByVal value As String(,))

                _Vinc = value

            End Set

        End Property

 

        Public Property Solution As String(,)

            Get

                Return _Solution

            End Get

            Set(ByVal value As String(,))

                _Solution = value

            End Set

        End Property

 

    End Class

 

 

 

    'Metrice del sudoku.

    Public Mastersudoku(,) As Int32

 

    'struttura dati schema principale.

    Public dss As DatiSchemaSudoku

 

    'Lista Matrici Schemi Avanzamento Tentativi

    Public Lst_SAT As List(Of DatiSchemaSudoku) = Nothing

    'flag

    Public PrimoTentativoInCorso As Boolean

 

    'Matrice(Dizionario) Probabilità per Tentativi

    Public M_PT(,) As Int32

    'Matrice dove vengono registrate le eliminazioni dei Candidati prima dei Tentativi.

    Public Matrice_Candidati_Eliminati(,) As Int32

    'Dizionario dei Candidati non eliminati per la fase a Tentativi.

    Public Elenco_Candidati_nonEliminati_daVincoliPT As Dictionary(Of Int32, List(Of Int32))

 

    'se si vuole che si trovino più soluzioni

    Public Multisoluzioni As Boolean

 

    Public log_sequenza_Matrici As New System.Text.StringBuilder

 

    Public log_Dancing_Links As New System.Text.StringBuilder

 

    'Dizionario dei vincoli bloccanti.

    Public VincoliBloccanti As Dictionary(Of String, Int32)

 

#End Region

 

#Region "Costanti_ChiaviCandidati"

 

    'Dizionario delle chiavi_candidati

    Friend dc As New Dictionary(Of String, Int32)

 

    Public Sub iniDizionariChiaviCandidati()

        Dim nomechiavecandidato As String = String.Empty

        Dim numchiavecandidato As Int32 = 0

        'righe del sudoku

        For r As Int32 = 1 To nBase

            'colonne del sudoku

            For c As Int32 = 1 To nBase

                'simboli del sudoku

                For s As Int32 = 1 To nBase

                    nomechiavecandidato = ""

                    numchiavecandidato += 1

                    nomechiavecandidato = "r" & r & "_c" & c & "_s" & s

                    dc.Add(nomechiavecandidato, numchiavecandidato)

                Next s

            Next c

        Next r

    End Sub

 

#End Region

 

#Region "Costanti_ChiaviVincoli"

 

    'Dizionario delle chiavi_vincoli

    Friend dv As New Dictionary(Of String, Int32)

 

    Public Sub iniDizionariChiaviVincoli()

        Dim nomechiaveVincoli As String = String.Empty

        Dim numchiaveVincolo As Int32 = 0

        Dim nCelle As Int32 = nBase * nBase

        'celle del sudoku (nbase * nbase)

        For i As Int32 = 1 To nCelle

            numchiaveVincolo += 1

            nomechiaveVincoli = "cella_" & numchiaveVincolo

            dv.Add(nomechiaveVincoli, numchiaveVincolo)

        Next i

        'righe+simboli del sudoku

        For j As Int32 = 1 To nBase

            For s As Int32 = 1 To nBase

                numchiaveVincolo += 1

                nomechiaveVincoli = "row" & j & "_s" & s

                dv.Add(nomechiaveVincoli, numchiaveVincolo)

            Next s

        Next j

        'colonne+simboli del sudoku

        For k As Int32 = 1 To nBase

            For s As Int32 = 1 To nBase

                numchiaveVincolo += 1

                nomechiaveVincoli = "col" & k & "_s" & s

                dv.Add(nomechiaveVincoli, numchiaveVincolo)

            Next s

        Next k

        'box+simboli del sudoku

        For z As Int32 = 1 To nBase

            For s As Int32 = 1 To nBase

                numchiaveVincolo += 1

                nomechiaveVincoli = "box" & z & "_s" & s

                dv.Add(nomechiaveVincoli, numchiaveVincolo)

            Next s

        Next z

 

    End Sub

 

 

#End Region

 

#Region "Inizzializzazione_variabili"

 

    Public Sub New(ByRef nBaseSudoku As Int32, Optional ByRef inivar As Boolean = False)

        nBase = nBaseSudoku

        cToT = nBase * nBase

        iniDizionariChiaviCandidati()

        iniDizionariChiaviVincoli()

        dss = New DatiSchemaSudoku

        dss.Name = "StrutturaDatiPrincipale"

        dss.Index_Vincolo_PT = 1

        ReDim dss.Cand(nBase * cToT, nBase + 2)

        ReDim dss.Vinc(cToT * 4, nBase + 2)

        ReDim dss.Solution(cToT, 2)

        ReDim Matrice_Candidati_Eliminati(cToT * 4, nBase + 1)

        Lst_SAT = New List(Of DatiSchemaSudoku)

        VincoliBloccanti = New Dictionary(Of String, Int32)

        If inivar Then ImpostaVariabili(inivar)

 

    End Sub

 

    Sub ImpostaVariabili(ByRef inivar As Boolean)

        If Not inivar Then Exit Sub

        PrimoTentativoInCorso = True

        Unica = True

        Call CaricaCandidatiNumericiSudoku()

        Call CaricaMatriceCandidatiPresceltiConSquare()

        Call CaricaMatriceDatiSchemaSudoku()

        log_sequenza_Matrici.Clear()

        log_Dancing_Links.Clear()

        VincoliBloccanti = New Dictionary(Of String, Int32)

    End Sub

 

#End Region

 

#Region "Codice_Algoritmo_Base"

 

    Public Sub RisolviSudoku_DLX_Solver(ByVal Msudoku(,) As Int32, ByVal nThreads As Int32, ByVal nPercorsi As Int32, ByRef ferma As Boolean, Optional ByVal Multisol As Boolean = False)

 

        Dim KeyCandidato As String

        Dim CollectionAppoggio As Collection

        Dim EsitoInserimento As Boolean

        Dim Conta As Integer

        Dim IndiceCandidato As Integer

        Dim IndSquere As Integer = nBase + 2

        Dim Lst_vincoli_ad_1 As New List(Of Int32)

        Dim Msku(nBase, nBase) As Int32

        Dim rcs(2) As Int32

        Multisoluzioni = Multisol

        Call ImpostazioniIniziali(Msudoku)

        CollectionAppoggio = New Collection

        'Call Controllo_correttezza_Matrici()

 

        'Ripeti finché la matrice dei candidati e quella dei vincoli non sono entrambe azzerate

        Do While dss.Cand(0, 0) > 0 Or dss.Vinc(0, 0) > 0 Or dss.Solution(0, 0) < cToT

            Conta = 0

            IndiceCandidato = 0

            'Lst_vincoli_ad1.Clear()

            For Conta = 1 To cToT * 4

                'Se un vincolo rimane con un solo possibile candidato da scegliere,

                'memorizziamo il candidato nella collection da passare alla funzione

                'di inserimento nella soluzione finale; poiché lo stesso candidato può

                '"emergere" contemporaneamente da più vincoli sui 4 possibili,

                'utilizziamo la collection per passare valori univoci.

                If CInt(dss.Vinc(Conta, 1)) = 1 Then

                    KeyCandidato = _

                        dss.Vinc(Conta, IndiceSimboloCandidatoDaCostantiSquare(CInt(dss.Vinc(Conta, IndSquere))))

 

                    IndiceCandidato = dc(KeyCandidato)

                    If Not CollectionAppoggio.Contains(IndiceCandidato) Then

                        CollectionAppoggio.Add(IndiceCandidato, CStr(IndiceCandidato))

                        'Lst_vincoli_ad1.Add(Conta)

                    End If

                End If

            Next Conta

 

            'Se abbiamo trovato qualche candidato inseribile dopo il controllo vincoli ...

            If CollectionAppoggio.Count > 0 Then

                '... lo passiamo alla funzione di inserimento

                'azzerando poi la collection per utilizzi futuri

                If InserisciCandidatiFissiMultipli(CollectionAppoggio, Lst_vincoli_ad_1) = True Then

                    For Conta = 1 To CollectionAppoggio.Count

                        CollectionAppoggio.Remove(1)

                    Next

                    'Se però l'inserimento candidati fissi non va a buon fine

                    '(perché la funzione di inserimento controlla che non si

                    'generino delle incongruenze nel piazzamento dei candidati) ...

                Else

                    '... azzeriamo semplicemente la collection per utilizzi futuri

                    For Conta = 1 To CollectionAppoggio.Count

                        CollectionAppoggio.Remove(1)

                    Next

                    'A questo punto: se siamo nei tentativi bisogna tornare indietro ...

                    If PrimoTentativoInCorso = False Then

                        '... e cercare un altro candidato

                        IndiceCandidato = ChiaveCandidato_PerTentativoDiRitorno()

                        'Se troviamo un candidato di ritorno lo inseriamo nella soluzione

                        If IndiceCandidato > 0 Then

                            Call InserisciSingoloCandidatoFisso(IndiceCandidato, "TR1")

                            'se invece non troviamo alcun candidato di ritorno

                            'lo schema non è risolvibile

                        Else

                            MsgBox(" Lo schema è errato o irrisolvibile da TR1. ", MsgBoxStyle.Information)

                            GoTo esce

 

                        End If

                        '... se invece non siamo nei tentativi lo schema non è risolvibile

                    Else

 

                        MsgBox(" Lo schema è errato o irrisolvibile. da CMIniziali", MsgBoxStyle.Information)

                        GoTo esce

 

                    End If

                End If

                'se invece non abbiamo trovato candidati inseribili dopo il controllo vincoli

            Else

                'Al primo mancato ritrovamento prepariamo il vettore ordinato

                'che ci indicherà d'ora in poi le priorità di vincolo su cui provare

                If PrimoTentativoInCorso = True And IndiceCandidato = 0 Then

                    If nBase = 9 Or nPercorsi = 1 Then

                        Call CaricaVettoreProbabilitaTentativi()

                    Else

                        'se il sudoku è superiore ad un 9x9

                        Call CaricaVettoreProbabilitaTentativi()

                        'avviamo il multi threads.

                        Call Inizializza_Elenco_Candidati_per_Tentativi()

                        Call Multi_Threading_Work(nThreads, nPercorsi)

                        While (Trovata_Soluzione = False) AndAlso (num_Thread > 0) AndAlso ferma = False

                            'Thread_avviati = Thread_avviati

                            Thread.Sleep(250)

                        End While

                        If Trovata_Soluzione = True Then

                            GoTo esce

                        Else

                            MsgBox(" Lo schema è errato o irrisolvibile. da Tentativi Multi_Thread, Thread avviati: " & Thread_avviati.ToString, MsgBoxStyle.Information)

                            GoTo esce

                        End If

                    End If

                End If

                'Individuiamo un candidato da inserire nella soluzione

                IndiceCandidato = ChiaveCandidato_PerTentativo()

                'Se lo troviamo lo inseriamo

                If IndiceCandidato > 0 Then

                    Call InserisciSingoloCandidatoFisso(IndiceCandidato, "PT")

                    'se non lo troviamo bisogna cercare un candidato di ritorno

                Else

                    'MsgBox(" Lo schema è errato o irrisolvibile, da funzione ChiaveCandidato_PerTentativo PT", MsgBoxStyle.Information)

                    'GoTo esce

                    IndiceCandidato = ChiaveCandidato_PerTentativoDiRitorno()

                    If Not IndiceCandidato = 0 Then

                        Call InserisciSingoloCandidatoFisso(IndiceCandidato, "TR2")

                    Else

                        MsgBox(" Lo schema è errato o irrisolvibile. da Tentativi di Ritorno 2", MsgBoxStyle.Information)

                        GoTo esce

                    End If

                End If

            End If

            If dss.Solution(0, 0) = cToT Or ferma = True Then

                Exit Do

            End If

            Application.DoEvents()

        Loop

esce:

        Call ChiusuraElaborazione(Msudoku)

        CollectionAppoggio = Nothing

        EsitoInserimento = True

        ferma = False

 

    End Sub

 

    Private Sub ImpostazioniIniziali(ByVal Msudoku(,) As Int32)

        'copio la matrice del sudoku.

        Mastersudoku = Msudoku.Clone

        Call ImpostaVariabili(True)

        Call CaricaCandidatiFissiIniziali(Msudoku)

    End Sub

 

    Private Sub ChiusuraElaborazione(ByRef Msudoku(,) As Int32)

 

        Call RitornaSoluzione(Msudoku)

        Call RilasciaCollectionMatrici()

 

    End Sub

 

    Friend Sub Inizializza_MatriciStruttureDati(ByRef MSD As DatiSchemaSudoku, Optional ByVal nLst As Int32 = -1)

        'inizzializziamo le matrici.

        ReDim MSD.Cand(cToT * nBase, nBase + 2)

        ReDim MSD.Vinc(cToT * 4, nBase + 2)

        ReDim MSD.Solution(cToT, 2)

        MSD.Name = "NewSD " & nLst

    End Sub

 

    Friend Sub Clona_MatriciDati(ByRef V_MatrRef()(,) As String, ByVal V_MatrVal()(,) As String, ByVal nM As Int32)

 

        If nM = 0 Then

            Dim ncan As Int32 = cToT * nBase

            'candidati

            For i As Int32 = 0 To ncan

                For j As Int32 = 0 To 11

                    If V_MatrVal(nM)(i, j) = Nothing Then Continue For

                    V_MatrRef(nM)(i, j) = V_MatrVal(nM)(i, j).ToString.Trim

                Next j

            Next i

            'ricorsiva

            Clona_MatriciDati(V_MatrRef, V_MatrVal, nM + 1)

        ElseIf nM = 1 Then

            Dim nvin As Int32 = cToT * 4

            Dim subcv As Int32 = nBase + 2

            'vincoli

            For i As Int32 = 0 To nvin

                For j As Int32 = 0 To subcv

                    If V_MatrVal(nM)(i, j) = Nothing Then Continue For

                    V_MatrRef(nM)(i, j) = V_MatrVal(nM)(i, j).ToString.Trim

                Next j

            Next i

            'ricorsiva

            Clona_MatriciDati(V_MatrRef, V_MatrVal, nM + 1)

        ElseIf nM = 2 Then

            'soluzione

            For i As Int32 = 0 To cToT

                For j As Int32 = 0 To 2

                    If V_MatrVal(nM)(i, j) = Nothing Then Continue For

                    V_MatrRef(nM)(i, j) = V_MatrVal(nM)(i, j).ToString.Trim

                Next j

            Next i

 

        End If

 

    End Sub

 

    Public Numero_del_Thread_solutivo As Int32 = 0

    Public UltimoLivelloProfonditàRaggiunto As Int32 = 0

    Public MaxProfonditàRicerca As Int32 = 0

 

    Friend Sub Aggiorna_Lista_StruttureDati(ByVal StrutDati As DatiSchemaSudoku, ByRef ListaSD As List(Of DatiSchemaSudoku), ByVal Aggiungi As Byte, Optional ByRef StdatiRef As DatiSchemaSudoku = Nothing)

 

        If Aggiungi = 1 Then

            'aggiunge nuova stuttura dati alla lista.

            Dim NuovaSD As New DatiSchemaSudoku

            Call Inizializza_MatriciStruttureDati(NuovaSD, ListaSD.Count)

            ListaSD.Add(NuovaSD)

            'registriamo i livelli di profondità ricerca.

            UltimoLivelloProfonditàRaggiunto = ListaSD.Count

            If UltimoLivelloProfonditàRaggiunto > MaxProfonditàRicerca Then

                MaxProfonditàRicerca = UltimoLivelloProfonditàRaggiunto

            End If

            'eseguo la ricorsione per passare alla fase due.

            Aggiorna_Lista_StruttureDati(StrutDati, ListaSD, 2)

        ElseIf Aggiungi = 2 Then

            'copia struttura dati nella lista.

            Dim inls As Integer = ListaSD.Count - 1

            ListaSD(inls).Index_Vincolo_PT = StrutDati.Index_Vincolo_PT

            ListaSD(inls).t_CVE = StrutDati.t_CVE

            ListaSD(inls).t_IC = StrutDati.t_IC

            ListaSD(inls).t_UCR = StrutDati.t_UCR

            Dim vmsd1()(,) As String = {ListaSD(inls).Cand, ListaSD(inls).Vinc, ListaSD(inls).Solution}

            Dim vmsd2()(,) As String = {StrutDati.Cand, StrutDati.Vinc, StrutDati.Solution}

            Call Clona_MatriciDati(vmsd1, vmsd2, 0)

        ElseIf Aggiungi = 3 Then

            'copia nella struttura dati principale dalla listastrutture.

            StdatiRef.Index_Vincolo_PT = StrutDati.Index_Vincolo_PT

            StdatiRef.t_CVE = StrutDati.t_CVE

            StdatiRef.t_IC = StrutDati.t_IC

            StdatiRef.t_UCR = StrutDati.t_UCR

            Dim vmsd3()(,) As String = {StdatiRef.Cand, StdatiRef.Vinc, StdatiRef.Solution}

            Dim vmsd4()(,) As String = {StrutDati.Cand, StrutDati.Vinc, StrutDati.Solution}

            Call Clona_MatriciDati(vmsd3, vmsd4, 0)

        End If

    End Sub

 

    Private Sub Controllodiverificadebug()

        Dim flagok As Boolean = True

 

        For i As Int32 = 1 To cToT * 4

 

            If Lst_SAT(0).Vinc(i, 1) = Lst_SAT(Lst_SAT.Count - 1).Vinc(i, 1) Then

            Else

                flagok = False

            End If

 

            If Lst_SAT(0).Vinc(i, 1) = dss.Vinc(i, 1) Then

            Else

                flagok = False

            End If

 

        Next i

 

    End Sub

 

    Public NumeroTotale_Salti_Back As ULong = 0

 

    Private Function ChiaveCandidato_PerTentativoDiRitorno() As Integer

        'Backtracking

        Dim Conta As Integer

        Dim InizioConta As Integer

        Dim IUEM As Integer         'IndiceUltimoElementoMatrice

        Dim ChiaveCandidatoDiRitorno As Int32

        Dim ChiaveVincoloInEsame As Integer

        Dim UltimaChiaveRialasciataUBound_M_SAT As Int32

        Dim dssX As New DatiSchemaSudoku

        Call Inizializza_MatriciStruttureDati(dssX)

        'Call Controllodiverificadebug()

 

        ChiaveCandidatoDiRitorno = 0

        ChiaveCandidato_PerTentativoDiRitorno = ChiaveCandidatoDiRitorno

 

        Do While ChiaveCandidatoDiRitorno = 0

 

            IUEM = Lst_SAT.Count - 1

            If IUEM = -1 Then

                ChiaveCandidatoDiRitorno = 0

                Return ChiaveCandidatoDiRitorno

            End If

            Call Aggiorna_Lista_StruttureDati(Lst_SAT(IUEM), Lst_SAT, 3, dssX)

            InizioConta = dssX.t_IC + 1

            ChiaveVincoloInEsame = dssX.t_CVE

            UltimaChiaveRialasciataUBound_M_SAT = dssX.t_UCR

            If ChiaveVincoloInEsame = 0 Then Exit Do

 

            For Conta = (InizioConta) To (nBase + 1)

 

                ChiaveCandidatoDiRitorno = dc(dssX.Vinc(ChiaveVincoloInEsame, Conta))

 

                If ChiaveCandidatoDiRitorno <> UltimaChiaveRialasciataUBound_M_SAT Then

 

                    If (CInt(dssX.Cand(ChiaveCandidatoDiRitorno, 1))) = 1 Then

 

                        dssX.t_IC = Conta

                        dssX.t_CVE = ChiaveVincoloInEsame

                        dssX.t_UCR = ChiaveCandidatoDiRitorno

                        Lst_SAT(IUEM).t_IC = dssX.t_IC

                        Lst_SAT(IUEM).t_CVE = dssX.t_CVE

                        Lst_SAT(IUEM).t_UCR = dssX.t_UCR

                        Call Aggiorna_Lista_StruttureDati(Lst_SAT(IUEM), Lst_SAT, 3, dss)

                        ChiaveCandidato_PerTentativoDiRitorno = ChiaveCandidatoDiRitorno

                        Sequenza_index_vincoli.Add("-indexcand-PTR: " & Conta & "     vin: " & dssX.Vinc(ChiaveVincoloInEsame, 0) & "     can: " & dssX.Cand(ChiaveCandidatoDiRitorno, 0))

                        Exit Do

                    Else

                        ChiaveCandidatoDiRitorno = 0

                    End If

                Else

                    ChiaveCandidatoDiRitorno = 0

                End If

            Next

 

            Lst_SAT.RemoveAt(IUEM)

            Sequenza_index_vincoli.RemoveAt(IUEM)

            NumeroTotale_Salti_Back += 1

        Loop

 

        Return ChiaveCandidato_PerTentativoDiRitorno

 

    End Function

 

    Public IndexMaxRaggiuntoVettoreTentativi As Int32 = 0

    Public IndexUltimoRaggiuntoVettoreTentativi As Int32 = 0

    Public NumeroTotale_vincoli_in_esame_scansionati As ULong = 0

 

    Private Function ChiaveCandidato_PerTentativo() As Integer

 

        Dim Ultimo_Index_Vinc_PT As Int32 = dss.Index_Vincolo_PT

        Dim ContaEst As Integer

        Dim ContaInt As Integer

        Dim ChiaveVincolo As Integer

        Dim ChiaveCandidato As String

        Dim FotoDatiPT As New DatiSchemaSudoku

        Dim n_El_PT As Int32 = UBound(M_PT)

        Call Inizializza_MatriciStruttureDati(FotoDatiPT)

 

        For ContaEst = Ultimo_Index_Vinc_PT To n_El_PT

 

            ChiaveVincolo = M_PT(ContaEst, 1)

 

            If (CInt(dss.Vinc(ChiaveVincolo, 1))) > 0 Then

 

                For ContaInt = 2 To (nBase + 1)

                    ChiaveCandidato = dss.Vinc(ChiaveVincolo, ContaInt)

 

                    If (Not (CInt(dss.Cand(dc(ChiaveCandidato), 1))) = 1) Or VerificaCongruenzaInserimentoFisso(dc(ChiaveCandidato), 1) = False Then

                        Continue For

                    Else

                        dss.Index_Vincolo_PT = ContaEst

                        dss.t_CVE = ChiaveVincolo

                        dss.t_IC = ContaInt

                        dss.t_UCR = dc(ChiaveCandidato)

                        IndexUltimoRaggiuntoVettoreTentativi = ContaEst

                        Sequenza_index_vincoli.Add(" indexvin-PT: " & ContaEst & "     vin: " & dss.Vinc(ChiaveVincolo, 0) & "     can: " & ChiaveCandidato)

                        If IndexUltimoRaggiuntoVettoreTentativi > IndexMaxRaggiuntoVettoreTentativi Then

                            IndexMaxRaggiuntoVettoreTentativi = IndexUltimoRaggiuntoVettoreTentativi

                        End If

                        NumeroTotale_vincoli_in_esame_scansionati += 1

                        Call Aggiorna_Lista_StruttureDati(dss, Lst_SAT, 3, FotoDatiPT)

                        'memorizziamo foto struttura dati.

                        Call Aggiorna_Lista_StruttureDati(FotoDatiPT, Lst_SAT, 1)

                        ChiaveCandidato_PerTentativo = dc(ChiaveCandidato)

                        Return ChiaveCandidato_PerTentativo

                    End If

                Next

            End If

        Next

 

        ChiaveCandidato_PerTentativo = 0

 

    End Function

 

    Private Sub CaricaVettoreProbabilitaTentativi()

 

        Dim Conta As Integer

        Dim i As Integer

        i = 0

        For Conta = 1 To cToT * 4

            If CInt(dss.Vinc(Conta, 1)) > 0 Then

                i = i + 1

            End If

        Next

        ReDim Preserve M_PT(i, 2)

        M_PT(0, 0) = i

        i = 0

        For Conta = 1 To cTOT * 4

            If (CInt(dss.Vinc(Conta, 1))) > 0 Then

                i = i + 1

                M_PT(i, 1) = Conta

                M_PT(i, 2) = dss.Vinc(Conta, 1)

 

            End If

        Next

 

        If Multisoluzioni = False Then

            Call QuickSortChiaviPerTentativi(M_PT)

        Else

            Call QuickSortChiaviPerTentativi(M_PT)

            Call Mischia(M_PT, i, 10)

            Call QuickSortChiaviPerTentativi(M_PT)

        End If

 

        'Ragruppa la lista vincoli per tentativi, in base ai vincoli diretti.

        Dim Matrice_per_vincoli_diretti(,) As String

        'impostiamo le dimensioni della matrice

        ReDim Matrice_per_vincoli_diretti(UBound(M_PT), nBase * 3)

        'rileviamo i candidati rimasti per i tentativi, in base ai quali cerchiamo eventuali vincoli diretti nella lista.

        Call Inizializza_Elenco_Candidati_per_Tentativi()

        'carichiamo la matrice con i vincoli ragruppati.

        Call Ragruppa_vincoli_diretti(Matrice_per_vincoli_diretti, dss)

        'aggiorniamo la lista M_PT in base ai ragruppamenti.

        Call Aggiorna_la_Lista_M_PT(Matrice_per_vincoli_diretti)

 

        PrimoTentativoInCorso = False

 

    End Sub

 

    Public Sub Ragruppa_vincoli_diretti(ByRef MVD(,) As String, ByRef mds As DatiSchemaSudoku)

 

        Dim cont1 As Int32 = 0

        Dim cont2 As Int32 = 0

        Dim lista1 As New List(Of Int32)

        Dim lista2 As New List(Of String)

        Dim Lista_Vincoli As New List(Of String)

 

        For Each vinc1 As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT.Keys

            cont1 += 1

            cont2 = 0

            Lista_Vincoli.Add(vinc1)

            lista1.AddRange(Elenco_Candidati_nonEliminati_daVincoliPT(vinc1))

            For Icand As Int32 = 1 To lista1.Count

 

                lista2.Add(mds.Vinc(vinc1, lista1(Icand - 1)))

            Next Icand

            For Each vinc2 As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT.Keys

                cont2 += 1

                If cont2 > cont1 Then

                    For Each Icand2 As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT(vinc2)

 

                        If lista2.Contains(mds.Vinc(vinc2, Icand2)) = True Then

 

                            Lista_Vincoli.Add(vinc2)

                            Exit For

                        End If

                    Next Icand2

                End If

            Next vinc2

            lista2.Clear()

 

            For i As Int32 = 0 To Lista_Vincoli.Count - 1

 

                MVD(cont1, i + 1) = Lista_Vincoli(i)

            Next i

 

            Lista_Vincoli.Clear()

            lista1.Clear()

        Next vinc1

 

 

 

    End Sub

 

    Public Sub Aggiorna_la_Lista_M_PT(ByRef MVD(,) As String)

 

        'Dizionario dei Candidati non eliminati per la fase a Tentativi.

        Dim Elenco_Candidati_nonEliminati_daVincoliPT2 As New Dictionary(Of Int32, List(Of Int32))

 

        For x As Int32 = 1 To UBound(MVD) - 1

 

            For y As Int32 = 1 To nBase + 2

 

                If Not MVD(x, y) = "" Then

                    If Not Elenco_Candidati_nonEliminati_daVincoliPT2.ContainsKey(CInt(MVD(x, y))) Then

 

                        Elenco_Candidati_nonEliminati_daVincoliPT2.Add(CInt(MVD(x, y)), New List(Of Int32))

                    End If

 

                End If

            Next y

        Next x

 

        For Each vinc As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT2.Keys

 

            Elenco_Candidati_nonEliminati_daVincoliPT2(vinc).AddRange(Elenco_Candidati_nonEliminati_daVincoliPT(vinc))

 

        Next vinc

 

        Elenco_Candidati_nonEliminati_daVincoliPT.Clear()

 

        For Each vinc As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT2.Keys

 

            Elenco_Candidati_nonEliminati_daVincoliPT.Add(vinc, New List(Of Int32))

 

            Elenco_Candidati_nonEliminati_daVincoliPT(vinc).AddRange(Elenco_Candidati_nonEliminati_daVincoliPT2(vinc))

        Next vinc

 

        For i As Int32 = 1 To UBound(M_PT)

            M_PT(i, 1) = 0

            M_PT(i, 2) = 0

        Next i

 

        Dim cont As Int32 = 0

        For Each vinc As Int32 In Elenco_Candidati_nonEliminati_daVincoliPT2.Keys

            cont += 1

            M_PT(cont, 1) = vinc

            M_PT(cont, 2) = Elenco_Candidati_nonEliminati_daVincoliPT2(vinc).Count

        Next vinc

        Dim MLengh As Int32 = UBound(M_PT)

        For idx As Int32 = 1 To MLengh

            If M_PT(idx, 1) = 0 Then

                MLengh = idx - 1

                Exit For

            End If

        Next

        Call QuickSortChiaviPerTentativi(M_PT, -2, MLengh)

 

    End Sub

 

    Public Sub Inizializza_Elenco_Candidati_per_Tentativi()

 

        Elenco_Candidati_nonEliminati_daVincoliPT = New Dictionary(Of Int32, List(Of Int32))

 

        For i As Int32 = 1 To UBound(M_PT) - 1

 

            For j As Int32 = 1 To UBound(Matrice_Candidati_Eliminati) - 1

 

                If M_PT(i, 1) = Matrice_Candidati_Eliminati(j, 1) Then

 

                    Elenco_Candidati_nonEliminati_daVincoliPT.Add(M_PT(i, 1), New List(Of Int32))

 

                    For k As Int32 = 2 To nBase + 1

 

                        If Matrice_Candidati_Eliminati(j, k) > 0 Then

                            Elenco_Candidati_nonEliminati_daVincoliPT(Matrice_Candidati_Eliminati(j, 1)).Add(Matrice_Candidati_Eliminati(j, k))

                        End If

 

                    Next k

                    Exit For

                End If

 

            Next j

 

        Next i

 

    End Sub

 

    Public Function RitornaNindxNpercorsi(ByRef newECV As Object, ByVal nThr As Int32) As Int32()

        Dim nv(2) As Int32

        Dim nvie As Int32 = 1

        nv(0) = 0

 

        For Each vinc As Int32 In newECV.Keys

 

            nvie *= newECV(vinc).count

            If nvie > nThr Then

                If nThr = 1 Then nv(1) = 1

                Exit For

            Else

                nv(0) += 1

                nv(1) = nvie

            End If

 

        Next

 

        Return nv

    End Function

 

    Public Sub Carica_matrice_prercorsi_MT(ByRef Matrice_Percorsi As Int32(,), ByRef newelenco As Dictionary(Of Int32, List(Of Int32)), ByVal nindx As Int32, ByVal nper As Int32)

 

        Dim matrice_di_appoggio(,) As Int32

        ReDim matrice_di_appoggio(nindx, 5)

        'inizializzazione della matrice di appoggio.

        For x As Int32 = 1 To nindx

 

            For y As Int32 = 1 To 5

 

                If y = 1 Then

                    'indice dei vincoli in esame.

                    matrice_di_appoggio(x, y) = x

                End If

                If y = 2 Then

                    'quantità degli elementi candidati per vincolo.

                    Dim cont As Int32 = 1

                    For Each elv As Int32 In newelenco.Keys

                        If cont = x Then

                            matrice_di_appoggio(x, y) = newelenco(elv).Count

                            Exit For

                        End If

                        cont += 1

                    Next elv

                End If

                If y = 3 Then

                    'moltiplicatore dei percorsi.

                    If x = 1 Then

                        matrice_di_appoggio(x, y) = 1

                    Else

                        matrice_di_appoggio(x, y) = matrice_di_appoggio(x, 2)

                    End If

                End If

                If y = 4 Then

                    'numero quantità per elemento candidato

                    If x = 1 Then

                        matrice_di_appoggio(x, y) = matrice_di_appoggio(x, 2) * matrice_di_appoggio(x, 3)

                    Else

                        matrice_di_appoggio(x, y) = matrice_di_appoggio(x, 3) * matrice_di_appoggio(x - 1, 4)

                    End If

                End If

                If y = 5 Then

                    'quantità di ripetizioni per elemento candidato nella matrice dei percorsi.

                    matrice_di_appoggio(x, y) = nper / matrice_di_appoggio(x, 4)

                End If

            Next y

 

        Next x

 

 

 

        'inizializziamo la matrice dei percorsi.

        Dim Conta_elementi As Int32 = 0

        Dim elemento_in_esame As Int32 = 0

        Dim Quant_Elem_per_cand As Int32

 

        For x As Int32 = 1 To nindx

            'numero di elementi consecutivi nella matrice di appoggio.

            Quant_Elem_per_cand = matrice_di_appoggio(x, 5)

            elemento_in_esame = 1

 

            For y As Int32 = 1 To nper

                Conta_elementi += 1

 

 

                If Conta_elementi > Quant_Elem_per_cand Then

 

                    If elemento_in_esame = matrice_di_appoggio(x, 2) Then

                        elemento_in_esame = 1

                    Else

                        elemento_in_esame += 1

                    End If

 

                    Conta_elementi = 1

                Else

 

                End If

 

                Dim cont As Int32 = 1

                For Each elv As Int32 In newelenco.Keys

                    If cont = x Then

                        Matrice_Percorsi(x, y) = newelenco(elv)(elemento_in_esame - 1)

                        Exit For

                    End If

                    cont += 1

                Next elv

 

            Next y

            Conta_elementi = 0

        Next x

 

        Dim matrice_dei_percorsi As String = ""

 

        For x As Int32 = 1 To nindx

 

            matrice_dei_percorsi &= Environment.NewLine

 

            For y As Int32 = 1 To nper

                If Matrice_Percorsi(x, y) < 10 Then

                    matrice_dei_percorsi &= "0" & Matrice_Percorsi(x, y) & "  "

                Else

                    matrice_dei_percorsi &= Matrice_Percorsi(x, y) & "  "

                End If

            Next y

 

        Next x

 

        'MsgBox(matrice_dei_percorsi, MsgBoxStyle.Information)

 

 

    End Sub

 

    Public Function Imposta_le_vie_iniziali(ByVal newelencoX As Dictionary(Of Int32, List(Of Int32)), ByVal Matrice_Percorsi As Int32(,), ByVal ncvin() As Int32, ByVal npercorso As Int32) As Dictionary(Of Int32, List(Of Int32))

 

        Dim numero_ultimo_indx_listavinc As Int32 = ncvin(0)

        Dim numero_percorsi As Int32 = ncvin(1)

 

        Dim conta As Int32 = 1

        For Each elemv As Int32 In newelencoX.Keys

            If conta > numero_ultimo_indx_listavinc Then

                Exit For

            End If

            Dim flg As Boolean

 

            Do

                flg = False

                'eliminiamo i candidati non neccessari dal percorso.

                For Each cand As Int32 In newelencoX(elemv)

 

                    If Not cand = Matrice_Percorsi(conta, npercorso) Then

                        newelencoX(elemv).Remove(cand)

                        flg = True

                        Exit For

                    End If

                Next cand

 

            Loop While (flg = True)

 

            conta += 1

        Next

 

        Return newelencoX

    End Function

 

    Public Elenchi_candidati_da_vincoli_MT As New List(Of Dictionary(Of Int32, List(Of Int32)))

 

    Public Sub Distribuisci_elenco_per_il_MT(ByVal numThreads As Int32, ByVal elencocandidati As Dictionary(Of Int32, List(Of Int32)))

 

        Dim newelenco() As Dictionary(Of Int32, List(Of Int32))

 

        'ritorna il numero di index dell'elenco dei candidati che ci servono, ed il numero di vie.

        'ncvin(0)= numero index

        'ncvin(1)= numero percorsi sviluppati

        Dim ncvin() As Int32 = RitornaNindxNpercorsi(elencocandidati, num_Thread)

        'creiamo la matrice dei percorsi.

        Dim Matrice_Percorsi(,) As Int32

        ReDim Matrice_Percorsi(ncvin(0), ncvin(1))

        'se i thread sono maggiori di 1

        If ncvin(1) > 1 Then

            'carichiamo la matrice dei percorsi.

            Call Carica_matrice_prercorsi_MT(Matrice_Percorsi, elencocandidati, ncvin(0), ncvin(1))

        End If

 

        numThreads = ncvin(1)

        'impostiamo il numero di thread necessari per ogni percorso.

        num_Thread = ncvin(1)

 

        ReDim newelenco(ncvin(1))

        Dim contapercorsi As Int32 = 0

 

        While numThreads > 0

 

            Dim newelencoXT As Dictionary(Of Int32, List(Of Int32))

            newelenco(contapercorsi) = New Dictionary(Of Int32, List(Of Int32))

 

 

            For Each elem As Int32 In elencocandidati.Keys

 

                newelenco(contapercorsi).Add(elem, New List(Of Int32))

 

                For Each ic As Int32 In elencocandidati(elem)

                    newelenco(contapercorsi)(elem).Add(ic)

                Next ic

 

 

            Next elem

            contapercorsi += 1

            newelencoXT = New Dictionary(Of Int32, List(Of Int32))

            'elimina le vie(candidati) che non servono per i percorsi iniziali.

            'se i thread sono maggiori di 1

            If ncvin(1) >= 1 Then

                newelencoXT = Imposta_le_vie_iniziali(newelenco(contapercorsi - 1), Matrice_Percorsi, ncvin, contapercorsi)

            End If

            'inseriamo la nuova lista dei percorsi candidati per il MultiThreading.

            Elenchi_candidati_da_vincoli_MT.Add(newelencoXT)

 

            numThreads -= 1

        End While

 

    End Sub

 

    Public Sub Multi_Threading_Work(ByVal nt As Int32, ByVal np As Int32)

 

        'ThreadingPool Delegate WaitCallback instance.

        Dim ThrPool As WaitCallback = New WaitCallback(AddressOf Thread_Solver_Job2_MT)

        num_step = np

        'ThreadingPool

        Dim nThreads As Int32

        Try

            nThreads = (nt)

            num_Thread = nThreads

        Catch ex As Exception

            nThreads = 128

            num_Thread = nThreads

        End Try

        Dim maxThreadPool As Int32 = nThreads

        Dim aviablethreadsPool As Int32 = nThreads

        ThreadPool.SetMaxThreads(maxThreadPool, aviablethreadsPool)

 

        'distribuzione su più elenchi per il MT.

        Call Distribuisci_elenco_per_il_MT(nThreads, Elenco_Candidati_nonEliminati_daVincoliPT)

 

        'se il numero dei percorsi trovati è inferiore al numero di thread

        If num_Thread < nThreads Then

            'si diminuiscono i thread

            nThreads = num_Thread

        End If

        'se il numero dei percorsi trovati è superiore al numero di thread

        If num_Thread > nThreads Then

            'si diminuiscono i thread

            nThreads = num_Thread

        End If

 

        'ThreadingPool

        For t As Int32 = 1 To nThreads

 

            If Trovata_Soluzione = True Then Exit For

 

            ThreadPool.QueueUserWorkItem(ThrPool, t)

 

        Next t

 

 

    End Sub

 

    Public num_Thread As Int32

    Public Thread_avviati As Int32 = 0

    Public num_step As Int32 = 0

    Public Trovata_Soluzione As Boolean = False

 

    ''' <summary>

    ''' Unità thread job per il multi threading

    ''' </summary>

    ''' <param name="n_Thread"></param>

    ''' <remarks></remarks>

    Public Sub Thread_Solver_Job2_MT(ByVal n_Thread As Int32)

 

 

 

 

    End Sub

 

    ''' <summary>

    ''' Unità thread job per il multi threading

    ''' </summary>

    ''' <param name="n_Thread"></param>

    ''' <remarks></remarks>

    Public Sub Thread_Solver_Job_MT(ByVal n_Thread As Int32)

 

        Dim FotoDatiPT As New DatiSchemaSudoku

        Dim n_El_PT As Int32 = UBound(M_PT)

        Call Inizializza_MatriciStruttureDati(FotoDatiPT, n_Thread)

        Dim sd1()(,) As String = {dss.Cand, dss.Vinc, dss.Solution}

        Dim sd2()(,) As String = {FotoDatiPT.Cand, FotoDatiPT.Vinc, FotoDatiPT.Solution}

        Dim Numero_percorsi As Int32 = num_step

        Dim indx_cand As Int32 = 0

        Dim candidato As String = ""

        Dim chiave_candidato As Int32 = 0

        Dim nc As Int32 = 0

        Dim indxcand As Int32 = 0

        Dim num_PT As Int32 = Numero_percorsi * n_Thread

        Dim conta_P As Int32 = (num_PT - Numero_percorsi) + 1

        Dim cont_indx As Int32 = 0

        Dim conta_vincoli As Int32 = 0

        Dim n_soluzione As Int32 = cToT

        Dim Modificatore As Int32 = 1

        Thread_avviati += 1

        Application.DoEvents()

 

        Call Clona_MatriciDati(sd2, sd1, 0) 'clona sd1(master) in sd2(step0)

        Call Clona_step_avanzamenti_MT(FotoDatiPT, dss)

        Dim Lista_Step_Avanzamenti() As DatiSchemaSudoku

        ReDim Lista_Step_Avanzamenti(Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Count)

        Dim FotoDatiAvanzamento As New DatiSchemaSudoku

        Dim vincoloinesame As Int32

        Dim contvinc As Int32

        Dim matrice_segna_passi(,) As Int32

        ReDim matrice_segna_passi(Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Count, 2)

        Dim sd3()(,) As String

        Dim Ultimo_step_buono As Int32

        Dim Pila_step_buoni As New List(Of Int32)

        Dim backtrack As Boolean = False

        'step di partenza.

        Lista_Step_Avanzamenti(0) = (FotoDatiPT)

        Pila_step_buoni.Add(0)

 

        For contvinc = 1 To Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Count

back2:

 

            conta_vincoli = 0

            For Each iv As Int32 In Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Keys

                conta_vincoli += 1

                If contvinc = conta_vincoli Then

                    vincoloinesame = iv

                    Exit For

                End If

            Next iv

 

            If backtrack = False Then

                FotoDatiAvanzamento = New DatiSchemaSudoku

                Call Inizializza_MatriciStruttureDati(FotoDatiAvanzamento, n_Thread)

                FotoDatiAvanzamento.Name = n_Thread & "-" & contvinc

                sd3 = {FotoDatiAvanzamento.Cand, FotoDatiAvanzamento.Vinc, FotoDatiAvanzamento.Solution}

                Call Clona_MatriciDati(sd3, sd2, 0) 'clona sd2(master) in sd3(step+)

                Call Clona_step_avanzamenti_MT(FotoDatiAvanzamento, FotoDatiPT)

                'step di avanzamento.

                Lista_Step_Avanzamenti(contvinc) = (FotoDatiAvanzamento)

                'se il vincolo in esame non è valido, avanza al prossimo.

                If Not (CInt(Lista_Step_Avanzamenti(contvinc).Vinc(vincoloinesame, 1))) > 0 Then

                    backtrack = False

                    Continue For

                End If

            Else

                'backtrak ritorna allo step precedente.

                If contvinc = 1 Then

                    sd3 = {Lista_Step_Avanzamenti(0).Cand, Lista_Step_Avanzamenti(0).Vinc, Lista_Step_Avanzamenti(0).Solution}

                    Call Clona_MatriciDati(sd2, sd3, 0) 'clona sd3(backtrack) in sd2(master)

                    Call Clona_step_avanzamenti_MT(FotoDatiPT, Lista_Step_Avanzamenti(1))

                    backtrack = False

                    GoTo back2

                Else

                    sd3 = {Lista_Step_Avanzamenti(contvinc - 1).Cand, Lista_Step_Avanzamenti(contvinc - 1).Vinc, Lista_Step_Avanzamenti(contvinc - 1).Solution}

                    Call Clona_MatriciDati(sd2, sd3, 0) 'clona sd3(backtrack) in sd2(master)

                    Call Clona_step_avanzamenti_MT(FotoDatiPT, Lista_Step_Avanzamenti(contvinc - 1))

                    backtrack = False

                    GoTo back2

                End If

            End If

 

            If Trovata_Soluzione = True Then

                GoTo esce

            End If

 

            nc = Elenchi_candidati_da_vincoli_MT(n_Thread - 1)(vincoloinesame).Count

            cont_indx = 0

            candidato = ""

            Modificatore = nc

 

            If Lista_Step_Avanzamenti(contvinc).t_IC > 0 Then

                cont_indx = Lista_Step_Avanzamenti(contvinc).t_IC

            End If

back1:

            If cont_indx = Modificatore Then

                matrice_segna_passi(contvinc, 2) = 0

                If contvinc = Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Count - 1 Then

                    GoTo esce

                Else

                    backtrack = False

                    'Lista_Step_Avanzamenti(contvinc) = Nothing

                    contvinc += 1

                    GoTo back2

                End If

            End If

 

            While cont_indx < Modificatore

 

                For i As Int32 = 0 To nc - 1

                    cont_indx += 1

                    If cont_indx <= Modificatore Then

                        indx_cand = Elenchi_candidati_da_vincoli_MT(n_Thread - 1)(vincoloinesame)(cont_indx - 1)

                        candidato = Lista_Step_Avanzamenti(contvinc).Vinc(vincoloinesame, indx_cand)

                        matrice_segna_passi(contvinc, 1) = vincoloinesame

                        matrice_segna_passi(contvinc, 2) = cont_indx

                        Exit While

                    End If

 

                Next i

 

            End While

 

            'se il vincolo in esame non è valido, avanza al prossimo.

            If Not (CInt(Lista_Step_Avanzamenti(contvinc).Vinc(vincoloinesame, 1))) > 0 Then

                backtrack = False

                Continue For

            End If

 

            'verifico se il candidato è valido.

            If (Not (CInt(Lista_Step_Avanzamenti(contvinc).Cand(dc(candidato), 1))) = 1) Or VerificaCongruenzaInserimentoFisso_MT(dc(candidato), Lista_Step_Avanzamenti(contvinc)) = False Then

                'se il candidato abbinato al vincolo, non è valido avanza al successivo.

                GoTo back1

                'Continue For

            Else

 

                'se è valido, inseriamo il candidato e eseguiamo gli aggiornamenti.

                chiave_candidato = dc(candidato)

                Call InserisciSingoloCandidatoFisso_MT(chiave_candidato, "MultiThread" & n_Thread.ToString, Lista_Step_Avanzamenti(contvinc))

 

                'se il sudoku è risolto esce.

                If Lista_Step_Avanzamenti(contvinc).Solution(0, 0) = n_soluzione Then

                    Trovata_Soluzione = True

                    Call Clona_MatriciDati(sd1, sd3, 0) 'clona sd3 in sd1

                    UltimoLivelloProfonditàRaggiunto = Pila_step_buoni.Count

                    Numero_del_Thread_solutivo = n_Thread

                    MaxProfonditàRicerca = contvinc

                    GoTo esce

                End If

 

                'inserisce eventuali candidati dal dansinglinks dei vincoli.

                If Candidati_multipli_dai_vincoli_MT(n_Thread, Lista_Step_Avanzamenti(contvinc)) = False Then

                    'se si verifica un False, passiamo ai tentativi di ritorno backtracking

                    Dim indx_ultimo_step As Int32

                    If contvinc = 1 Or Pila_step_buoni.Count = 0 Then

                        GoTo esce

                    Else

                        'matrice_segna_passi(contvinc, 2) = 0

                        For i As Int32 = contvinc To Elenchi_candidati_da_vincoli_MT(n_Thread - 1).Count

                            matrice_segna_passi(contvinc, 2) = 0

                        Next i

                        indx_ultimo_step = Pila_step_buoni.Count - 1

                        contvinc = Pila_step_buoni(indx_ultimo_step)

                        Pila_step_buoni.RemoveAt(indx_ultimo_step)

                        backtrack = True

                        GoTo back2

                    End If

 

                Else

                    'altrimenti memorizza un nuovo step e prosegue normalmente.

                    sd3 = {Lista_Step_Avanzamenti(contvinc).Cand, Lista_Step_Avanzamenti(contvinc).Vinc, Lista_Step_Avanzamenti(contvinc).Solution}

                    Lista_Step_Avanzamenti(contvinc).t_CVE = vincoloinesame

                    Lista_Step_Avanzamenti(contvinc).t_IC = cont_indx

                    Lista_Step_Avanzamenti(contvinc).t_UCR = chiave_candidato

                    Call Clona_step_avanzamenti_MT(FotoDatiPT, Lista_Step_Avanzamenti(contvinc))

                    Call Clona_MatriciDati(sd2, sd3, 0) 'clona sd3(avanzamento) in sd2(master-back)

                    Ultimo_step_buono = contvinc

                    Pila_step_buoni.Add(Ultimo_step_buono)

                End If

 

                'se il sudoku è risolto esce.

                If Lista_Step_Avanzamenti(contvinc).Solution(0, 0) = n_soluzione Then

                    Trovata_Soluzione = True

                    Call Clona_MatriciDati(sd1, sd3, 0) 'clona sd3 in sd1

                    UltimoLivelloProfonditàRaggiunto = Pila_step_buoni.Count

                    Numero_del_Thread_solutivo = n_Thread

                    MaxProfonditàRicerca = contvinc

                    GoTo esce

                End If

 

            End If

 

            backtrack = False

 

        Next contvinc

 

esce:

        UltimoLivelloProfonditàRaggiunto = Pila_step_buoni.Count

        Numero_del_Thread_solutivo = n_Thread

        MaxProfonditàRicerca = contvinc

        If num_Thread > 0 Then

            num_Thread -= 1

            Application.DoEvents()

        End If

 

    End Sub

 

    Public Sub Clona_step_avanzamenti_MT(ByRef a As DatiSchemaSudoku, ByVal b As DatiSchemaSudoku)

        'chiave vincolo in esame

        a.t_CVE = b.t_CVE

        'index candidato

        a.t_IC = b.t_IC

        'ultimo candidato rilasciato

        a.t_UCR = b.t_UCR

    End Sub

 

    Public Function Candidati_multipli_dai_vincoli_MT(ByRef nThread As String, ByRef mds As Object) As Boolean

 

        Dim Conta As Int32 = 0

        Dim IndiceCandidato As Int32 = 0

        Dim KeyCandidato As String

        Dim CollectionAppoggio As Collection

        Dim IndSquere As Integer = nBase + 2

        Dim resultok As Boolean = True

        CollectionAppoggio = New Collection

 

        For Conta = 1 To cToT * 4

            'Se un vincolo rimane con un solo possibile candidato da scegliere,

            'memorizziamo il candidato nella collection da passare alla funzione

            'di inserimento nella soluzione finale; poiché lo stesso candidato può

            '"emergere" contemporaneamente da più vincoli sui 4 possibili,

            'utilizziamo la collection per passare valori univoci.

            If CInt(mds.Vinc(Conta, 1)) = 1 Then

                KeyCandidato = _

                    mds.Vinc(Conta, IndiceSimboloCandidatoDaCostantiSquare(CInt(mds.Vinc(Conta, IndSquere))))

 

                IndiceCandidato = dc(KeyCandidato)

                If Not CollectionAppoggio.Contains(IndiceCandidato) Then

                    CollectionAppoggio.Add(IndiceCandidato, CStr(IndiceCandidato))

                End If

            End If

        Next Conta

 

        'Se abbiamo trovato qualche candidato inseribile dopo il controllo vincoli ...

        If CollectionAppoggio.Count > 0 Then

            '... lo passiamo alla funzione di inserimento

            'azzerando poi la collection per utilizzi futuri

            If InserisciCandidatiFissiMultipli_MT(CollectionAppoggio, mds) = True Then

                CollectionAppoggio = New Collection

                resultok = True

            Else

                CollectionAppoggio = New Collection

                resultok = False

            End If

 

        End If

 

        Return resultok

    End Function

 

    Private Function IndiceSimboloCandidatoDaCostantiSquare(ByVal CostanteSquare As Integer) As Integer

 

        Select Case CostanteSquare

            Case p1

                IndiceSimboloCandidatoDaCostantiSquare = s1 + 1

            Case p2

                IndiceSimboloCandidatoDaCostantiSquare = s2 + 1

            Case p3

                IndiceSimboloCandidatoDaCostantiSquare = s3 + 1

            Case p4

                IndiceSimboloCandidatoDaCostantiSquare = s4 + 1

            Case p5

                IndiceSimboloCandidatoDaCostantiSquare = s5 + 1

            Case p6

                IndiceSimboloCandidatoDaCostantiSquare = s6 + 1

            Case p7

                IndiceSimboloCandidatoDaCostantiSquare = s7 + 1

            Case p8

                IndiceSimboloCandidatoDaCostantiSquare = s8 + 1

            Case p9

                IndiceSimboloCandidatoDaCostantiSquare = s9 + 1

            Case p10

                IndiceSimboloCandidatoDaCostantiSquare = s10 + 1

            Case p11

                IndiceSimboloCandidatoDaCostantiSquare = s11 + 1

            Case p12

                IndiceSimboloCandidatoDaCostantiSquare = s12 + 1

            Case p13

                IndiceSimboloCandidatoDaCostantiSquare = s13 + 1

            Case p14

                IndiceSimboloCandidatoDaCostantiSquare = s14 + 1

            Case p15

                IndiceSimboloCandidatoDaCostantiSquare = s15 + 1

            Case p16

                IndiceSimboloCandidatoDaCostantiSquare = s16 + 1

            Case Else

                IndiceSimboloCandidatoDaCostantiSquare = 0

        End Select

 

    End Function

 

    Public Sub InserisciSingoloCandidatoFisso_MT(ByVal IndiceCandidato As Integer, ByVal TipoTentativo As String, ByRef mds As Object)

 

        Dim I_Cella As Integer

        Dim I_Candidato As Integer

 

        I_Cella = CInt(mds.Cand(IndiceCandidato, 6))

        I_Candidato = CInt(mds.Cand(IndiceCandidato, 11))

        Call InserisciCandidatoFissoInSoluzioneFinale_MT(I_Cella, I_Candidato, mds)

 

        Call AggiornamentiPostInserimentoFisso_MT(IndiceCandidato, mds)

 

    End Sub

 

    Private Sub InserisciSingoloCandidatoFisso(ByVal IndiceCandidato As Integer, ByVal TipoTentativo As String)

 

        Dim I_Cella As Integer

        Dim I_Candidato As Integer

 

        I_Cella = CInt(dss.Cand(IndiceCandidato, 6))

        I_Candidato = CInt(dss.Cand(IndiceCandidato, 11))

        Call InserisciCandidatoFissoInSoluzioneFinale(I_Cella, I_Candidato)

        'Traccio il candidato inserito.

        'dss.Cand(IndiceCandidato, 0) += "-" & TipoTentativo & "-" & dss.Solution(0, 0)

        Call AggiornamentiPostInserimentoFisso(IndiceCandidato)

 

    End Sub

 

    Public Function InserisciCandidatiFissiMultipli_MT(ByVal CollectionAppoggio As Collection, ByRef mds As Object) As Boolean

        'ElementoCandidato_Collection

        Dim elemcand As Integer

 

        Dim I_Cella As Integer

        Dim I_Candidato As Integer

        Dim Elemento_Collection As String

        InserisciCandidatiFissiMultipli_MT = False

 

        For Each elemcand In CollectionAppoggio

 

            Elemento_Collection = mds.Cand(elemcand, 0)

 

            If VerificaCongruenzaInserimentoFisso_MT(elemcand, mds) = True Then

                I_Cella = CInt(mds.Cand(elemcand, 6))

                I_Candidato = CInt(mds.Cand(elemcand, 11))

                Call InserisciCandidatoFissoInSoluzioneFinale_MT(I_Cella, I_Candidato, mds)

 

                Call AggiornamentiPostInserimentoFisso_MT(elemcand, mds)

                InserisciCandidatiFissiMultipli_MT = True

            Else

                InserisciCandidatiFissiMultipli_MT = False

                Exit For

            End If

 

            If mds.Solution(0, 0) = cToT Then

                Exit For

            End If

 

        Next

 

        Return InserisciCandidatiFissiMultipli_MT

 

    End Function

 

    Private Function InserisciCandidatiFissiMultipli(ByVal CollectionAppoggio As Collection, Optional ByRef LstVincolo_ad1 As List(Of Int32) = Nothing) As Boolean

        'ElementoCandidato_Collection

        Dim ecand As Integer

 

        Dim I_Cella As Integer

        Dim I_Candidato As Integer

        Dim Elemento_Collection As String

        InserisciCandidatiFissiMultipli = False

 

        For Each ecand In CollectionAppoggio

            'CInt(ec) = Indice Candidato

            Elemento_Collection = dss.Cand(ecand, 0)

            'ec = dc(Elemento_Collection)

            If VerificaCongruenzaInserimentoFisso(ecand, 1, LstVincolo_ad1) = True Then

                I_Cella = CInt(dss.Cand(ecand, 6))

                I_Candidato = CInt(dss.Cand(ecand, 11))

                Call InserisciCandidatoFissoInSoluzioneFinale(I_Cella, I_Candidato)

                'Traccio il candidato inserito.

                'dss.Cand(ecand, 0) += "-CM-" & dss.Solution(0, 0)

                'log_Dancing_Links.AppendLine("| Inserito CM  " & dss.Cand(ecand, 0) & "        **********************     POSIZIONE DI INSERIMENTO: " & dss.Solution(0, 0))

                Call AggiornamentiPostInserimentoFisso(ecand)

                InserisciCandidatiFissiMultipli = True

            Else

                InserisciCandidatiFissiMultipli = False

                Exit For

            End If

        Next

 

        Return InserisciCandidatiFissiMultipli

 

    End Function

 

    Public Sequenza_index_vincoli As New List(Of String)

    Public ElencoVincolibloccanti As New Dictionary(Of String, Int32)

    Public Mischiate As Int32 = 0

 

    Private Function VerificaCongruenzaInserimentoFisso(ByVal IndiceCandidato As Integer, ByRef controllo As Byte, Optional ByRef Vincolo_rimasto_ad_1 As List(Of Int32) = Nothing) As Boolean

 

        'Dim Lst_Vinc As New List(Of Int32)

        Dim Conta As Integer

        Dim vincoloDiretto As String = ""

        Dim indicevincolodiretto As Int32

        Dim Candidato As String = ""

        VerificaCongruenzaInserimentoFisso = True

        Dim Targhet As Int32 = nBase / 2

        Dim Targhet2 As Int32

        'If Not Vincolo_rimasto_ad_1 Is Nothing Then

        'Lst_Vinc.AddRange(Vincolo_rimasto_ad_1)

        'End If

 

        'verifica i vincoli di cella, riga, colonna, box.

        For Conta = 2 To 5

 

            vincoloDiretto = dss.Cand(IndiceCandidato, Conta)

            indicevincolodiretto = dv(vincoloDiretto)

 

 

            If (CInt(dss.Vinc(indicevincolodiretto, 1))) < 1 Then

 

                If Not VincoliBloccanti.ContainsKey(vincoloDiretto) Then

                    VincoliBloccanti.Add(vincoloDiretto, 1)

                Else

                    VincoliBloccanti(vincoloDiretto) += 1

                End If

 

                Dim nc As Int32 = 0

                For Each cand As String In dc.Keys

                    nc += 1

                    If nc = IndiceCandidato Then

                        Candidato = cand

                        Exit For

                    End If

                Next

 

                Dim ns As Int32 = 0

                For Each strd In Lst_SAT

                    ns += 1

                    If controllo = 1 And strd.t_CVE = indicevincolodiretto Then

                        If VincoliBloccanti(vincoloDiretto) > Targhet Then

                            For i As Int32 = Lst_SAT.Count - 1 To ns Step -1

                                'Lst_SAT.RemoveAt(i)

                            Next i

                            'scambia con elementi in coda.

                            'Call scambia_posizione_priorità_vincoli_lastindex(indicevincolodiretto, conta_swaps)

                            'scambia con elementi successivi.

                            'Call scambia_posizione_priorità_vincoli_nextindex(indicevincolodiretto, conta_swaps)

                            Dim vincolobloccante As String = vincoloDiretto & " che blocca il Candidato: " & Candidato & " "

                            If Not ElencoVincolibloccanti.Keys.Contains(vincolobloccante) Then

                                ElencoVincolibloccanti.Add(vincolobloccante, 1)

                            Else

                                ElencoVincolibloccanti(vincolobloccante) += 1

                            End If

                            conta_swaps += 1

                            Targhet2 = 5 'nBase

                            'If Lst_SAT.Count = 1 OrElse conta_swaps > Targhet2 Then

                            'If Lst_SAT.Count > 1 Then

                            'For i As Int32 = Lst_SAT.Count - 1 To 1 Step -1

                            'Lst_SAT.RemoveAt(i)

                            'Next i

                            'End If

                            'If Lst_SAT.Count > 0 Then Lst_SAT(0).t_IC = 2

                            'Call Mischia(M_PT, UBound(M_PT), nBase)

                            'Call QuickSortChiaviPerTentativi(M_PT, 1, (UBound(M_PT) / 2) + 1)

                            'Mischiate += 1

                            'If Lst_SAT.Count > 0 Then

                            'For i As Int32 = 1 To UBound(M_PT)

                            'If M_PT(i, 1) = Lst_SAT(0).t_CVE Then

                            'M_PT(i, 1) = 0

                            'M_PT(i, 2) = 0

                            'Exit For

                            'End If

                            'Next i

                            'End If

                            'conta_swaps = 0

                            'lista_vincoli_scambiati.Clear()

                            'End If

                            VincoliBloccanti.Clear()

                        End If

 

                        Exit For

 

                    End If

                    'dss.Cand(strd.t_UCR, 0) &= ""

                Next strd

                'dss.Cand(IndiceCandidato, 0) &= ""

 

                'se un vincolo diretto è bloccante ritorna False.

                VerificaCongruenzaInserimentoFisso = False

                Return False

            End If

        Next

 

 

    End Function

 

    Public Function VerificaCongruenzaInserimentoFisso_MT(ByVal IndiceCandidato As Integer, ByRef mdati As Object) As Boolean

 

        Dim CongruenzaInserimentoFisso As Boolean = True

        Dim Conta As Integer

        Dim vincoloDiretto As String = ""

        Dim indicevincolodiretto As Int32

 

        'verifica i vincoli di cella, riga, colonna, box.

        For Conta = 2 To 5

 

            vincoloDiretto = mdati.Cand(IndiceCandidato, Conta)

            indicevincolodiretto = dv(vincoloDiretto)

 

 

            If (CInt(mdati.Vinc(indicevincolodiretto, 1))) < 1 Then

 

 

                'se un vincolo diretto è bloccante ritorna False.

                CongruenzaInserimentoFisso = False

                Return CongruenzaInserimentoFisso

 

            End If

 

        Next Conta

 

 

        Return CongruenzaInserimentoFisso

    End Function

 

    Public conta_swaps As Int32 = 0

 

    Public Sub scambia_posizione_priorità_vincoli_lastindex(ByVal indicevincolodiretto As Int32, ByVal contatore_scambi As Int32)

        Dim indexelement As Int32 = (UBound(M_PT) - 1) - contatore_scambi

        Dim swap(2) As Int32

 

        swap(0) = M_PT(indexelement, 1)

 

        M_PT(indexelement, 1) = indicevincolodiretto

 

 

        swap(1) = M_PT(indexelement, 2)

 

        For i As Int32 = 1 To indexelement

 

            If M_PT(i, 1) = indicevincolodiretto Then

                M_PT(indexelement, 2) = M_PT(i, 2)