03/10/18 06:35:53 C:\Users\CESARE\_WEBSITES\myweb\SourceCode\RETE NEURALE Codice Sorgente.txt

Attenzione!

Questa è una copia HTML (utilizzabile a soli fini di visualizzazione nel browser)
del codice sorgente dell'esempio di rete neurale con sintassi color-highlighted per
facilitare la lettura. Naturalmente, il file con la versione VBA della procedura
NON è questo... - Questa versione HTML serve solo per visualizzare
le complesse sintassi della procedura cosí come apparirebbero in SUBLIME TEXT.
In particolare, le linee di commento sono visualizzate IN ROSSO

    1 
Option Compare Database
    2 
Option Explicit
    3 
'===========================================================
    4 
' Quanto segue attiene la creazione di una rete neurale così
    5 
' concepita:
    6 
' -----------------------------------------
    7 
' STRATO DATI UNO - INPUT - matrice 10 x 10 = 100 nodi (CELLE)
    8 
' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti
    9 
' STRATO DATI DUE - HIDDEN LAYER - vettore unidimensionale 4 nodi (=CELLE)
   10 
' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 collegamenti
   11 
' STRATO DATI TRE - OUTPUT - vettore unidimensionale 4 nodi (=CELLE)
   12 
' "TERZO STRATO collegamenti" - 4 collegamenti tra celle hidden layer ed
   13 
'                               i rispettivi BIAS NODES
   14 
' "QUARTO STRATO collegamenti" - 4 collegamenti tra celle strato output ed
   15 
'                               i rispettivi BIAS NODES
   16 
'============================================================
   17 
Public Const NumCelleStratoInput As Integer = 10
   18 
Public Const NumCelleHiddenLayer As Integer = 4
   19 
Public Const NumCelleStratoOutput As Integer = 4
   20 
Public Const LearningRate As Double = 0.01
   21 
Public Const ValoreArbitrario As Double = 0.9 'ValoreArbitrario "momentum"=0.9
   22 
 
   23 
Public M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer
   24 
Public M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double
   25 
Public M_HIDDEN(NumCelleHiddenLayer) As Double
   26 
Public M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double
   27 
Public M_OUTPUT(NumCelleStratoOutput) As Double
   28 
'la matrice con i BIAS NODES per le celle di HIDDEN LAYER
   29 
Public M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double
   30 
'la matrice con i BIAS NODES per le celle di STRATO OUTPUT
   31 
Public M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double
   32 
'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES
   33 
Public M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double
   34 
'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES
   35 
Public M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double
   36 
'=========================================================
   37 
'Per RETROPROPAGAZIONE ERRORI
   38 
'=========================================================
   39 
'cosa mi aspetto di ottenere in output
   40 
Public M_OUTPUT_DESIDERATI(NumCelleStratoOutput) As Double
   41 
'errori in output rispetto alle mie aspettative
   42 
Public M_ERRORI_OUTPUT(NumCelleStratoOutput) As Double
   43 
'errori in hidden layer come calcolati da backward propagation
   44 
Public M_ERRORI_HIDDEN(NumCelleHiddenLayer) As Double
   45 
'ultimi delta applicati ai pesi strato 1
   46 
Public M_ULTIMI_DELTAW_S1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer)  As Double
   47 
'ultimi delta applicati ai pesi strato 2
   48 
Public M_ULTIMI_DELTAW_S2(NumCelleHiddenLayer, NumCelleStratoOutput)  As Double
   49 
'ultimi delta applicati ai pesi tra HIDDEN ed i rispettivi BIAS NODES
   50 
Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer)  As Double
   51 
'ultimi delta applicati ai pesi tra OUTPUT ed i rispettivi BIAS NODES
   52 
Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput)  As Double
   53 
 
   54 
Public dbs As Database  ' variabile database per accesso DAO
   55 
Public rst As Recordset ' variabile recordset per accesso DAO
   56 
Public strCriteri As String 'stringa criterio di ricerca
   57 
 
   58 
'===> Colori per visualizzare esiti analisi
   59 
Public Const ROSSO As Long = 255
   60 
Public Const VERDE As Long = 65408
   61 
 
   62 
 
   63 
 
   64 
 
   65 
 
   66 
 
   67 
Sub AzzeraTutteLeMatrici()
   68 
'========================> Per pulizia integrale
   69 
On Error GoTo Err_Azzera
   70 
'========================> Indici locali
   71 
Dim LocalI As Integer
   72 
Dim LocalJ As Integer
   73 
Dim LocalK As Integer
   74 
'========================> Azzera nodi strato input
   75 
For LocalI = 1 To NumCelleStratoInput
   76 
    For LocalJ = 1 To NumCelleStratoInput
   77 
        M_INPUT(LocalI, LocalJ) = 0
   78 
    Next
   79 
Next
   80 
'========================> Azzera pesi di strato collegamenti 1
   81 
'========================> Azzera ERRORI pesi di strato collegamenti 1
   82 
For LocalI = 1 To NumCelleStratoInput
   83 
    For LocalJ = 1 To NumCelleStratoInput
   84 
        For LocalK = 1 To NumCelleHiddenLayer
   85 
            M_Strato1(LocalI, LocalJ, LocalK) = 0
   86 
            M_ULTIMI_DELTAW_S1(LocalI, LocalJ, LocalK) = 0
   87 
        Next
   88 
    Next
   89 
Next
   90 
'========================> Azzera nodi hidden layer
   91 
'========================> Azzera errori in hidden layer
   92 
'========================> Azzera BIAS NODES per le celle di HIDDEN LAYER
   93 
'========================> Azzera collegamenti tra HIDDEN LAYER ed i rispettivi BIAS NODES
   94 
'========================> Azzera ultimi delta pesi tra HIDDEN LAYER ed i BIAS NODES
   95 
For LocalI = 1 To NumCelleHiddenLayer
   96 
    M_HIDDEN(LocalI) = 0
   97 
    M_ERRORI_HIDDEN(LocalI) = 0
   98 
    M_BiasNodes_HIDDEN(LocalI) = 0
   99 
    M_Strato_HID_BIAS(LocalI) = 0
  100 
    M_ULTIMI_DELTAW_HB(LocalI) = 0
  101 
Next
  102 
'========================> Azzera pesi di strato collegamenti 2
  103 
'========================> Azzera ERRORI pesi di strato collegamenti 2
  104 
For LocalI = 1 To NumCelleHiddenLayer
  105 
    For LocalJ = 1 To NumCelleStratoOutput
  106 
        M_Strato2(LocalI, LocalJ) = 0
  107 
        M_ULTIMI_DELTAW_S2(LocalI, LocalJ) = 0
  108 
    Next
  109 
Next
  110 
'========================> Azzera strato output
  111 
'========================> Azzera cosa mi aspetto di ottenere in output
  112 
'========================> Azzera errori in output rispetto alle mie aspettative
  113 
'========================> Azzera BIAS NODES per le celle di strato output
  114 
'========================> Azzera collegamenti tra OUTPUT ed i rispettivi BIAS NODES
  115 
'========================> Azzera ultimi delta pesi tra OUTPUT ed i BIAS NODES
  116 
For LocalI = 1 To NumCelleStratoOutput
  117 
    M_OUTPUT(LocalI) = 0
  118 
    M_OUTPUT_DESIDERATI(LocalI) = 0
  119 
    M_ERRORI_OUTPUT(LocalI) = 0
  120 
    M_BiasNodes_OUTPUT(LocalI) = 0
  121 
    M_Strato_OUT_BIAS(LocalI) = 0
  122 
    M_ULTIMI_DELTAW_OB(LocalI) = 0
  123 
Next
  124 
 
  125 
Exit_Azzera:
  126 
    Exit Sub
  127 
 
  128 
Err_Azzera:
  129 
     MsgBox "AzzeraTutteLeMatrici: Errore " & Str(Err.Number) & " generato da " _
  130 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  131 
    Resume Exit_Azzera
  132 
   
  133 
End Sub
  134 
Sub AzzeraTrannePesiCollegamenti()
  135 
'========================> Per pulizia dei dati ma non dei pesi collegamenti
  136 
On Error GoTo Err_AzzNocollegamenti
  137 
Dim LocalI As Integer
  138 
Dim LocalJ As Integer
  139 
'========================> Azzera nodi strato input
  140 
For LocalI = 1 To NumCelleStratoInput
  141 
    For LocalJ = 1 To NumCelleStratoInput
  142 
        M_INPUT(LocalI, LocalJ) = 0
  143 
    Next
  144 
Next
  145 
'========================> Azzera nodi hidden layer
  146 
For LocalI = 1 To NumCelleHiddenLayer
  147 
    M_HIDDEN(LocalI) = 0
  148 
Next
  149 
'========================> Azzera strato output
  150 
'========================> Azzera cosa mi aspetto di ottenere in output
  151 
For LocalI = 1 To NumCelleStratoOutput
  152 
    M_OUTPUT(LocalI) = 0
  153 
    M_OUTPUT_DESIDERATI(LocalI) = 0
  154 
Next
  155 
'========================> Non tocco i BIAS NODES, che sono inizializzati ad 1 e
  156 
'========================> tali devono rimanere!
  157 
 
  158 
Exit_AzzNocollegamenti:
  159 
    Exit Sub
  160 
 
  161 
Err_AzzNocollegamenti:
  162 
     MsgBox "AzzeraTrannePesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _
  163 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  164 
    Resume Exit_AzzNocollegamenti
  165 
   
  166 
End Sub
  167 
 
  168 
 
  169 
 
  170 
 
  171 
 
  172 
 
  173 
Sub PredisponiTabellaPesoCollegamenti(Valore As Double)
  174 
 
  175 
On Error GoTo Err_PredisponiTabellacollegamenti
  176 
'===================================================================
  177 
' Vinco la tentazione di rendere totalmente parametrica questa fase
  178 
' é ovvio che potrei farmi passare come parametro tutto quanto, numero
  179 
' dello strato e dimensione dello strato. Altrettanto ovvio è che potrei
  180 
' ricorrere ad una tabella di configurazione, con un record per ogni
  181 
' strato di pesi, dalla quale leggere ogni informazione necessaria
  182 
'===================================================================
  183 
' Da consigli ricevuti (vedi commenti iniziali) pare che mi bastino
  184 
' quattro celle nell'hidden layer, oltre alle quattro dell'output
  185 
' Quindi qui predispongo brutalmente 416 celle di cui 400 nel primo
  186 
' strato di pesi, e 16 nel secondo.
  187 
' Nel PRIMO STRATO DI collegamenti la cella è localizzata come segue:
  188 
' strato di pesi = 1
  189 
' x strato di input
  190 
' y stato di input
  191 
' x "hidden layer" (fisso a 1 : è un vettore unidimensionale)
  192 
' y "hidden layer" (da 1 a 4)
  193 
'=========================> Totale primo strato: 400 collegamenti
  194 
' Nel SECONDO STRATO DI collegamenti la cella è localizzata come segue:
  195 
' strato di pesi = 2
  196 
' x "hidden layer" (fisso a 1 : è un vettore unidimensionale)
  197 
' y "hidden layer" (da 1 a 4)
  198 
' x strato di output (fisso a 1 : è un vettore unidimensionale)
  199 
' y strato di output (da 1 a 4)
  200 
'=========================> Totale secondo strato: 16 collegamenti
  201 
' SONO PREVISTI DUE ULTERIORI STRATI
  202 
' UNO PER MEMORIZZARE IL PESO DEI COLLEGAMENTI "UNO A UNO" TRA LE CELLE
  203 
' DI HIDDEN LAYER ED I RISPETTIVI BIAS NODES
  204 
' UNO PER MEMORIZZARE IL PESO DEI COLLEGAMENTI "UNO A UNO" TRA LE CELLE
  205 
' DI OUTPUT LAYER ED I RISPETTIVI BIAS NODES
  206 
' Sebbene tecnicamente il significato non sia  esattamente identico a
  207 
' quello degli altri strati, nulla naturalmente impedisce di memorizzare
  208 
' e gestire questi collegamenti esattamente come gli altri
  209 
'======================================================================
  210 
' Nel TERZO STRATO DI collegamenti la cella è localizzata come segue:
  211 
' strato di pesi = 3
  212 
' x "hidden layer" (fisso a 1 : è un vettore unidimensionale)
  213 
' y "hidden layer" (da 1 a 4)
  214 
' x fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE
  215 
' y fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE
  216 
'=========================> Totale terzo strato: 4 collegamenti
  217 
' Nel QUARTO STRATO DI collegamenti la cella è localizzata come segue:
  218 
' strato di pesi = 4
  219 
' x strato di output (fisso a 1 : è un vettore unidimensionale)
  220 
' y strato di output (da 1 a 4)
  221 
' x fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE
  222 
' y fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE
  223 
'=========================> Totale terzo strato: 4 collegamenti
  224 
 
  225 
'===================================================================
  226 
'Previa eliminazione di tutti i records eventualmente esistenti,
  227 
'corredo la tabella PESO_COLLEGAMENTI di un adeguato numero di records,
  228 
'La chiave è una stringa del tipo "SIIJJiijj"
  229 
'dove:
  230 
'S è il numero dello strato di collegamenti
  231 
'II e JJ sono gli indici posizionali dello strato "di provenienza"
  232 
'ii e jj sono gli indici posizionali dello strato "di destinazione"
  233 
'==================> Indici Locali
  234 
Dim LocalItop As Integer
  235 
Dim LocalJtop As Integer
  236 
Dim LocalIbottom As Integer
  237 
Dim LocalJbottom As Integer
  238 
'==================> Numero strato
  239 
Dim LocalS As Integer
  240 
'==================> Chiave di ricerca
  241 
Dim Chiave As String
  242 
'==================> Random Seed
  243 
Dim RND_SEED As Integer
  244 
'==================> SORTEGGIO SEGNO
  245 
Dim PIUOMENO As Double
  246 
'==================> Chiedo conferma della cancellazione
  247 
'==================> del contenuto corrente della tabella PESO_COLLEGAMENTI
  248 
If MsgBox("Confermate l'azzeramento della tabella PESO_COLLEGAMENTI?", vbYesNo, "PredisponiTabellacollegamenti") = vbNo Then
  249 
    Exit Sub
  250 
End If
  251 
'==================> Svuoto tabella collegamenti
  252 
DoCmd.RunSQL "Delete * from PESO_COLLEGAMENTI"
  253 
 
  254 
' Restituisce il riferimento al database corrente.
  255 
Set dbs = CurrentDb
  256 
' Apre la tabella collegamenti come oggetto Recordset di tipo dynaset.
  257 
Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable)
  258 
' Attiva l'indice associato COORDINATE
  259 
rst.Index = "COORDINATE"
  260 
'==================================================================================
  261 
'Forzo in associazione ad ogni collegamento un valore random in un range - X / + X
  262 
'(X è il valore di inizializzazione passatomi nel parametro VALORE).
  263 
'==================================================================================
  264 
'=========================
  265 
'Inizializzo RANDOM SEED
  266 
'=========================
  267 
RND_SEED = 1
  268 
'=========================
  269 
' PRIMO STRATO - 400 COLLEGAMENTI
  270 
' mettono in contatto una matrice 10 x 10
  271 
' con una matrice 1 x 4
  272 
'=========================
  273 
LocalS = 1
  274 
'per ogni riga strato sopra
  275 
For LocalItop = 1 To 10
  276 
    'per ogni colonna strato sopra
  277 
    For LocalJtop = 1 To 10
  278 
        'per ogni riga strato sotto
  279 
        For LocalIbottom = 1 To 1
  280 
            'per ogni colonna strato sotto
  281 
            For LocalJbottom = 1 To 4
  282 
                'Compongo la chiave da salvare
  283 
                Chiave = LTrim$(Str$(LocalS)) + Format$(LocalItop, "00") + Format$(LocalJtop, "00") + Format$(LocalIbottom, "00") + Format$(LocalJbottom, "00")
  284 
                ' AGGIUNGO NUOVO RECORD
  285 
                rst.AddNew
  286 
                ' salvo chiave
  287 
                rst!Posizione = Chiave
  288 
                '===\
  289 
                '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore
  290 
                '===/
  291 
                '=======================> "SORTEGGIO" il segno
  292 
                RND_SEED = RND_SEED + 1
  293 
                Randomize RND_SEED
  294 
                PIUOMENO = Rnd
  295 
                '=======================> "SORTEGGIO" il VALORE
  296 
                RND_SEED = RND_SEED + 1
  297 
                Randomize RND_SEED
  298 
                '================================================
  299 
                ' salvo valore calcolato con il segno sorteggiato
  300 
                '================================================
  301 
                If PIUOMENO > 0.5 Then
  302 
                    rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore
  303 
                Else
  304 
                    rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1
  305 
                End If
  306 
                ' salvo il record
  307 
                rst.Update
  308 
            Next
  309 
        Next
  310 
    Next
  311 
Next
  312 
'=======================================
  313 
' SECONDO STRATO - 16 COLLEGAMENTI
  314 
' mettono in contatto una matrice 1 x 4
  315 
' con una matrice 1 x 4
  316 
'=======================================
  317 
LocalS = 2
  318 
'per ogni riga strato sopra
  319 
For LocalItop = 1 To 1
  320 
    'per ogni colonna strato sopra
  321 
    For LocalJtop = 1 To 4
  322 
        'per ogni riga strato sotto
  323 
        For LocalIbottom = 1 To 1
  324 
            'per ogni colonna strato sotto
  325 
            For LocalJbottom = 1 To 4
  326 
                'Compongo la chiave da salvare
  327 
                Chiave = LTrim$(Str$(LocalS)) + Format$(LocalItop, "00") + Format$(LocalJtop, "00") + Format$(LocalIbottom, "00") + Format$(LocalJbottom, "00")
  328 
                ' AGGIUNGO NUOVO RECORD
  329 
                rst.AddNew
  330 
                ' salvo chiave
  331 
                rst!Posizione = Chiave
  332 
                '=======================> "SORTEGGIO" il segno
  333 
                RND_SEED = RND_SEED + 1
  334 
                Randomize RND_SEED
  335 
                PIUOMENO = Rnd
  336 
                '=======================> "SORTEGGIO" il VALORE
  337 
                RND_SEED = RND_SEED + 1
  338 
                Randomize RND_SEED
  339 
                '===\
  340 
                '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore
  341 
                '===/
  342 
                '================================================
  343 
                ' salvo valore calcolato con il segno sorteggiato
  344 
                '================================================
  345 
                If PIUOMENO > 0.5 Then
  346 
                    rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore
  347 
                Else
  348 
                    rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1
  349 
                End If
  350 
                ' salvo il record
  351 
                rst.Update
  352 
            Next
  353 
        Next
  354 
    Next
  355 
Next
  356 
 
  357 
'=========================
  358 
' TERZO STRATO - 4 COLLEGAMENTI
  359 
' mettono in contatto quattro celle di un vettore 1 x 4
  360 
' con le rispettive celle di BIAS NODE senza incroci
  361 
'=========================
  362 
For LocalItop = 1 To NumCelleHiddenLayer
  363 
    'Compongo la chiave da salvare
  364 
    Chiave = "301" + Format$(LocalItop, "00") + "0000"
  365 
    ' AGGIUNGO NUOVO RECORD
  366 
    rst.AddNew
  367 
    ' salvo chiave
  368 
    rst!Posizione = Chiave
  369 
    '=======================> "SORTEGGIO" il segno
  370 
    RND_SEED = RND_SEED + 1
  371 
    Randomize RND_SEED
  372 
    PIUOMENO = Rnd
  373 
    '=======================> "SORTEGGIO" il VALORE
  374 
    RND_SEED = RND_SEED + 1
  375 
    Randomize RND_SEED
  376 
    '===\
  377 
    '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore
  378 
    '===/
  379 
    '================================================
  380 
    ' salvo valore calcolato con il segno sorteggiato
  381 
    '================================================
  382 
    If PIUOMENO > 0.5 Then
  383 
        rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore
  384 
    Else
  385 
        rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1
  386 
    End If
  387 
    ' salvo il record
  388 
    rst.Update
  389 
Next
  390 
'=========================
  391 
' QUARTO STRATO - 4 COLLEGAMENTI
  392 
' mettono in contatto quattro celle di un vettore 1 x 4
  393 
' con le rispettive celle di BIAS NODE senza incroci
  394 
'=========================
  395 
 
  396 
'========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes
  397 
For LocalItop = 1 To NumCelleStratoOutput
  398 
    'Compongo la chiave da salvare
  399 
    Chiave = "401" + Format$(LocalItop, "00") + "0000"
  400 
    ' AGGIUNGO NUOVO RECORD
  401 
    rst.AddNew
  402 
    ' salvo chiave
  403 
    rst!Posizione = Chiave
  404 
    '=======================> "SORTEGGIO" il segno
  405 
    RND_SEED = RND_SEED + 1
  406 
    Randomize RND_SEED
  407 
    PIUOMENO = Rnd
  408 
    '=======================> "SORTEGGIO" il VALORE
  409 
    RND_SEED = RND_SEED + 1
  410 
    Randomize RND_SEED
  411 
    '===\
  412 
    '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore
  413 
    '===/
  414 
    '================================================
  415 
    ' salvo valore calcolato con il segno sorteggiato
  416 
    '================================================
  417 
    If PIUOMENO > 0.5 Then
  418 
        rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore
  419 
    Else
  420 
        rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1
  421 
    End If
  422 
    ' salvo il record
  423 
    rst.Update
  424 
Next
  425 
'Chiudo recordset
  426 
rst.Close
  427 
'Azzero variabile Database
  428 
Set dbs = Nothing
  429 
 
  430 
Exit_PredisponiTabellacollegamenti:
  431 
    Exit Sub
  432 
 
  433 
Err_PredisponiTabellacollegamenti:
  434 
     MsgBox "PredisponiTabellaPesoCollegamenti: Errore " & Str(Err.Number) & " generato da " _
  435 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  436 
    Resume Exit_PredisponiTabellacollegamenti
  437 
   
  438 
End Sub
  439 
 
  440 
 
  441 
 
  442 
 
  443 
 
  444 
 
  445 
Sub SalvaPesoCollegamento(Strato As Integer, RTop As Integer, CTop As Integer, RBottom As Integer, CBottom As Integer, Valore As Double)
  446 
On Error GoTo Err_SalvaPesoCollegamento
  447 
'=========================================
  448 
'Salvo nella apposita tabella PESO_COLLEGAMENTI
  449 
'il valore DOUBLE del peso collegamento passatomi.
  450 
'La chiave è una stringa del tipo "SIIJJiijj"
  451 
'dove
  452 
'S è il numero dello strato di collegamenti
  453 
'II e JJ sono gli indici posizionali della cella "di provenienza"
  454 
'ii e jj sono gli indici posizionali della cella "di destinazione"
  455 
'--------------------------------------------------------------
  456 
'NEL CASO DEI COLLEGAMENTI CON BIAS NODES IL DISCORSO NON VALE!
  457 
'--------------------------------------------------------------
  458 
'"301010000" è il collegamento tra la prima cella hidden ed il suo bias node
  459 
'"301020000" è il collegamento tra la seconda cella hidden ed il suo bias node
  460 
'........
  461 
'"401010000" è il collegamento tra la prima cella output ed il suo bias node
  462 
'"401020000" è il collegamento tra la seconda cella output ed il suo bias node
  463 
'........
  464 
'=========================================
  465 
'==================> Chiave di ricerca
  466 
Dim Chiave As String
  467 
'Compongo la chiave da cercare
  468 
Chiave = LTrim$(Str$(Strato)) + Format$(RTop, "00") + Format$(CTop, "00") + Format$(RBottom, "00") + Format$(CBottom, "00")
  469 
' Restituisce il riferimento al database corrente.
  470 
Set dbs = CurrentDb
  471 
' Apre la tabella collegamenti come oggetto Recordset di tipo dynaset.
  472 
Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable)
  473 
' Attiva l'indice associato COORDINATE
  474 
rst.Index = "COORDINATE"
  475 
'Mi porto su record corrispondente alla chiave
  476 
rst.Seek "=", Chiave
  477 
'Prevedo l'eventualità di un errore
  478 
If rst.NoMatch Then
  479 
    MsgBox "SalvaPesoCollegamento - Chiave di ricerca " & Chiave & "non trovata"
  480 
    'Chiudo recordset
  481 
    rst.Close
  482 
    'Azzero variabile Database
  483 
    Set dbs = Nothing
  484 
    Exit Sub
  485 
End If
  486 
'Ricerca riuscita - mi porto in modalità EDIT
  487 
rst.Edit
  488 
'salvo nel campo peso il VALORE passato come parametro
  489 
rst!Peso = Valore
  490 
'Salvo il record
  491 
rst.Update
  492 
'Chiudo recordset
  493 
rst.Close
  494 
'Azzero variabile Database
  495 
Set dbs = Nothing
  496 
 
  497 
Exit_SalvaPesoCollegamento:
  498 
    Exit Sub
  499 
 
  500 
Err_SalvaPesoCollegamento:
  501 
     MsgBox "SalvaPesoCollegamento: Errore " & Str(Err.Number) & " generato da " _
  502 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  503 
    Resume Exit_SalvaPesoCollegamento
  504 
   
  505 
End Sub
  506 
 
  507 
 
  508 
 
  509 
 
  510 
 
  511 
Function LeggiPesoCollegamento(Strato As Integer, RTop As Integer, CTop As Integer, RBottom As Integer, CBottom As Integer) As Double
  512 
On Error GoTo Err_LeggiPesoCollegamento
  513 
'=========================================
  514 
'Leggo dalla apposita tabella peso_collegamenti
  515 
'il valore DOUBLE del peso del collegamento passatomi.
  516 
'La chiave è una stringa del tipo "SIIJJiijj"
  517 
'dove
  518 
'S è il numero dello strato di collegamenti
  519 
'II e JJ sono gli indici posizionali della cella "sopra"
  520 
'ii e jj sono gli indici posizionali della cella "sotto"
  521 
'--------------------------------------------------------------
  522 
'NEL CASO DEI COLLEGAMENTI CON BIAS NODES IL DISCORSO NON VALE!
  523 
'--------------------------------------------------------------
  524 
'"301010000" è il collegamento tra la prima cella hidden ed il suo bias node
  525 
'"301020000" è il collegamento tra la seconda cella hidden ed il suo bias node
  526 
'........
  527 
'"401010000" è il collegamento tra la prima cella output ed il suo bias node
  528 
'"401020000" è il collegamento tra la seconda cella output ed il suo bias node
  529 
'........
  530 
'=========================================
  531 
'==================> Chiave di ricerca
  532 
Dim Chiave As String
  533 
'==================> Valore da restituire
  534 
Dim Ridai As Double
  535 
 
  536 
'Compongo la chiave da cercare
  537 
Chiave = LTrim$(Str$(Strato)) + Format$(RTop, "00") + Format$(CTop, "00") + Format$(RBottom, "00") + Format$(CBottom, "00")
  538 
' Restituisce il riferimento al database corrente.
  539 
Set dbs = CurrentDb
  540 
' Apre la tabella PESO_COLLEGAMENTI come oggetto Recordset di tipo dynaset.
  541 
Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable)
  542 
' Attiva l'indice associato COORDINATE
  543 
rst.Index = "COORDINATE"
  544 
'Mi porto su record corrispondente alla chiave
  545 
rst.Seek "=", Chiave
  546 
'Prevedo l'eventualità di un errore
  547 
If rst.NoMatch Then
  548 
    MsgBox "LeggiPesoCollegamento - Chiave di ricerca " & Chiave & "non trovata"
  549 
    Ridai = 0
  550 
Else
  551 
    'Ricerca riuscita - salvo nel campo RIDAI il valore dato
  552 
    Ridai = rst!Peso
  553 
End If
  554 
'Chiudo recordset
  555 
rst.Close
  556 
'Azzero variabile Database
  557 
Set dbs = Nothing
  558 
 
  559 
LeggiPesoCollegamento = Ridai
  560 
 
  561 
Exit_LeggiPesoCollegamento:
  562 
    Exit Function
  563 
 
  564 
Err_LeggiPesoCollegamento:
  565 
     MsgBox "LeggiPesoColegamento: Errore " & Str(Err.Number) & " generato da " _
  566 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  567 
    Resume Exit_LeggiPesoCollegamento
  568 
   
  569 
End Function
  570 
 
  571 
 
  572 
 
  573 
Sub LeggiTuttiIPesiCollegamenti()
  574 
On Error GoTo Err_LeggiTutticollegamenti
  575 
'=========================================
  576 
'Leggo dalla apposita tabella PESO_COLLEGAMENTI
  577 
'tutti i pesi relativi ai collegamenti, e li
  578 
'metto nelle apposite matrici
  579 
'=========================================
  580 
'========================> Indici locali
  581 
Dim LocalI As Integer
  582 
Dim LocalJ As Integer
  583 
Dim LocalK As Integer
  584 
'==================> Chiave di ricerca
  585 
Dim Chiave As String
  586 
'==================> Nome Tabella PESO_COLLEGAMENTI
  587 
Dim NomeTabella As String
  588 
Dim Trovata As Boolean
  589 
Dim tdfCiclo As TableDef
  590 
 
  591 
'==================> Chiedo il nome della Tabella PESO_COLLEGAMENTI da usare
  592 
NomeTabella = UCase(InputBox(Prompt:="Da che tabella leggo il peso dei collegamenti (Tipicamente, da tabella PESO_COLLEGAMENTI)?", Title:="Scelta tabella peso collegamenti", XPos:=2000, YPos:=2000))
  593 
 
  594 
'==================> verifico l'esistenza della tabella
  595 
' Restituisce il riferimento al database corrente.
  596 
Set dbs = CurrentDb
  597 
' Per ora, non so se esiste
  598 
Trovata = False
  599 
' Spazzo tutte le TableDefs
  600 
For Each tdfCiclo In dbs.TableDefs
  601 
    If tdfCiclo.name = NomeTabella Then
  602 
        Trovata = True
  603 
    End If
  604 
Next
  605 
'=========================> Se la tabella peso collegamenti indicata non esiste, non proseguo
  606 
If Trovata = False Then
  607 
    Beep
  608 
    MsgBox "La tabella " & NomeTabella & " non esiste! Sospendo l'esecuzione."
  609 
    Exit Sub
  610 
End If
  611 
'==================> Accedo a tabella
  612 
' Apre la tabella peso collegamenti indicata come oggetto Recordset di tipo dynaset.
  613 
Set rst = dbs.OpenRecordset(NomeTabella, dbOpenTable)
  614 
' Attiva l'indice associato COORDINATE
  615 
rst.Index = "COORDINATE"
  616 
 
  617 
' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti
  618 
' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 CELLE
  619 
' TERZO STRATO collegamenti HIDDEN LAYER / BIAS NODES - vettore unidimensionale 4 CELLE
  620 
' QUARTO STRATO collegamenti STRATO OUTPUT / BIAS NODES - vettore unidimensionale 4 CELLE
  621 
'========================> Legge pesi collegamenti strato 1 tra INPUT e HIDDEN
  622 
For LocalI = 1 To NumCelleStratoInput
  623 
    For LocalJ = 1 To NumCelleStratoInput
  624 
        For LocalK = 1 To NumCelleHiddenLayer
  625 
            'Compongo la chiave da cercare
  626 
            Chiave = "1" + Format$(LocalI, "00") + Format$(LocalJ, "00") + "01" + Format$(LocalK, "00")
  627 
            'Mi porto su record corrispondente alla chiave
  628 
            rst.Seek "=", Chiave
  629 
            'Prevedo l'eventualità di un errore
  630 
            If rst.NoMatch Then
  631 
                MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  632 
            Else
  633 
                M_Strato1(LocalI, LocalJ, LocalK) = rst!Peso
  634 
            End If
  635 
        Next
  636 
    Next
  637 
Next
  638 
'========================> Legge pesi collegamenti strato 2 tra hidden e output
  639 
For LocalI = 1 To NumCelleHiddenLayer
  640 
    For LocalJ = 1 To NumCelleStratoOutput
  641 
            'Compongo la chiave da cercare
  642 
            Chiave = "201" + Format$(LocalI, "00") + "01" + Format$(LocalJ, "00")
  643 
            'Mi porto su record corrispondente alla chiave
  644 
            rst.Seek "=", Chiave
  645 
            'Prevedo l'eventualità di un errore
  646 
            If rst.NoMatch Then
  647 
                MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  648 
            Else
  649 
                M_Strato2(LocalI, LocalJ) = rst!Peso
  650 
            End If
  651 
    Next
  652 
Next
  653 
 
  654 
'========================> Legge pesi collegamenti strato 3 tra hidden e Bias Nodes
  655 
For LocalI = 1 To NumCelleHiddenLayer
  656 
    'Compongo la chiave da cercare
  657 
    Chiave = "301" + Format$(LocalI, "00") + "0000"
  658 
    'Mi porto su record corrispondente alla chiave
  659 
    rst.Seek "=", Chiave
  660 
    'Prevedo l'eventualità di un errore
  661 
    If rst.NoMatch Then
  662 
        MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  663 
    Else
  664 
        M_Strato_HID_BIAS(LocalI) = rst!Peso
  665 
    End If
  666 
Next
  667 
 
  668 
'========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes
  669 
For LocalI = 1 To NumCelleStratoOutput
  670 
    'Compongo la chiave da cercare
  671 
    Chiave = "401" + Format$(LocalI, "00") + "0000"
  672 
    'Mi porto su record corrispondente alla chiave
  673 
    rst.Seek "=", Chiave
  674 
    'Prevedo l'eventualità di un errore
  675 
    If rst.NoMatch Then
  676 
        MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  677 
    Else
  678 
        M_Strato_OUT_BIAS(LocalI) = rst!Peso
  679 
    End If
  680 
Next
  681 
 
  682 
'Chiudo recordset
  683 
rst.Close
  684 
'Azzero variabile Database
  685 
Set dbs = Nothing
  686 
 
  687 
'============> Avviso di avere provveduto
  688 
MsgBox "Tutti i pesi dei collegamenti sono stati letti dalla tabella " & NomeTabella
  689 
 
  690 
 
  691 
Exit_LeggiTutticollegamenti:
  692 
    Exit Sub
  693 
 
  694 
Err_LeggiTutticollegamenti:
  695 
     MsgBox "LeggiTuttiIPesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _
  696 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  697 
    Resume Exit_LeggiTutticollegamenti
  698 
   
  699 
End Sub
  700 
 
  701 
 
  702 
 
  703 
 
  704 
Sub ScriviTuttiIPesiCollegamenti()
  705 
On Error GoTo Err_ScriviTutticollegamenti
  706 
'=========================================
  707 
'Leggo dalle apposite matrici tutti i valori
  708 
'relativi al peso dei collegamenti, e li
  709 
'metto nella apposita tabella
  710 
'=========================================
  711 
'========================> Indici locali
  712 
Dim LocalI As Integer
  713 
Dim LocalJ As Integer
  714 
Dim LocalK As Integer
  715 
'==================> Chiave di ricerca
  716 
Dim Chiave As String
  717 
'==================> Nome Tabella PESO_COLLEGAMENTI
  718 
Dim NomeTabella As String
  719 
Dim Trovata As Boolean
  720 
Dim tdfCiclo As TableDef
  721 
'==================> Chiedo il nome della Tabella PESO_COLLEGAMENTIcollegamenti da usare
  722 
NomeTabella = UCase(InputBox(Prompt:="In che tabella scrivo il peso dei collegamenti (Tipicamente, in tabella PESO_COLLEGAMENTI)?", Title:="Scelta tabella peso collegamenti", XPos:=2000, YPos:=2000))
  723 
'==================> verifico l'esistenza della tabella
  724 
' Restituisce il riferimento al database corrente.
  725 
Set dbs = CurrentDb
  726 
' Per ora, non so se esiste
  727 
Trovata = False
  728 
' Spazzo tutte le TableDefs
  729 
For Each tdfCiclo In dbs.TableDefs
  730 
    If tdfCiclo.name = NomeTabella Then
  731 
        Trovata = True
  732 
    End If
  733 
Next
  734 
'=========================> Se la tabella peso collegamenti indicata non esiste, non proseguo
  735 
If Trovata = False Then
  736 
    Beep
  737 
    MsgBox "La tabella " & NomeTabella & " non esiste! Sospendo l'esecuzione."
  738 
    Exit Sub
  739 
End If
  740 
'==================> Accedo a tabella
  741 
' Restituisce il riferimento al database corrente.
  742 
Set dbs = CurrentDb
  743 
' Apre la tabella PESO_COLLEGAMENTI come oggetto Recordset di tipo dynaset.
  744 
Set rst = dbs.OpenRecordset(NomeTabella, dbOpenTable)
  745 
' Attiva l'indice associato COORDINATE
  746 
rst.Index = "COORDINATE"
  747 
 
  748 
' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti
  749 
' STRATO DATI DUE - HIDDEN LAYER - vettore unidimensionale 4 celle
  750 
' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 collegamenti
  751 
 
  752 
 
  753 
'========================> Scrive pesi collegamenti strato 1 - tra Input e Hidden
  754 
For LocalI = 1 To NumCelleStratoInput
  755 
    For LocalJ = 1 To NumCelleStratoInput
  756 
        For LocalK = 1 To NumCelleHiddenLayer
  757 
            'Compongo la chiave da cercare
  758 
            Chiave = "1" + Format$(LocalI, "00") + Format$(LocalJ, "00") + "01" + Format$(LocalK, "00")
  759 
            'Mi porto su record corrispondente alla chiave
  760 
            rst.Seek "=", Chiave
  761 
            'Prevedo l'eventualità di un errore
  762 
            If rst.NoMatch Then
  763 
                MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  764 
            Else
  765 
                '=============> Mi porto in modalità modifica record
  766 
                rst.Edit
  767 
                '=============> Salvo il peso della cella corrente
  768 
                rst!Peso = M_Strato1(LocalI, LocalJ, LocalK)
  769 
                '=============> Salvo il record
  770 
                rst.Update
  771 
            End If
  772 
        Next
  773 
    Next
  774 
Next
  775 
'========================> Scrive pesi collegamenti strato 2 - tra Hidden e Output
  776 
For LocalI = 1 To NumCelleHiddenLayer
  777 
    For LocalJ = 1 To NumCelleStratoOutput
  778 
            'Compongo la chiave da cercare
  779 
            Chiave = "201" + Format$(LocalI, "00") + "01" + Format$(LocalJ, "00")
  780 
            'Mi porto su record corrispondente alla chiave
  781 
            rst.Seek "=", Chiave
  782 
            'Prevedo l'eventualità di un errore
  783 
            If rst.NoMatch Then
  784 
                MsgBox "ScriviTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  785 
            Else
  786 
                '=============> Mi porto in modalità modifica record
  787 
                rst.Edit
  788 
                '=============> Salvo il peso della cella corrente
  789 
                rst!Peso = M_Strato2(LocalI, LocalJ)
  790 
                '=============> Salvo il record
  791 
                rst.Update
  792 
            End If
  793 
    Next
  794 
Next
  795 
 
  796 
'=========================
  797 
' TERZO STRATO - 4 COLLEGAMENTI
  798 
' mettono in contatto quattro celle di un vettore 1 x 4
  799 
' con le rispettive celle di BIAS NODE senza incroci
  800 
'=========================
  801 
For LocalI = 1 To NumCelleHiddenLayer
  802 
    'Compongo la chiave da cercare
  803 
    Chiave = "301" + Format$(LocalI, "00") + "0000"
  804 
    'Mi porto su record corrispondente alla chiave
  805 
    rst.Seek "=", Chiave
  806 
    'Prevedo l'eventualità di un errore
  807 
    If rst.NoMatch Then
  808 
        MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  809 
    Else
  810 
        '=============> Mi porto in modalità modifica record
  811 
        rst.Edit
  812 
        '=============> Salvo il peso della cella corrente
  813 
        rst!Peso = M_Strato_HID_BIAS(LocalI)
  814 
        '=============> Salvo il record
  815 
        rst.Update
  816 
    End If
  817 
Next
  818 
'=========================
  819 
' QUARTO STRATO - 4 COLLEGAMENTI
  820 
' mettono in contatto quattro celle di un vettore 1 x 4
  821 
' con le rispettive celle di BIAS NODE senza incroci
  822 
'=========================
  823 
 
  824 
'========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes
  825 
For LocalI = 1 To NumCelleStratoOutput
  826 
    'Compongo la chiave da cercare
  827 
    Chiave = "401" + Format$(LocalI, "00") + "0000"
  828 
    'Mi porto su record corrispondente alla chiave
  829 
    rst.Seek "=", Chiave
  830 
    'Prevedo l'eventualità di un errore
  831 
    If rst.NoMatch Then
  832 
        MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata"
  833 
    Else
  834 
        '=============> Mi porto in modalità modifica record
  835 
        rst.Edit
  836 
        '=============> Salvo il peso della cella corrente
  837 
        rst!Peso = M_Strato_OUT_BIAS(LocalI)
  838 
        '=============> Salvo il record
  839 
        rst.Update
  840 
    End If
  841 
Next
  842 
 
  843 
 
  844 
 
  845 
 
  846 
'Chiudo recordset
  847 
rst.Close
  848 
'Azzero variabile Database
  849 
Set dbs = Nothing
  850 
 
  851 
Exit_ScriviTutticollegamenti:
  852 
    Exit Sub
  853 
 
  854 
Err_ScriviTutticollegamenti:
  855 
     MsgBox "ScriviTuttiIPesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _
  856 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  857 
    Resume Exit_ScriviTutticollegamenti
  858 
   
  859 
End Sub
  860 
 
  861 
 
  862 
 
  863 
 
  864 
Sub FillMatriceInput(matricedati() As Integer)
  865 
'==================================================
  866 
'Trasferisco una matrice di dati 10 x 10 in M_INPUT
  867 
'==================================================
  868 
On Error GoTo Err_FillMatriceInput
  869 
'========================> Indici locali
  870 
Dim LocalI As Integer
  871 
Dim LocalJ As Integer
  872 
'========================> Azzera strato input
  873 
For LocalI = 1 To NumCelleStratoInput
  874 
    For LocalJ = 1 To NumCelleStratoInput
  875 
        M_INPUT(LocalI, LocalJ) = matricedati(LocalI, LocalJ)
  876 
    Next
  877 
Next
  878 
 
  879 
Exit_FillMatriceInput:
  880 
    Exit Sub
  881 
 
  882 
Err_FillMatriceInput:
  883 
     MsgBox "FillMatriceInput: Errore " & Str(Err.Number) & " generato da " _
  884 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  885 
    Resume Exit_FillMatriceInput
  886 
   
  887 
End Sub
  888 
 
  889 
 
  890 
 
  891 
 
  892 
 
  893 
 
  894 
=================================
  895 
=================================
  896 
====  F O R M ===================
  897 
=================================
  898 
=================================
  899 
 
  900 
Option Compare Database
  901 
Option Explicit
  902 
'============> Matrice che contiene quanto visualiuzzato sul display
  903 
'============> 10 x 10 a video - metodologicamente non attiene alla
  904 
'============> rete neurale, ma è un semplice stratagemma per rappresentare
  905 
'============> un problema a video
  906 
Dim MatriceVideo(10, 10) As Integer
  907 
'============> queste righe sono uno stratagemma che metodologicamente
  908 
'============> non attiene alla rete neurale, per riempire rapidamente
  909 
'============> il display 10 x 10 su video con una figura (pattern) da
  910 
'============> usare come input per la analisi o l'addestramento
  911 
Dim Righevideo(10) As String
  912 
 
  913 
 
  914 
Public Sub ColoraCella(quale As String)
  915 
'Error trap
  916 
On Error GoTo Err_ColoraCella
  917 
 
  918 
If Me(quale).BackColor = 0 Then
  919 
        Me(quale).BackColor = 16777215
  920 
Else
  921 
        Me(quale).BackColor = 0
  922 
End If
  923 
 
  924 
 
  925 
Exit_ColoraCella:
  926 
    Exit Sub
  927 
 
  928 
Err_ColoraCella:
  929 
    MsgBox "ColoraCella: Errore " & Str(Err.Number) & " generato da " _
  930 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  931 
    Resume Exit_ColoraCella
  932 
End Sub
  933 
 
  934 
 
  935 
 
  936 
 
  937 
 
  938 
Private Sub Form_Open(Cancel As Integer)
  939 
'Error trap
  940 
On Error GoTo Err_Form_Open
  941 
 
  942 
'Pulisco il riquadro video
  943 
PulisciDisplay
  944 
'Svuoto "MatriceVideo"
  945 
SvuotaMatriceVideo
  946 
 
  947 
'=========================> Tutte a "rosso" le caselle degli esiti
  948 
SvuotaEsiti
  949 
'=========================>
  950 
Me!prova.Caption = ""
  951 
 
  952 
'===========================
  953 
'Mostro spiegazione iniziale
  954 
'===========================
  955 
Me.Presentazione.Top = 0
  956 
Me.Presentazione.Left = 0
  957 
Me.Presentazione.Width = 8610
  958 
Me.Presentazione.Height = 6100
  959 
Me.Presentazione.Visible = True
  960 
 
  961 
Exit_Form_Open:
  962 
    Exit Sub
  963 
 
  964 
Err_Form_Open:
  965 
    MsgBox "FORM_OPEN: Errore " & Str(Err.Number) & " generato da " _
  966 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  967 
    Resume Exit_Form_Open
  968 
 
  969 
End Sub
  970 
 
  971 
 
  972 
 
  973 
 
  974 
Private Sub Chiudi_Click()
  975 
On Error GoTo Err_Chiudi_Click
  976 
 
  977 
    'Chiudo la form
  978 
    DoCmd.Close
  979 
 
  980 
Exit_Chiudi_Click:
  981 
    Exit Sub
  982 
 
  983 
Err_Chiudi_Click:
  984 
     MsgBox "Chiudi: Errore " & Str(Err.Number) & " generato da " _
  985 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
  986 
    Resume Exit_Chiudi_Click
  987 
   
  988 
End Sub
  989 
 
  990 
 
  991 
 
  992 
 
  993 
 
  994 
Private Sub Inizializza_Click()
  995 
On Error GoTo Err_IniClick
  996 
 
  997 
'=========================> Tutte a "rosso" le caselle degli esiti
  998 
SvuotaEsiti
  999 
 
 1000 
If MsgBox("Questa inizializzazione svuoterà gli strati della rete neurale! Procedo?", vbYesNo, "Attenzione!") = vbYes Then
 1001 
    '====================> Azzero tutte le matrici
 1002 
    AzzeraTutteLeMatrici
 1003 
    '======================================================================
 1004 
    ' Leggo da tabella PESO COLLEGAMENTI (o da altra indicata dall'utente)
 1005 
    ' i i valori da porre nelle matrici dei collegamenti
 1006 
    '======================================================================
 1007 
    '====================> Riempio i vettori dei collegamenti
 1008 
    LeggiTuttiIPesiCollegamenti
 1009 
End If
 1010 
 
 1011 
Exit_IniClick:
 1012 
    Exit Sub
 1013 
 
 1014 
Err_IniClick:
 1015 
     MsgBox "Pulsante Inizializza: Errore " & Str(Err.Number) & " generato da " _
 1016 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1017 
    Resume Exit_IniClick
 1018 
End Sub
 1019 
 
 1020 
Private Sub Presentazione_Click()
 1021 
On Error GoTo Err_Presentazione
 1022 
 
 1023 
'Faccio sparire il riquadro iniziale di testo
 1024 
 
 1025 
'per prima cosa, passo il "fuoco" da un'altra parte, così da
 1026 
'potere rendere invisibile il controllo corrente
 1027 
 
 1028 
Me.Chiudi.SetFocus
 1029 
Me.Presentazione.Visible = False
 1030 
 
 1031 
 
 1032 
Exit_Presentazione:
 1033 
    Exit Sub
 1034 
 
 1035 
Err_Presentazione:
 1036 
     MsgBox "Presentazione_Click: Errore " & Str(Err.Number) & " generato da " _
 1037 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1038 
    Resume Exit_Presentazione
 1039 
   
 1040 
End Sub
 1041 
 
 1042 
 
 1043 
 
 1044 
 
 1045 
 
 1046 
Sub PulisciDisplay()
 1047 
On Error GoTo Err_PulisciDisplay
 1048 
Dim LocalI As Integer
 1049 
Dim LocalJ As Integer
 1050 
Dim NomeCTRL As String
 1051 
 
 1052 
'============================
 1053 
' Pulisco il display 10x10
 1054 
'============================
 1055 
For LocalI = 1 To 10
 1056 
    For LocalJ = 1 To 10
 1057 
        'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION
 1058 
        NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ))
 1059 
        '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo
 1060 
        'elemento della matrice di Score
 1061 
        Me(NomeCTRL).Caption = " "
 1062 
        Me(NomeCTRL).BackColor = 16777215
 1063 
    Next
 1064 
Next
 1065 
 
 1066 
Exit_PulisciDisplay:
 1067 
    Exit Sub
 1068 
 
 1069 
Err_PulisciDisplay:
 1070 
     MsgBox "PulisciDisplay: Errore " & Str(Err.Number) & " generato da " _
 1071 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1072 
     Resume Exit_PulisciDisplay
 1073 
End Sub
 1074 
 
 1075 
 
 1076 
 
 1077 
 
 1078 
 
 1079 
Private Sub R1C1_Click()
 1080 
ColoraCella ("R1C1")
 1081 
End Sub
 1082 
 
 1083 
Private Sub R1C2_Click()
 1084 
ColoraCella ("R1C2")
 1085 
End Sub
 1086 
Private Sub R1C3_Click()
 1087 
ColoraCella ("R1C3")
 1088 
End Sub
 1089 
Private Sub R1C4_Click()
 1090 
ColoraCella ("R1C4")
 1091 
End Sub
 1092 
Private Sub R1C5_Click()
 1093 
ColoraCella ("R1C5")
 1094 
End Sub
 1095 
Private Sub R1C6_Click()
 1096 
ColoraCella ("R1C6")
 1097 
End Sub
 1098 
Private Sub R1C7_Click()
 1099 
ColoraCella ("R1C7")
 1100 
End Sub
 1101 
Private Sub R1C8_Click()
 1102 
ColoraCella ("R1C8")
 1103 
End Sub
 1104 
Private Sub R1C9_Click()
 1105 
ColoraCella ("R1C9")
 1106 
End Sub
 1107 
Private Sub R1C10_Click()
 1108 
ColoraCella ("R1C10")
 1109 
End Sub
 1110 
Private Sub R2C1_Click()
 1111 
ColoraCella ("R2C1")
 1112 
End Sub
 1113 
Private Sub R2C2_Click()
 1114 
ColoraCella ("R2C2")
 1115 
End Sub
 1116 
Private Sub R2C3_Click()
 1117 
ColoraCella ("R2C3")
 1118 
End Sub
 1119 
Private Sub R2C4_Click()
 1120 
ColoraCella ("R2C4")
 1121 
End Sub
 1122 
Private Sub R2C5_Click()
 1123 
ColoraCella ("R2C5")
 1124 
End Sub
 1125 
Private Sub R2C6_Click()
 1126 
ColoraCella ("R2C6")
 1127 
End Sub
 1128 
Private Sub R2C7_Click()
 1129 
ColoraCella ("R2C7")
 1130 
End Sub
 1131 
Private Sub R2C8_Click()
 1132 
ColoraCella ("R2C8")
 1133 
End Sub
 1134 
Private Sub R2C9_Click()
 1135 
ColoraCella ("R2C9")
 1136 
End Sub
 1137 
Private Sub R2C10_Click()
 1138 
ColoraCella ("R2C10")
 1139 
End Sub
 1140 
Private Sub R3C1_Click()
 1141 
ColoraCella ("R3C1")
 1142 
End Sub
 1143 
Private Sub R3C2_Click()
 1144 
ColoraCella ("R3C2")
 1145 
End Sub
 1146 
Private Sub R3C3_Click()
 1147 
ColoraCella ("R3C3")
 1148 
End Sub
 1149 
Private Sub R3C4_Click()
 1150 
ColoraCella ("R3C4")
 1151 
End Sub
 1152 
Private Sub R3C5_Click()
 1153 
ColoraCella ("R3C5")
 1154 
End Sub
 1155 
Private Sub R3C6_Click()
 1156 
ColoraCella ("R3C6")
 1157 
End Sub
 1158 
Private Sub R3C7_Click()
 1159 
ColoraCella ("R3C7")
 1160 
End Sub
 1161 
Private Sub R3C8_Click()
 1162 
ColoraCella ("R3C8")
 1163 
End Sub
 1164 
Private Sub R3C9_Click()
 1165 
ColoraCella ("R3C9")
 1166 
End Sub
 1167 
Private Sub R3C10_Click()
 1168 
ColoraCella ("R3C10")
 1169 
End Sub
 1170 
Private Sub R4C1_Click()
 1171 
ColoraCella ("R4C1")
 1172 
End Sub
 1173 
Private Sub R4C2_Click()
 1174 
ColoraCella ("R4C2")
 1175 
End Sub
 1176 
Private Sub R4C3_Click()
 1177 
ColoraCella ("R4C3")
 1178 
End Sub
 1179 
Private Sub R4C4_Click()
 1180 
ColoraCella ("R4C4")
 1181 
End Sub
 1182 
Private Sub R4C5_Click()
 1183 
ColoraCella ("R4C5")
 1184 
End Sub
 1185 
Private Sub R4C6_Click()
 1186 
ColoraCella ("R4C6")
 1187 
End Sub
 1188 
Private Sub R4C7_Click()
 1189 
ColoraCella ("R4C7")
 1190 
End Sub
 1191 
Private Sub R4C8_Click()
 1192 
ColoraCella ("R4C8")
 1193 
End Sub
 1194 
Private Sub R4C9_Click()
 1195 
ColoraCella ("R4C9")
 1196 
End Sub
 1197 
Private Sub R4C10_Click()
 1198 
ColoraCella ("R4C10")
 1199 
End Sub
 1200 
Private Sub R5C1_Click()
 1201 
ColoraCella ("R5C1")
 1202 
End Sub
 1203 
Private Sub R5C2_Click()
 1204 
ColoraCella ("R5C2")
 1205 
End Sub
 1206 
Private Sub R5C3_Click()
 1207 
ColoraCella ("R5C3")
 1208 
End Sub
 1209 
Private Sub R5C4_Click()
 1210 
ColoraCella ("R5C4")
 1211 
End Sub
 1212 
Private Sub R5C5_Click()
 1213 
ColoraCella ("R5C5")
 1214 
End Sub
 1215 
Private Sub R5C6_Click()
 1216 
ColoraCella ("R5C6")
 1217 
End Sub
 1218 
Private Sub R5C7_Click()
 1219 
ColoraCella ("R5C7")
 1220 
End Sub
 1221 
Private Sub R5C8_Click()
 1222 
ColoraCella ("R5C8")
 1223 
End Sub
 1224 
Private Sub R5C9_Click()
 1225 
ColoraCella ("R5C9")
 1226 
End Sub
 1227 
Private Sub R5C10_Click()
 1228 
ColoraCella ("R5C10")
 1229 
End Sub
 1230 
Private Sub R6C1_Click()
 1231 
ColoraCella ("R6C1")
 1232 
End Sub
 1233 
Private Sub R6C2_Click()
 1234 
ColoraCella ("R6C2")
 1235 
End Sub
 1236 
Private Sub R6C3_Click()
 1237 
ColoraCella ("R6C3")
 1238 
End Sub
 1239 
Private Sub R6C4_Click()
 1240 
ColoraCella ("R6C4")
 1241 
End Sub
 1242 
Private Sub R6C5_Click()
 1243 
ColoraCella ("R6C5")
 1244 
End Sub
 1245 
Private Sub R6C6_Click()
 1246 
ColoraCella ("R6C6")
 1247 
End Sub
 1248 
Private Sub R6C7_Click()
 1249 
ColoraCella ("R6C7")
 1250 
End Sub
 1251 
Private Sub R6C8_Click()
 1252 
ColoraCella ("R6C8")
 1253 
End Sub
 1254 
Private Sub R6C9_Click()
 1255 
ColoraCella ("R6C9")
 1256 
End Sub
 1257 
Private Sub R6C10_Click()
 1258 
ColoraCella ("R6C10")
 1259 
End Sub
 1260 
Private Sub R7C1_Click()
 1261 
ColoraCella ("R7C1")
 1262 
End Sub
 1263 
Private Sub R7C2_Click()
 1264 
ColoraCella ("R7C2")
 1265 
End Sub
 1266 
Private Sub R7C3_Click()
 1267 
ColoraCella ("R7C3")
 1268 
End Sub
 1269 
Private Sub R7C4_Click()
 1270 
ColoraCella ("R7C4")
 1271 
End Sub
 1272 
Private Sub R7C5_Click()
 1273 
ColoraCella ("R7C5")
 1274 
End Sub
 1275 
Private Sub R7C6_Click()
 1276 
ColoraCella ("R7C6")
 1277 
End Sub
 1278 
Private Sub R7C7_Click()
 1279 
ColoraCella ("R7C7")
 1280 
End Sub
 1281 
Private Sub R7C8_Click()
 1282 
ColoraCella ("R7C8")
 1283 
End Sub
 1284 
Private Sub R7C9_Click()
 1285 
ColoraCella ("R7C9")
 1286 
End Sub
 1287 
Private Sub R7C10_Click()
 1288 
ColoraCella ("R7C10")
 1289 
End Sub
 1290 
Private Sub R8C1_Click()
 1291 
ColoraCella ("R8C1")
 1292 
End Sub
 1293 
Private Sub R8C2_Click()
 1294 
ColoraCella ("R8C2")
 1295 
End Sub
 1296 
Private Sub R8C3_Click()
 1297 
ColoraCella ("R8C3")
 1298 
End Sub
 1299 
Private Sub R8C4_Click()
 1300 
ColoraCella ("R8C4")
 1301 
End Sub
 1302 
Private Sub R8C5_Click()
 1303 
ColoraCella ("R8C5")
 1304 
End Sub
 1305 
Private Sub R8C6_Click()
 1306 
ColoraCella ("R8C6")
 1307 
End Sub
 1308 
Private Sub R8C7_Click()
 1309 
ColoraCella ("R8C7")
 1310 
End Sub
 1311 
Private Sub R8C8_Click()
 1312 
ColoraCella ("R8C8")
 1313 
End Sub
 1314 
Private Sub R8C9_Click()
 1315 
ColoraCella ("R8C9")
 1316 
End Sub
 1317 
Private Sub R8C10_Click()
 1318 
ColoraCella ("R8C10")
 1319 
End Sub
 1320 
Private Sub R9C1_Click()
 1321 
ColoraCella ("R9C1")
 1322 
End Sub
 1323 
Private Sub R9C2_Click()
 1324 
ColoraCella ("R9C2")
 1325 
End Sub
 1326 
Private Sub R9C3_Click()
 1327 
ColoraCella ("R9C3")
 1328 
End Sub
 1329 
Private Sub R9C4_Click()
 1330 
ColoraCella ("R9C4")
 1331 
End Sub
 1332 
Private Sub R9C5_Click()
 1333 
ColoraCella ("R9C5")
 1334 
End Sub
 1335 
Private Sub R9C6_Click()
 1336 
ColoraCella ("R9C6")
 1337 
End Sub
 1338 
Private Sub R9C7_Click()
 1339 
ColoraCella ("R9C7")
 1340 
End Sub
 1341 
Private Sub R9C8_Click()
 1342 
ColoraCella ("R9C8")
 1343 
End Sub
 1344 
Private Sub R9C9_Click()
 1345 
ColoraCella ("R9C9")
 1346 
End Sub
 1347 
Private Sub R9C10_Click()
 1348 
ColoraCella ("R9C10")
 1349 
End Sub
 1350 
Private Sub R10C1_Click()
 1351 
ColoraCella ("R10C1")
 1352 
End Sub
 1353 
Private Sub R10C2_Click()
 1354 
ColoraCella ("R10C2")
 1355 
End Sub
 1356 
Private Sub R10C3_Click()
 1357 
ColoraCella ("R10C3")
 1358 
End Sub
 1359 
Private Sub R10C4_Click()
 1360 
ColoraCella ("R10C4")
 1361 
End Sub
 1362 
Private Sub R10C5_Click()
 1363 
ColoraCella ("R10C5")
 1364 
End Sub
 1365 
Private Sub R10C6_Click()
 1366 
ColoraCella ("R10C6")
 1367 
End Sub
 1368 
Private Sub R10C7_Click()
 1369 
ColoraCella ("R10C7")
 1370 
End Sub
 1371 
Private Sub R10C8_Click()
 1372 
ColoraCella ("R10C8")
 1373 
End Sub
 1374 
Private Sub R10C9_Click()
 1375 
ColoraCella ("R10C9")
 1376 
End Sub
 1377 
Private Sub R10C10_Click()
 1378 
ColoraCella ("R10C10")
 1379 
End Sub
 1380 
 
 1381 
 
 1382 
 
 1383 
 
 1384 
Sub FillMatriceVideoX()
 1385 
On Error GoTo Err_FillX
 1386 
'====================================
 1387 
'Carico un pattern a X in RIGHEVIDEO
 1388 
'====================================
 1389 
Righevideo(1) = "1100000011"
 1390 
Righevideo(2) = "0110000110"
 1391 
Righevideo(3) = "0011001100"
 1392 
Righevideo(4) = "0001111000"
 1393 
Righevideo(5) = "0000110000"
 1394 
Righevideo(6) = "0000110000"
 1395 
Righevideo(7) = "0001111000"
 1396 
Righevideo(8) = "0011001100"
 1397 
Righevideo(9) = "0110000110"
 1398 
Righevideo(10) = "1100000011"
 1399 
'===============================================
 1400 
' Passo tale pattern nella matrice MATRICEVIDEO
 1401 
'===============================================
 1402 
FillMatriceVideoconRigheVideo
 1403 
'===============================================
 1404 
' Riverso sul display 10 x 10 MATRICEVIDEO
 1405 
'===============================================
 1406 
MostraMatriceVideo
 1407 
 
 1408 
Exit_FillX:
 1409 
    Exit Sub
 1410 
 
 1411 
Err_FillX:
 1412 
     MsgBox "FillMatriceVideoX: Errore " & Str(Err.Number) & " generato da " _
 1413 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1414 
     Resume Exit_FillX
 1415 
End Sub
 1416 
 
 1417 
 
 1418 
 
 1419 
Sub FillMatriceVideoO()
 1420 
On Error GoTo Err_FillO
 1421 
'====================================
 1422 
'Carico un pattern a O in RIGHEVIDEO
 1423 
'====================================
 1424 
Righevideo(1) = "0000110000"
 1425 
Righevideo(2) = "0001111000"
 1426 
Righevideo(3) = "0011001100"
 1427 
Righevideo(4) = "0110000110"
 1428 
Righevideo(5) = "1100000011"
 1429 
Righevideo(6) = "1100000011"
 1430 
Righevideo(7) = "0110000110"
 1431 
Righevideo(8) = "0011001100"
 1432 
Righevideo(9) = "0001111000"
 1433 
Righevideo(10) = "0000110000"
 1434 
'===============================================
 1435 
' Passo tale pattern nella matrice MATRICEVIDEO
 1436 
'===============================================
 1437 
FillMatriceVideoconRigheVideo
 1438 
'===============================================
 1439 
' Riverso sul display 10 x 10 MATRICEVIDEO
 1440 
'===============================================
 1441 
MostraMatriceVideo
 1442 
 
 1443 
Exit_FillO:
 1444 
    Exit Sub
 1445 
 
 1446 
Err_FillO:
 1447 
     MsgBox "FillMatriceVideoO: Errore " & Str(Err.Number) & " generato da " _
 1448 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1449 
     Resume Exit_FillO
 1450 
End Sub
 1451 
 
 1452 
 
 1453 
 
 1454 
Sub FillMatriceVideoPiu()
 1455 
On Error GoTo Err_FillPiu
 1456 
'====================================
 1457 
'Carico un pattern a + in RIGHEVIDEO
 1458 
'====================================
 1459 
Righevideo(1) = "0001111000"
 1460 
Righevideo(2) = "0001111000"
 1461 
Righevideo(3) = "0001111000"
 1462 
Righevideo(4) = "1111111111"
 1463 
Righevideo(5) = "1111111111"
 1464 
Righevideo(6) = "1111111111"
 1465 
Righevideo(7) = "1111111111"
 1466 
Righevideo(8) = "0001111000"
 1467 
Righevideo(9) = "0001111000"
 1468 
Righevideo(10) = "0001111000"
 1469 
'===============================================
 1470 
' Passo tale pattern nella matrice MATRICEVIDEO
 1471 
'===============================================
 1472 
FillMatriceVideoconRigheVideo
 1473 
'===============================================
 1474 
' Riverso sul display 10 x 10 MATRICEVIDEO
 1475 
'===============================================
 1476 
MostraMatriceVideo
 1477 
 
 1478 
Exit_FillPiu:
 1479 
    Exit Sub
 1480 
 
 1481 
Err_FillPiu:
 1482 
     MsgBox "FillMatriceVideoPiu: Errore " & Str(Err.Number) & " generato da " _
 1483 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1484 
     Resume Exit_FillPiu
 1485 
End Sub
 1486 
 
 1487 
 
 1488 
 
 1489 
 
 1490 
Sub FillMatriceVideoQuad()
 1491 
On Error GoTo Err_FillQuad
 1492 
'==========================================
 1493 
'Carico un pattern a quadrato in RIGHEVIDEO
 1494 
'==========================================
 1495 
Righevideo(1) = "1111111111"
 1496 
Righevideo(2) = "1111111111"
 1497 
Righevideo(3) = "1100000011"
 1498 
Righevideo(4) = "1100000011"
 1499 
Righevideo(5) = "1100000011"
 1500 
Righevideo(6) = "1100000011"
 1501 
Righevideo(7) = "1100000011"
 1502 
Righevideo(8) = "1100000011"
 1503 
Righevideo(9) = "1111111111"
 1504 
Righevideo(10) = "1111111111"
 1505 
'===============================================
 1506 
' Passo tale pattern nella matrice MATRICEVIDEO
 1507 
'===============================================
 1508 
FillMatriceVideoconRigheVideo
 1509 
'===============================================
 1510 
' Riverso sul display 10 x 10 MATRICEVIDEO
 1511 
'===============================================
 1512 
MostraMatriceVideo
 1513 
 
 1514 
Exit_FillQuad:
 1515 
    Exit Sub
 1516 
 
 1517 
Err_FillQuad:
 1518 
     MsgBox "FillMatriceVideoQuad: Errore " & Str(Err.Number) & " generato da " _
 1519 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1520 
     Resume Exit_FillQuad
 1521 
End Sub
 1522 
 
 1523 
 
 1524 
 
 1525 
 
 1526 
Sub FillMatriceVideoconRigheVideo()
 1527 
On Error GoTo Err_FillMatVideoRigheVideo
 1528 
Dim LocalI As Integer
 1529 
Dim LocalJ As Integer
 1530 
Dim pezzo As String
 1531 
'========================================================
 1532 
' Riverso il contenuto di "RIGHEVIDEO" in "MATRICEVIDEO"
 1533 
' RIGHEVIDEO contiene il disegno di un pattern che previa
 1534 
' eventuale modifica riverserò in matrice di input per
 1535 
' addestramento o analisi
 1536 
'========================================================
 1537 
For LocalI = 1 To 10
 1538 
    For LocalJ = 1 To 10
 1539 
        pezzo = Mid$(Righevideo(LocalI), LocalJ, 1)
 1540 
        If pezzo = "1" Then
 1541 
            MatriceVideo(LocalI, LocalJ) = 1
 1542 
        Else
 1543 
            MatriceVideo(LocalI, LocalJ) = 0
 1544 
        End If
 1545 
    Next
 1546 
Next
 1547 
 
 1548 
Exit_FillMatVideoRigheVideo:
 1549 
    Exit Sub
 1550 
 
 1551 
Err_FillMatVideoRigheVideo:
 1552 
     MsgBox "FillMatriceVideoconRigheVideo: Errore " & Str(Err.Number) & " generato da " _
 1553 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1554 
     Resume Exit_FillMatVideoRigheVideo
 1555 
End Sub
 1556 
 
 1557 
 
 1558 
 
 1559 
 
 1560 
Sub MostraMatriceVideo()
 1561 
On Error GoTo Err_MostraMatriceVideo
 1562 
Dim LocalI As Integer
 1563 
Dim LocalJ As Integer
 1564 
Dim NomeControllo As String
 1565 
'========================================================
 1566 
' Rappresento sul display 10 x 10 il pattern memorizzato
 1567 
' in MatriceVideo - 1 = pixel nero, 0 = pixel bianco
 1568 
'========================================================
 1569 
For LocalI = 1 To 10
 1570 
    For LocalJ = 1 To 10
 1571 
        NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ))
 1572 
        If MatriceVideo(LocalI, LocalJ) = 1 Then
 1573 
            Me(NomeControllo).BackColor = 0
 1574 
        Else
 1575 
            Me(NomeControllo).BackColor = 16777215
 1576 
        End If
 1577 
    Next
 1578 
Next
 1579 
 
 1580 
Exit_MostraMatriceVideo:
 1581 
    Exit Sub
 1582 
 
 1583 
Err_MostraMatriceVideo:
 1584 
     MsgBox "MostraMatriceVideo: Errore " & Str(Err.Number) & " generato da " _
 1585 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1586 
     Resume Exit_MostraMatriceVideo
 1587 
End Sub
 1588 
 
 1589 
 
 1590 
 
 1591 
Private Sub SalvaE2_Click()
 1592 
On Error GoTo Err_SalvaE2_Click
 1593 
'======> Per risposta utente
 1594 
Dim strInput As String
 1595 
'======> Per parametro da passare con codice pattern
 1596 
Dim ValInput As Integer
 1597 
'= 1 = "X"
 1598 
'= 2 = "O"
 1599 
'= 3 = "+"
 1600 
'= 4 = "quadrato"
 1601 
 
 1602 
'=\
 1603 
'==> Richiedo a quale dei patterns di riferimento
 1604 
'==> è da ricondurre l'esempio
 1605 
'=/
 1606 
Do
 1607 
strInput = InputBox(Prompt:="A quale pattern è da ricondurre l'esempio:(X),(O),(C)roce) o (Q)uadrato?", Title:="Scelta del pattern rappresentato", XPos:=2000, YPos:=2000)
 1608 
    Select Case strInput
 1609 
        Case "X"
 1610 
            ValInput = 1
 1611 
            Exit Do
 1612 
        Case "O"
 1613 
            ValInput = 2
 1614 
            Exit Do
 1615 
        Case "C"
 1616 
            ValInput = 3
 1617 
            Exit Do
 1618 
        Case "Q"
 1619 
            ValInput = 4
 1620 
            Exit Do
 1621 
        Case Else
 1622 
            Beep
 1623 
    End Select
 1624 
Loop
 1625 
'=\
 1626 
'==> salvo quanto su display in un record della tabella ESEMPI
 1627 
'=/
 1628 
SalvaEsempio ValInput
 1629 
 
 1630 
Exit_SalvaE2_Click:
 1631 
    Exit Sub
 1632 
 
 1633 
Err_SalvaE2_Click:
 1634 
     MsgBox "SalvaE2_Click: Errore " & Str(Err.Number) & " generato da " _
 1635 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1636 
     Resume Exit_SalvaE2_Click
 1637 
End Sub
 1638 
 
 1639 
Private Sub SelectPattern_Click()
 1640 
On Error GoTo Err_SPCLICK
 1641 
Select Case SelectPattern.Value
 1642 
    Case 1
 1643 
        FillMatriceVideoX
 1644 
    Case 2
 1645 
        FillMatriceVideoO
 1646 
    Case 3
 1647 
        FillMatriceVideoPiu
 1648 
    Case 4
 1649 
        FillMatriceVideoQuad
 1650 
End Select
 1651 
 
 1652 
'=============> resetto per prossima scelta
 1653 
SelectPattern.DefaultValue = 0
 1654 
 
 1655 
Exit_SPCLICK:
 1656 
    Exit Sub
 1657 
 
 1658 
Err_SPCLICK:
 1659 
     MsgBox "SelectPattern_Click: Errore " & Str(Err.Number) & " generato da " _
 1660 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1661 
     Resume Exit_SPCLICK
 1662 
 
 1663 
End Sub
 1664 
 
 1665 
 
 1666 
 
 1667 
 
 1668 
 
 1669 
 
 1670 
Sub FillMatriceVideoconDisplay()
 1671 
On Error GoTo Err_FillMatVideoDisplay
 1672 
Dim LocalI As Integer
 1673 
Dim LocalJ As Integer
 1674 
Dim NomeControllo As String
 1675 
'========================================================
 1676 
' Riverso il contenuto del display 10x10 in "MATRICEVIDEO"
 1677 
' le eventuali modifiche apportate al pattern saranno così
 1678 
' rappresentate in MATRICEVIDEO
 1679 
' Pixel nero = 1 - Pixel bianco = 0
 1680 
'========================================================
 1681 
For LocalI = 1 To 10
 1682 
    For LocalJ = 1 To 10
 1683 
        NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ))
 1684 
        If Me(NomeControllo).BackColor = 0 Then
 1685 
            MatriceVideo(LocalI, LocalJ) = 1
 1686 
        Else
 1687 
            MatriceVideo(LocalI, LocalJ) = 0
 1688 
        End If
 1689 
    Next
 1690 
Next
 1691 
 
 1692 
Exit_FillMatVideoDisplay:
 1693 
    Exit Sub
 1694 
 
 1695 
Err_FillMatVideoDisplay:
 1696 
     MsgBox "FillMatriceVideoDisplay: Errore " & Str(Err.Number) & " generato da " _
 1697 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1698 
     Resume Exit_FillMatVideoDisplay
 1699 
End Sub
 1700 
 
 1701 
Sub SvuotaMatriceVideo()
 1702 
On Error GoTo Err_SvuotaMatriceVideo
 1703 
'=====================> Indici locali
 1704 
Dim LocalI As Integer
 1705 
Dim LocalJ As Integer
 1706 
 
 1707 
'========================================================
 1708 
' inizializzo MATRICEVIDEO a zero
 1709 
'========================================================
 1710 
For LocalI = 1 To 10
 1711 
    For LocalJ = 1 To 10
 1712 
            MatriceVideo(LocalI, LocalJ) = 0
 1713 
    Next
 1714 
Next
 1715 
 
 1716 
Exit_SvuotaMatriceVideo:
 1717 
    Exit Sub
 1718 
 
 1719 
Err_SvuotaMatriceVideo:
 1720 
     MsgBox "SvuotaMatriceVideo: Errore " & Str(Err.Number) & " generato da " _
 1721 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 1722 
     Resume Exit_SvuotaMatriceVideo
 1723 
End Sub
 1724 
 
 1725 
 
 1726 
 
 1727 
 
 1728 
 
 1729 
 
 1730 
 
 1731 
 
 1732 
 
 1733 
Private Sub TRAINING_Click()
 1734 
On Error GoTo Err_TRAINING_Click
 1735 
'=========================> Indice Locale per passare da un record esempi all'altro
 1736 
Dim ContaRecords As Integer
 1737 
'=========================> Per input utente
 1738 
Dim strInput As String
 1739 
'=====================> Indici locali
 1740 
Dim IInput As Integer ' due coordinate per l'input layer bidimensionale
 1741 
Dim JInput As Integer ' due coordinate per l'input layer bidimensionale
 1742 
Dim IHidden As Integer  ' una sola coordinata per l'hidden layer monodimensionale
 1743 
Dim IOutput As Integer  ' una sola coordinata per l'output layer monodimensionale
 1744 
Dim Sommatoria As Double 'la sommatoria dei valori convergenti sulla mia cella
 1745 
Dim SommaErrori As Double 'la somma degli errori misurati, per decidere se c'è da
 1746 
                          ' correggere oppure no
 1747 
Dim ErroreQuestaCella As Double 'errore della cella corrente
 1748 
Dim ValoreCellaAMonte As Double ' significato "intuitivo"
 1749 
Dim Corr_Di_prima As Double ' la correzione precedentemente applicata al peso corrente
 1750 
Dim DeltaPeso As Double 'differenza da applicare ai pesi
 1751 
Dim Aggiungi As Double 'variabile di transito
 1752 
Dim BIAS As Double 'variabile di transito BIAS cella corrente
 1753 
Dim ESPONENTE As Double 'variabile di transito BIAS
 1754 
'=====================> Ospita il numero del risultato
 1755 
Dim NRisultato As Integer
 1756 
'=====================> Ospita il valore del risultato
 1757 
Dim ValRisultato As Double
 1758 
'=====================> variabile temporanea per calcolo derivate
 1759 
Dim Temp As Double
 1760 
'=====================> Ospita il valore ricevuto dalla
 1761 
'=====================> singola connessione verso di me
 1762 
Dim RicevoDaNodoCorrente As Double
 1763 
'=========================> Su quale set di esempi si svilupperà il training
 1764 
Dim SetEsempi As String
 1765 
 
 1766 
'=========================> Quanti records contiene
 1767 
Dim NumRecEsempi As String
 1768 
Dim EsempiFatti As Integer
 1769 
 
 1770 
If MsgBox("Se avete dati significativi in tabella PESO_COLLEGAMENTI, fermatevi e salvate la tabella PESO_COLLEGAMENTI con altro nome. Proseguo?", vbYesNo, "Attenzione!") = vbYes Then
 1771 
    If MsgBox("Confermate la rigenerazione della tabella PESO_COLLEGAMENTI con pesi random nel range - 0.001 / + 0.001?", vbYesNo, "Attenzione!") = vbYes Then
 1772 
        '====================> Ricreo la tabella peso_collegamenti
 1773 
        PredisponiTabellaPesoCollegamenti 0.001
 1774 
    Else
 1775 
        Exit Sub
 1776 
    End If
 1777 
Else
 1778 
    Exit Sub
 1779 
End If
 1780 
'=========================> Leggo in memoria la tabella pesi rigenerata
 1781 
'====================> Riempio i vettori dei collegamenti
 1782 
LeggiTuttiIPesiCollegamenti
 1783 
 
 1784 
'=========================> DEFINISCO IL NOME DEL SET DI ESEMPI
 1785 
SetEsempi = "ESEMPI"
 1786 
 
 1787 
'===============================================================>
 1788 
'Apre la tabella scelta come oggetto Recordset di tipo dynaset.
 1789 
' Restituisce il riferimento al database corrente.
 1790 
Set dbs = CurrentDb
 1791 
Set rst = dbs.OpenRecordset(SetEsempi, dbOpenTable)
 1792 
'==============> Vedo quanti esempi dovrò esaminare
 1793 
rst.MoveLast
 1794 
NumRecEsempi = rst.RecordCount
 1795 
'==============> Chiudo la tabella: sarà LeggiEsempio a riaprirla ogni volta
 1796 
rst.Close
 1797 
'Debug
 1798 
Me!prova.Caption = Str$(NumRecEsempi)
 1799 
 
 1800 
'==\
 1801 
'===> Promemoria sui nomi delle matrici
 1802 
'==/
 1803 
' M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer
 1804 
' M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double
 1805 
' M_HIDDEN(NumCelleHiddenLayer) As Double
 1806 
' M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double
 1807 
' M_OUTPUT(NumCelleStratoOutput) As Integer
 1808 
'la matrice con i BIAS NODES per le celle di HIDDEN LAYER
 1809 
' M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double
 1810 
'la matrice con i BIAS NODES per le celle di STRATO OUTPUT
 1811 
' M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double
 1812 
'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES
 1813 
' M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double
 1814 
'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES
 1815 
' M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double
 1816 
'=========================================================
 1817 
'Per RETROPROPAGAZIONE ERRORI
 1818 
'=========================================================
 1819 
'cosa mi aspetto di ottenere in output
 1820 
'Public M_OUTPUT_DESIDERATI(NumCelleStratoOutput) As Double
 1821 
'ultimi delta applicati ai pesi strato 1
 1822 
'Public M_ULTIMI_DELTAW_S1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer)  As Double
 1823 
'ultimi delta applicati ai pesi strato 2
 1824 
'Public M_ULTIMI_DELTAW_S2(NumCelleHiddenLayer, NumCelleStratoOutput)  As Double
 1825 
'ultimi delta applicati ai pesi tra HIDDEN e BIAS CELL
 1826 
'Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer)  As Double
 1827 
'ultimi delta applicati ai pesi tra OUTPUT e BIAS CELL
 1828 
'Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput)  As Double
 1829 
 
 1830 
'==============================================================
 1831 
'===\
 1832 
'====> INIZIO - APPLICARE PRIMA DELL'INIZIO DELLA SESSIONE DI TRAINING
 1833 
'===/
 1834 
'==============================================================
 1835 
'Devo preservare in apposite matrici il valore ultimo della correzione
 1836 
'apportata al peso della connessione. Per consentire di referenziare
 1837 
'fin dal primo esempio questa matrice vi pongo valori nulli.
 1838 
'==============================================================
 1839 
'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi
 1840 
'tra INPUT e HIDDEN (strato 1)
 1841 
'==============================================================
 1842 
For IInput = 1 To NumCelleStratoInput
 1843 
    For JInput = 1 To NumCelleStratoInput
 1844 
        For IHidden = 1 To NumCelleHiddenLayer
 1845 
            M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden) = 0
 1846 
        Next
 1847 
    Next
 1848 
Next
 1849 
'==============================================================
 1850 
'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi
 1851 
'tra HIDDEN e OUTPUT (strato 2)
 1852 
'==============================================================
 1853 
For IHidden = 1 To NumCelleHiddenLayer
 1854 
    For IOutput = 1 To NumCelleStratoOutput
 1855 
        M_ULTIMI_DELTAW_S2(IHidden, IOutput) = 0
 1856 
    Next
 1857 
Next
 1858 
'===============================================================
 1859 
'Inizializzazione a 1 dei Bias Nodes
 1860 
'==============================================================
 1861 
For IHidden = 1 To NumCelleHiddenLayer
 1862 
    M_BiasNodes_HIDDEN(IHidden) = 1
 1863 
Next
 1864 
For IOutput = 1 To NumCelleStratoOutput
 1865 
    M_BiasNodes_OUTPUT(IOutput) = 1
 1866 
Next
 1867 
'===============================================================
 1868 
'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi
 1869 
'tra HIDDEN e BIAS CELL, e tra OUTPUT e BIAS CELL
 1870 
'==============================================================
 1871 
For IHidden = 1 To NumCelleHiddenLayer
 1872 
    M_ULTIMI_DELTAW_HB(IHidden) = 0
 1873 
Next
 1874 
For IOutput = 1 To NumCelleStratoOutput
 1875 
    M_ULTIMI_DELTAW_OB(IOutput) = 0
 1876 
Next
 1877 
 
 1878 
'==============================================================
 1879 
'===\
 1880 
'====> FINE - APPLICARE PRIMA DELL'INIZIO DELLA SESSIONE DI TRAINING
 1881 
'===/
 1882 
'==============================================================
 1883 
 
 1884 
'============================================================================
 1885 
'==================\                                  /======================
 1886 
'===================> INIZIO CICLO DI ADDESTRAMENTO  <=======================
 1887 
'==================/                                  \======================
 1888 
'============================================================================
 1889 
EsempiFatti = 0
 1890 
'=======================================>
 1891 
' LOOP DA RIPETERE PER OGNI ESEMPIO
 1892 
'=======================================>
 1893 
For ContaRecords = 1 To NumRecEsempi
 1894 
    '===> Incremento il conteggio degli esempi fatti
 1895 
    EsempiFatti = EsempiFatti + 1
 1896 
    Me!prova.Caption = Str$(NumRecEsempi - EsempiFatti)
 1897 
    Me!prova.Visible = True
 1898 
    Me.Repaint
 1899 
      
 1900 
    '===> Mi porto al Contarecords-esimo record (meno 1 perchè il primo record è 0)
 1901 
    '===> e porto su display 10 x 10 la relativa configurazione. Il risultato
 1902 
    '===> previsto mi viene restituito in NRisultato
 1903 
    NRisultato = LeggiEsempio(ContaRecords)
 1904 
    '=========================> Tutte a "rosso" le caselle degli esiti
 1905 
    SvuotaEsiti
 1906 
    '=========================> Azzero gli output desiderati
 1907 
    For IOutput = 1 To NumCelleStratoOutput
 1908 
        M_OUTPUT_DESIDERATI(IOutput) = 0
 1909 
    Next
 1910 
    '==========================================
 1911 
    '= Mostro il risultato
 1912 
    '= E VALORIZZO AD 1 LA SOLA CELLA DELLA M_OUTPUT_DESIDERATI
 1913 
    '= RELATIVA AL RISULTATO ATTESO
 1914 
    '= 1 = "X"
 1915 
    '= 2 = "O"
 1916 
    '= 3 = "+"
 1917 
    '= 4 = "quadrato"
 1918 
    '==========================================
 1919 
    Select Case NRisultato
 1920 
        Case 1
 1921 
            Me!ChiedoICS.BackColor = VERDE
 1922 
            M_OUTPUT_DESIDERATI(1) = 1
 1923 
        Case 2
 1924 
            Me!ChiedoCERCHIO.BackColor = VERDE
 1925 
            M_OUTPUT_DESIDERATI(2) = 1
 1926 
        Case 3
 1927 
            Me!ChiedoCROCE.BackColor = VERDE
 1928 
            M_OUTPUT_DESIDERATI(3) = 1
 1929 
        Case 4
 1930 
            Me!ChiedoQUADRATO.BackColor = VERDE
 1931 
            M_OUTPUT_DESIDERATI(4) = 1
 1932 
    End Select
 1933 
    '=========================> Salvo la configurazione del display in MATRICEVIDEO
 1934 
    FillMatriceVideoconDisplay
 1935 
    '=========================> Trasferisco MATRICEVIDEO in MATRICE INPUT M_INPUT
 1936 
    ' Perchè non trasferisco direttamente il "display" 10 x 10 in MATRICEINPUT
 1937 
    ' senza avvalermi della matrice di transito MATRICEVIDEO?
 1938 
    ' Potrei benissimo farlo in un colpo solo. Visto che comunque ho a
 1939 
    ' disposizione MatriceVideo, la sfrutto per creare una routine che accetta una
 1940 
    ' matrice come parametro
 1941 
    FillMatriceInput MatriceVideo
 1942 
    '==========================================
 1943 
    '= PER OGNI ESEMPIO,
 1944 
    '= Innanzitutto l'addestramento comprende
 1945 
    '= un ciclo di analisi "normale", del quale
 1946 
    '= valuto il risultato
 1947 
    '==========================================
 1948 
    Me.Refresh
 1949 
   
 1950 
    'Provvisorio!
 1951 
    'Beep
 1952 
    'MsgBox "Altro esempio"
 1953 
    'GoTo Oltre
 1954 
 
 1955 
    '==============================================================================
 1956 
    '==================\                                    /======================
 1957 
    '===================> INIZIO NORMALE CICLO DI ANALISI  <=======================
 1958 
    '==================/                                    \======================
 1959 
    '==============================================================================
 1960 
    'Stop
 1961 
    '=================================
 1962 
    '= Fase 1 - spazzata hidden layer
 1963 
    '=================================
 1964 
    '==============> Per ogni nodo dell'hidden layer
 1965 
    For IHidden = 1 To NumCelleHiddenLayer
 1966 
        '===============> Azzero la Sommatoria dei valori che
 1967 
        '===============> determinerà l'output (=il valore) del
 1968 
        '===============> mio neurone di hidden layer
 1969 
        Sommatoria = 0
 1970 
        '===============> Per tutti i collegamenti provenienti dall'input layer che convergono
 1971 
        '===============> sulla mia cella (=NODO) di hidden layer
 1972 
        For IInput = 1 To NumCelleStratoInput
 1973 
            For JInput = 1 To NumCelleStratoInput
 1974 
                '===============> Localizzo il collegamento tra la mia cella
 1975 
                '===============> di hidden layer e la cella corrente del
 1976 
                '===============> layer di input
 1977 
                RicevoDaNodoCorrente = M_INPUT(IInput, JInput) * M_Strato1(IInput, JInput, IHidden)
 1978 
                '===\
 1979 
                '====> Aggiungo alla sommatoria il valore ricevuto
 1980 
                '====> dalla connessione convergente verso il mio neurone
 1981 
                '===/
 1982 
                Sommatoria = Sommatoria + RicevoDaNodoCorrente
 1983 
       
 1984 
            Next
 1985 
        Next
 1986 
        '==\
 1987 
        '===> Valuto l'apporto del Bias Node specifico della mia cella
 1988 
        '==/
 1989 
        BIAS = M_BiasNodes_HIDDEN(IHidden) * M_Strato_HID_BIAS(IHidden)
 1990 
        '==\
 1991 
        '===> Calcolo l'esponente a cui elevare "e"
 1992 
        '===> -1 è la "costante di ripidità" della sigmoide
 1993 
        '==/
 1994 
        ESPONENTE = -1 * (Sommatoria - BIAS)
 1995 
       
 1996 
        '===\
 1997 
        '====> Memorizzo nel nodo corrente il valore ottenuto
 1998 
        '====> a partire da "Sommatoria", secondo il metodo seguente
 1999 
        '===/
 2000 
        M_HIDDEN(IHidden) = 1 / (1 + Exp(ESPONENTE))
 2001 
   
 2002 
    Next
 2003 
 
 2004 
 
 2005 
    '=================================
 2006 
    '= Fase 2 - spazzata layer output
 2007 
    '=================================
 2008 
    '==============> Per ogni nodo dello strato di output
 2009 
    For IOutput = 1 To NumCelleStratoOutput
 2010 
        '===============> Azzero la Sommatoria dei valori che
 2011 
        '===============> determinerà l'output (=il valore) del
 2012 
        '===============> mio neurone di output
 2013 
        Sommatoria = 0
 2014 
        '===============> Per tutti i collegamenti provenienti dall'hidden layer che convergono
 2015 
        '===============> sulla mia cella (=NODO) di output layer
 2016 
        For IHidden = 1 To NumCelleHiddenLayer
 2017 
            '===============> Localizzo il collegamento tra la mia cella
 2018 
            '===============> di output layer e la cella corrente dell'
 2019 
            '===============> hidden layer
 2020 
 
 2021 
            RicevoDaNodoCorrente = M_HIDDEN(IHidden) * M_Strato2(IHidden, IOutput)
 2022 
           
 2023 
            '===\
 2024 
            '====> Aggiungo alla sommatoria il valore ricevuto
 2025 
            '====> dalla connessione convergente verso il mio neurone
 2026 
            '===/
 2027 
            Sommatoria = Sommatoria + RicevoDaNodoCorrente
 2028 
        Next
 2029 
       
 2030 
        '==\
 2031 
        '===> Valuto l'apporto del Bias Node specifico della mia cella
 2032 
        '==/
 2033 
        BIAS = M_BiasNodes_OUTPUT(IOutput) * M_Strato_OUT_BIAS(IOutput)
 2034 
        '==\
 2035 
        '===> Calcolo l'esponente a cui elevare "e"
 2036 
        '===> -1 è la "costante di ripidità" della sigmoide
 2037 
        '==/
 2038 
        ESPONENTE = -1 * (Sommatoria - BIAS)
 2039 
       
 2040 
        '===\
 2041 
        '====> Memorizzo nel nodo corrente il valore ottenuto
 2042 
        '====> a partire da "Sommatoria", secondo il metodo seguente
 2043 
        '===/
 2044 
        M_OUTPUT(IOutput) = 1 / (1 + Exp(ESPONENTE))
 2045 
       
 2046 
    Next
 2047 
 
 2048 
    '========> DEBUG
 2049 
    '========> In attesa di potere effettuare il training,
 2050 
    '========> restituisco un risultato a caso
 2051 
 
 2052 
    '====================================================
 2053 
    '= Determino il risultato spazzando i nodi (=CELLE) di output
 2054 
    '= "The winner takes it all" - la risposta è il nodo
 2055 
    '= con il valore più elevato
 2056 
    '====================================================
 2057 
    '===============> Azzero il risultato
 2058 
    NRisultato = 0
 2059 
    ValRisultato = 0
 2060 
    '==============> Per ogni nodo dello strato di output
 2061 
    For IOutput = 1 To NumCelleStratoOutput
 2062 
        '================> Comunque, mostro il valore
 2063 
        Select Case IOutput
 2064 
            Case 1
 2065 
                Me!VX.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2066 
            Case 2
 2067 
                Me!VO.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2068 
            Case 3
 2069 
                Me!VC.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2070 
            Case 4
 2071 
                Me!VQ.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2072 
        End Select
 2073 
        '================> Memorizzo il risultato più alto
 2074 
        If M_OUTPUT(IOutput) > ValRisultato Then
 2075 
            NRisultato = IOutput
 2076 
            ValRisultato = M_OUTPUT(IOutput)
 2077 
        End If
 2078 
    Next
 2079 
    '==========================================
 2080 
    '= Mostro il risultato
 2081 
    '= 1 = "X"
 2082 
    '= 2 = "O"
 2083 
    '= 3 = "+"
 2084 
    '= 4 = "quadrato"
 2085 
    '==========================================
 2086 
    Select Case NRisultato
 2087 
        Case 1
 2088 
            Me!OttengoICS.BackColor = VERDE
 2089 
        Case 2
 2090 
            Me!OttengoCERCHIO.BackColor = VERDE
 2091 
        Case 3
 2092 
            Me!OttengoCROCE.BackColor = VERDE
 2093 
        Case 4
 2094 
            Me!OttengoQUADRATO.BackColor = VERDE
 2095 
        Case Else
 2096 
            MsgBox "La analisi non ha dato alcun risultato (RISULTATO = 0)."
 2097 
    End Select
 2098 
    '============================================================================
 2099 
    '==================\                                  /======================
 2100 
    '===================> FINE NORMALE CICLO DI ANALISI  <=======================
 2101 
    '==================/                                  \======================
 2102 
    '============================================================================
 2103 
    '=========================> Mostro uno per uno l'esito degli
 2104 
    '=========================> ultimi dieci esempi
 2105 
    If EsempiFatti > (NumRecEsempi - 10) Then
 2106 
        MsgBox "La rete neurale ha detto ...."
 2107 
    End If
 2108 
    '==========================================================
 2109 
    'Mi trovo a questo punto con il layer di output valorizzato
 2110 
    '==========================================================
 2111 
   
 2112 
   
 2113 
    '===============================================================
 2114 
    ' Addestramento stile Nikos Drakos
 2115 
    ' http://cbl.leeds.ac.uk/nikos/pail/Intml/subsections3.11.4.html
 2116 
    '===============================================================
 2117 
    'Consiglio tecnico:
 2118 
    ' Non mettere come VALORI DESIDERATI i valori estremi che
 2119 
    ' non saranno raggiunti! bisogna dare all'algoritmo di training
 2120 
    ' la possibilità di RAGGIUNGERE E SUPERARE tali valori.
 2121 
    ' A  esempio, non 1, ma 0.9
 2122 
    ' non 0, ma 0.1
 2123 
    '===========================================================
 2124 
    'Nota sul gergo tecnico:
 2125 
    'ACTIVATION OF NODE X significa il "valore proprio" del nodo X,
 2126 
    'in altri punti dei commenti chiamato "OUTPUT del neurone", che
 2127 
    'poi è semplicemente il valore memorizzato in cella di matrice
 2128 
    'M_OUTPUT o M_HIDDEN.
 2129 
    'NODE è una cella di uno dei tre strati: INPUT, HIDDEN, OUTPUT
 2130 
    'WEIGHT è il peso (=VALORE) una cella di una delle matrici di "collegamenti"
 2131 
    'o "pesi", ovvero le due matrici di connessione "strato1" e "strato2"
 2132 
    '===========================================================
 2133 
    '"SOPRA" (ABOVE) c'è lo strato di output
 2134 
    '"SOTTO" c'è lo strato di INPUT
 2135 
    'Quindi la cella "sopra" è quella "VERSO LO STRATO DI OUTPUT"
 2136 
    '===========================================================
 2137 
    'First, the error for the output layer nodes is computed
 2138 
    'using the following formula:
 2139 
    'Ej = (tj-aj)aj(1-aj)
 2140 
    'where
 2141 
    'Ej= error for the node j of the output layer
 2142 
    'tJ= "target" activation for node J of the output lajer
 2143 
    'aj= actual activation for node j of the output layer
 2144 
    '===========================================================
 2145 
    'Ovvero, con riferimento ai vettori:
 2146 
    ' M_OUTPUT: Matrice unidimensionale (=vettore) che contiene
 2147 
    '           i nodi (=CELLE) dello strato di output
 2148 
    ' M_OUTPUT_DESIDERATI: I valori desiderati come obiettivo
 2149 
    '                        per i nodi (=CELLE) dello strato di output
 2150 
    ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore
 2151 
    '                  associato ai nodi (=CELLE) dello strato di output
 2152 
    '===========================================================
 2153 
    '==\
 2154 
    '===> Riempio la matrice degli errori dello strato di OUTPUT
 2155 
    '===> ovvero M_ERRORI_OUTPUT(NumCelleStratoOutput)
 2156 
    'Ej = (tj-aj)aj(1-aj)
 2157 
    '==/
 2158 
   
 2159 
    For IOutput = 1 To NumCelleStratoOutput
 2160 
M_ERRORI_OUTPUT(IOutput) = (M_OUTPUT_DESIDERATI(IOutput) - M_OUTPUT(IOutput)) * M_OUTPUT(IOutput) * (1 - M_OUTPUT(IOutput))
 2161 
    Next
 2162 
 
 2163 
        '===============================================================
 2164 
        '==================\                     /======================
 2165 
        '===================> BACK PROPAGATION  <=======================
 2166 
        '==================/                     \======================
 2167 
        '===============================================================
 2168 
        '===========================================================
 2169 
        '==\
 2170 
        '===> Riempio la matrice degli errori dell'HIDDEN LAYER
 2171 
        '===> ovvero M_ERRORI_HIDDEN(NumCelleHiddenLayer)
 2172 
        '==/
 2173 
        '============================================================
 2174 
  
 2175 
        '===========================================================
 2176 
        'Then, successively, the error values for all the hidden layer nodes are computed:
 2177 
        'Ei = ai(1-ai)Sommatoria in j di EjWij
 2178 
        'where
 2179 
        'Ei= error for the node i of the hidden layer
 2180 
        'Ej= Error for the node J in the layer above (OUTPUT LAYER NELLO SCHEMA)
 2181 
        'wij= Weight for the connection between node i in the hidden
 2182 
        'layer and node j in the layer above (OUTPUT LAYER NELLO SCHEMA)
 2183 
        'ai= activation of node I in the hidden layer
 2184 
        '===========================================================
 2185 
        'Ovvero, con riferimento ai vettori:
 2186 
        ' M_HIDDEN: Matrice unidimensionale (=vettore) che contiene
 2187 
        '           i nodi dell'Hidden Layer
 2188 
        ' M_ERRORI_HIDDEN: La matrice destinata a contenere l'errore
 2189 
        '                  associato ai nodi dell'HIDDEN LAYER
 2190 
        ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore
 2191 
        '                  associato ai nodi dell'OUTPUT LAYER
 2192 
        ' M_STRATO2: La matrice con i nodi tra l'hidden layer e lo
 2193 
        '            strato di output
 2194 
        '===========================================================
 2195 
 
 2196 
        '==\
 2197 
        '===> Riempio la matrice degli errori dell'HIDDEN LAYER
 2198 
        '===> ovvero M_ERRORI_HIDDEN(NumNodiHiddenLayer)
 2199 
        '==/
 2200 
 
 2201 
        For IHidden = 1 To NumCelleHiddenLayer
 2202 
            'Inizializzo la sommatoria
 2203 
            Sommatoria = 0
 2204 
            For IOutput = 1 To NumCelleStratoOutput
 2205 
                '====> Valore che va a incrementare la sommatoria
 2206 
                '====> variabile inutile creata per leggibilità
 2207 
                Aggiungi = M_ERRORI_OUTPUT(IOutput) * M_Strato2(IHidden, IOutput)
 2208 
                '=\
 2209 
                '==> Incremento la SOMMATORIA
 2210 
                '=/
 2211 
                Sommatoria = Sommatoria + Aggiungi
 2212 
            Next
 2213 
            '====> Ei = ai(1-ai)Sommatoria in j di EjWij
 2214 
            M_ERRORI_HIDDEN(IHidden) = M_HIDDEN(IHidden) * (1 - M_HIDDEN(IHidden)) * Sommatoria
 2215 
 
 2216 
        Next
 2217 
        '=====================================================
 2218 
        'At the end of the error backward propagation phase,
 2219 
        'all nodes of the network (except the input layer nodes)
 2220 
        'will have error values.
 2221 
        'The error value of a node is used to compute new weights
 2222 
        'for the connections which lead to the node.
 2223 
        'Very generally, the weight change is done by using
 2224 
        'the following formula:
 2225 
        'wij = wij + DeltaWij
 2226 
        'where
 2227 
        'Wij is the weight of the connection between node I in
 2228 
        'the previous layer and node J in the output layer or
 2229 
        'in a hidden layer
 2230 
        'DeltaWij is the weight change for the connection between
 2231 
        'node I in the previous layer and node J in the output
 2232 
        'layer or in a hidden layer
 2233 
        '
 2234 
        'The DeltaWij values are computed in the same way for each
 2235 
        'node J in the network:
 2236 
        '
 2237 
        'where
 2238 
        'Beta is the Learning rate
 2239 
        'Ej is the error for node J
 2240 
        'ai activation for node i in the previous layer from which
 2241 
        '   the connection originates
 2242 
        'm momentum parameter (a value of 0.9 is used in the model)
 2243 
        'Deltawij' Deltawij for the previous weight change.
 2244 
        '
 2245 
        'The weight change can be done right after the computation
 2246 
        'of DeltaWij values (ON LINE PROCEDURE)
 2247 
        'Alternatively, the Deltawij values can be summed up for
 2248 
        'all input patterns in the training set, and the actual
 2249 
        'weight change is done after each input pattern has been
 2250 
        'presented once (OFF LINE PROCEDURE)
 2251 
        '===========================================================
 2252 
        'Ovvero, con riferimento ai vettori:
 2253 
        ' M_INPUT: Matrice bidimensionale (=vettore) che contiene
 2254 
        '           i nodi dello strato di input
 2255 
        ' M_HIDDEN: Matrice unidimensionale (=vettore) che contiene
 2256 
        '           i nodi dell'Hidden Layer
 2257 
        ' M_OUTPUT: Matrice unidimensionale (=vettore) che contiene
 2258 
        '           i nodi dello strato di output
 2259 
        ' M_ERRORI_HIDDEN: La matrice destinata a contenere l'errore
 2260 
        '                  associato ai nodi dell'HIDDEN LAYER
 2261 
        ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore
 2262 
        '                  associato ai nodi dell'HIDDEN LAYER
 2263 
        ' M_STRATO1: La matrice con i nodi tra lo strato di input
 2264 
        '            e l'hidden layer (tridimensionale di 400 pesi)
 2265 
        ' M_STRATO2: La matrice con i nodi tra l'hidden layer e lo
 2266 
        '            strato di output (bidimensionale di 16 pesi)
 2267 
        ' M_ULTIMI_DELTAW_S1: gli ultimi deltapesi applicati
 2268 
        '                             a M_strato1 (400)
 2269 
        ' M_ULTIMI_DELTAW_S2: gli ultimi deltapesi applicati
 2270 
        '                             a M_strato2 (16)
 2271 
        'LearningRate=0.01
 2272 
        'ValoreArbitrario "momentum"=0.9
 2273 
        'la matrice con i BIAS NODES per le celle di HIDDEN LAYER
 2274 
        'Public M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double
 2275 
        'la matrice con i BIAS NODES per le celle di STRATO OUTPUT
 2276 
        'Public M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double
 2277 
        'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES
 2278 
        'Public M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double
 2279 
        'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES
 2280 
        'Public M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double
 2281 
        'ultimi delta applicati ai pesi tra HIDDEN ed i rispettivi BIAS NODES
 2282 
        'Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer)  As Double
 2283 
        'ultimi delta applicati ai pesi tra OUTPUT ed i rispettivi BIAS NODES
 2284 
        'Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput)  As Double
 2285 
        '===========================================================
 2286 
        '==\
 2287 
        '===> Strategia on line
 2288 
        '==/
 2289 
        '==============================================================
 2290 
        'Applicazione degli errori ai pesi tra INPUT e HIDDEN (strato 1)
 2291 
        '==============================================================
 2292 
        For IInput = 1 To NumCelleStratoInput
 2293 
            For JInput = 1 To NumCelleStratoInput
 2294 
                For IHidden = 1 To NumCelleHiddenLayer
 2295 
                    '===========================================================
 2296 
                    ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER
 2297 
                    '===========================================================
 2298 
                    ErroreQuestaCella = M_ERRORI_HIDDEN(IHidden)
 2299 
                    '===========================================================
 2300 
                    ' Rilevo il valore della cella di input layer da cui parte
 2301 
                    ' la connessione al mio nodo
 2302 
                    '===========================================================
 2303 
                    ValoreCellaAMonte = M_INPUT(IInput, JInput)
 2304 
                    '==========\
 2305 
                    '===========> Leggo la correzione apportata a questo
 2306 
                    '===========> peso collegamento al ciclo precedente
 2307 
                    '==========/
 2308 
                    Corr_Di_prima = M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden)
 2309 
                    '========================================================
 2310 
                    ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto
 2311 
                    '========================================================
 2312 
                    DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima)
 2313 
   
 2314 
                    '==========\
 2315 
                    '===========> Scrivo la correzione applicata ora
 2316 
                    '===========> per riutilizzo al ciclo successivo
 2317 
                    '==========/
 2318 
                    M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden) = DeltaPeso
 2319 
               
 2320 
                    '========================================================
 2321 
                    ' Applico il deltapeso appena calcolato al peso corrente
 2322 
                    '========================================================
 2323 
                    M_Strato1(IInput, JInput, IHidden) = M_Strato1(IInput, JInput, IHidden) + DeltaPeso
 2324 
 
 2325 
                Next
 2326 
            Next
 2327 
        Next
 2328 
       
 2329 
        '=============================================================
 2330 
        'Applicazione degli errori ai pesi tra BIASNODE e HIDDEN LAYER
 2331 
        '=============================================================
 2332 
        For IHidden = 1 To NumCelleHiddenLayer
 2333 
            '===========================================================
 2334 
            ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER
 2335 
            '===========================================================
 2336 
            ErroreQuestaCella = M_ERRORI_HIDDEN(IHidden)
 2337 
            '===========================================================
 2338 
            ' Rilevo il valore del Bias Node specifico della cella corrente
 2339 
            '===========================================================
 2340 
            ValoreCellaAMonte = M_BiasNodes_HIDDEN(IHidden)
 2341 
            '==========\
 2342 
            '===========> Leggo la correzione apportata a questo
 2343 
            '===========> peso collegamento al ciclo precedente
 2344 
            '==========/
 2345 
            Corr_Di_prima = M_ULTIMI_DELTAW_HB(IHidden)
 2346 
            '========================================================
 2347 
            ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto
 2348 
            '========================================================
 2349 
            DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima)
 2350 
   
 2351 
            '==========\
 2352 
            '===========> Scrivo la correzione applicata ora
 2353 
            '===========> per riutilizzo al ciclo successivo
 2354 
            '==========/
 2355 
            M_ULTIMI_DELTAW_HB(IHidden) = DeltaPeso
 2356 
               
 2357 
            '========================================================
 2358 
            ' Applico il deltapeso appena calcolato al peso corrente
 2359 
            '========================================================
 2360 
            M_Strato_HID_BIAS(IHidden) = M_Strato_HID_BIAS(IHidden) + DeltaPeso
 2361 
 
 2362 
        Next
 2363 
 
 2364 
        '==============================================================
 2365 
        'Applicazione degli errori ai pesi tra HIDDEN e OUTPUT (strato 2)
 2366 
        '==============================================================
 2367 
        For IHidden = 1 To NumCelleHiddenLayer
 2368 
            For IOutput = 1 To NumCelleStratoOutput
 2369 
                '===========================================================
 2370 
                ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER
 2371 
                '===========================================================
 2372 
                ErroreQuestaCella = M_ERRORI_OUTPUT(IOutput)
 2373 
                '===========================================================
 2374 
                ' Rilevo il valore della cella di hidden layer da cui parte
 2375 
                ' la connessione al mio nodo
 2376 
                '===========================================================
 2377 
                ValoreCellaAMonte = M_HIDDEN(IHidden)
 2378 
                '==========\
 2379 
                '===========> Leggo la correzione apportata a questo
 2380 
                '===========> peso collegamento al ciclo precedente
 2381 
                '==========/
 2382 
                Corr_Di_prima = M_ULTIMI_DELTAW_S2(IOutput, IHidden)
 2383 
                '========================================================
 2384 
                ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto
 2385 
                '========================================================
 2386 
                DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima)
 2387 
                '==========\
 2388 
                '===========> Scrivo la correzione applicata ora
 2389 
                '===========> per riutilizzo al ciclo successivo
 2390 
                '==========/
 2391 
                M_ULTIMI_DELTAW_S2(IOutput, IHidden) = DeltaPeso
 2392 
         
 2393 
                '========================================================
 2394 
                ' Applico il deltapeso appena calcolato al peso corrente
 2395 
                '========================================================
 2396 
                M_Strato2(IHidden, IOutput) = M_Strato2(IHidden, IOutput) + DeltaPeso
 2397 
 
 2398 
            Next
 2399 
        Next
 2400 
 
 2401 
        '==============================================================
 2402 
        'Applicazione degli errori ai pesi tra BIASNODE e STRATO OUTPUT
 2403 
        '==============================================================
 2404 
        For IOutput = 1 To NumCelleStratoOutput
 2405 
            '===========================================================
 2406 
            ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER
 2407 
            '===========================================================
 2408 
            ErroreQuestaCella = M_ERRORI_OUTPUT(IOutput)
 2409 
            '===========================================================
 2410 
            ' Rilevo il valore del Bias Node
 2411 
            '===========================================================
 2412 
            ValoreCellaAMonte = M_BiasNodes_OUTPUT(IOutput)
 2413 
            '==========\
 2414 
            '===========> Leggo la correzione apportata a questo
 2415 
            '===========> peso collegamento al ciclo precedente
 2416 
            '==========/
 2417 
            Corr_Di_prima = M_ULTIMI_DELTAW_OB(IOutput)
 2418 
            '========================================================
 2419 
            ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto
 2420 
            '========================================================
 2421 
            DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima)
 2422 
   
 2423 
            '==========\
 2424 
            '===========> Scrivo la correzione applicata ora
 2425 
            '===========> per riutilizzo al ciclo successivo
 2426 
            '==========/
 2427 
            M_ULTIMI_DELTAW_OB(IOutput) = DeltaPeso
 2428 
               
 2429 
            '========================================================
 2430 
            ' Applico il deltapeso appena calcolato al peso corrente
 2431 
            '========================================================
 2432 
            M_Strato_OUT_BIAS(IOutput) = M_Strato_OUT_BIAS(IOutput) + DeltaPeso
 2433 
 
 2434 
        Next
 2435 
        '====================================================================
 2436 
        '==================\                          /======================
 2437 
        '===================> FINE BACK PROPAGATION  <=======================
 2438 
        '==================/                          \======================
 2439 
        '====================================================================
 2440 
 
 2441 
    '================================================
 2442 
    '================================================
 2443 
    ' PASSO ALL'ESEMPIO SUCCESSIVO
 2444 
    '================================================
 2445 
    '================================================
 2446 
 
 2447 
Next
 2448 
 
 2449 
'==========================================================================
 2450 
'==================\                                /======================
 2451 
'===================> FINE CICLO DI ADDESTRAMENTO  <=======================
 2452 
'==================/                                \======================
 2453 
'Il ciclo di addestramento finisce quando tutti gli esempi sono stati
 2454 
'esaminati
 2455 
'==========================================================================
 2456 
 
 2457 
'==========================================
 2458 
'= Salvo i pesi ad addestramento terminato
 2459 
'==========================================
 2460 
MsgBox "Fine Addestramento - ripeto altre 6 volte"
 2461 
Beep
 2462 
MsgBox "Fine Addestramento - ripeto altre 5 volte"
 2463 
Beep
 2464 
MsgBox "Fine Addestramento - ripeto altre 4 volte"
 2465 
Beep
 2466 
MsgBox "Fine Addestramento - ripeto altre 3 volte"
 2467 
Beep
 2468 
MsgBox "Fine Addestramento - ripeto altre 2 volte"
 2469 
Beep
 2470 
MsgBox "Fine Addestramento - ripeto una altra volta"
 2471 
Beep
 2472 
MsgBox "Fine Addestramento"
 2473 
If MsgBox("Salvo in tabella PESO_COLLEGAMENTI i pesi dei collegamenti ottenuti come risultato dell'addestramento?", vbYesNo, "Attenzione!") = vbYes Then
 2474 
    ScriviTuttiIPesiCollegamenti
 2475 
Else
 2476 
    MsgBox "Non avete salvato i pesi dei collegamenti nella tabella - i collegamenti addestrati sono attivi in memoria RAM"
 2477 
End If
 2478 
 
 2479 
Exit_TRAINING_Click:
 2480 
    Exit Sub
 2481 
 
 2482 
Err_TRAINING_Click:
 2483 
    MsgBox "TRAINING_Click: Errore " & Str(Err.Number) & " generato da " _
 2484 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 2485 
    Resume Exit_TRAINING_Click
 2486 
End Sub
 2487 
 
 2488 
 
 2489 
 
 2490 
 
 2491 
 
 2492 
 
 2493 
 
 2494 
 
 2495 
Private Sub UTILIZZO_Click()
 2496 
On Error GoTo Err_UTILIZZO_Click
 2497 
'=====================> Indici locali
 2498 
Dim IInput As Integer ' due coordinata per l'input layer bidimensionale
 2499 
Dim JInput As Integer ' due coordinata per l'input layer bidimensionale
 2500 
Dim IHidden As Integer  ' una sola coordinata per l'hidden layer monodimensionale
 2501 
Dim IOutput As Integer  ' una sola coordinata per l'output layer monodimensionale
 2502 
Dim Sommatoria As Double 'la sommatoria dei valori convergenti sulla mia cella
 2503 
Dim Aggiungi As Double 'variabile di transito
 2504 
Dim BIAS As Double 'variabile di transito BIAS cella corrente
 2505 
Dim ESPONENTE As Double 'variabile di transito BIAS
 2506 
'=====================> Ospita il numero del risultato
 2507 
Dim NRisultato As Integer
 2508 
'=====================> Ospita il valore del risultato
 2509 
Dim ValRisultato As Double
 2510 
'=====================> Ospita il valore ricevuto dalla
 2511 
'=====================> singola connessione verso di me
 2512 
Dim RicevoDaNodoCorrente As Double
 2513 
'=====================> Avviso
 2514 
MsgBox "Si suppone che abbiate caricato opportuni pesi nei collegamenti ed un pattern su video eventualmente modificato per mettere alla prova la capacità della rete neurale di riconoscerlo"
 2515 
If MsgBox("Confermate di volere analizzare quanto visualizzato?", vbYesNo, "Attenzione!") = vbNo Then
 2516 
    Exit Sub
 2517 
End If
 2518 
'=========================> Tutte a "rosso" le caselle degli esiti
 2519 
SvuotaEsiti
 2520 
'=========================> Salvo la configurazione del display in MATRICEVIDEO
 2521 
FillMatriceVideoconDisplay
 2522 
'=========================> Trasferisco MATRICEVIDEO in MATRICE INPUT M_INPUT
 2523 
' Perchè non trasferisco direttamente il "display" 10 x 10 in MATRICEINPUT
 2524 
' senza avvalermi della matrice di transito MATRICEVIDEO?
 2525 
' Potrei benissimo farlo in un colpo solo. Visto che comunque ho a
 2526 
' disposizione MatriceVideo, la sfrutto per creare una routine che accetta una
 2527 
' matrice come parametro
 2528 
FillMatriceInput MatriceVideo
 2529 
'===============================================================
 2530 
'Inizializzazione a 1 dei Bias Nodes
 2531 
'==============================================================
 2532 
For IHidden = 1 To NumCelleHiddenLayer
 2533 
    M_BiasNodes_HIDDEN(IHidden) = 1
 2534 
Next
 2535 
For IOutput = 1 To NumCelleStratoOutput
 2536 
    M_BiasNodes_OUTPUT(IOutput) = 1
 2537 
Next
 2538 
'======================================
 2539 
'= LEGGO TUTTI I PESI
 2540 
'======================================
 2541 
'If MsgBox("Utilizzo i pesi eventualmente già presenti in RAM (NO=Carico il peso dei collegamenti da tabella)?", vbYesNo, "Attenzione!") = vbNo Then
 2542 
'    '==============================================================
 2543 
'    'Leggo da tabella PESO_COLLEGAMENTI i valori da porre nelle matrici dei collegamenti
 2544 
'    '==============================================================
 2545 
'    '====================> Riempio i vettori dei collegamenti
 2546 
'    LeggiTuttiIPesiCollegamenti
 2547 
'End If
 2548 
 
 2549 
'======================================
 2550 
'= Qui l'utilizzo
 2551 
'======================================
 2552 
'==\
 2553 
'===> Promemoria sui nomi delle matrici
 2554 
'==/
 2555 
' M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer
 2556 
' M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double
 2557 
' M_HIDDEN(NumCelleHiddenLayer) As Double
 2558 
' M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double
 2559 
' M_OUTPUT(NumCelleStratoOutput) As Integer
 2560 
'la matrice con i BIAS NODES per le celle di HIDDEN LAYER
 2561 
' M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double
 2562 
'la matrice con i BIAS NODES per le celle di STRATO OUTPUT
 2563 
' M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double
 2564 
'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES
 2565 
' M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double
 2566 
'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES
 2567 
' M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double
 2568 
 
 2569 
 
 2570 
 
 2571 
'=================================
 2572 
'= Fase 1 - spazzata hidden layer
 2573 
'=================================
 2574 
'==============> Per ogni nodo dell'hidden layer
 2575 
For IHidden = 1 To NumCelleHiddenLayer
 2576 
    '===============> Azzero la Sommatoria dei valori che
 2577 
    '===============> determinerà l'output (=il valore) del
 2578 
    '===============> mio neurone di hidden layer
 2579 
    Sommatoria = 0
 2580 
    '===============> Per tutti i collegamenti dell'input layer che convergono
 2581 
    '===============> sulla mia cella di hidden layer
 2582 
    For IInput = 1 To NumCelleStratoInput
 2583 
        For JInput = 1 To NumCelleStratoInput
 2584 
            '===============> Localizzo il collegamento tra la mia cella
 2585 
            '===============> di hidden layer e la cella corrente del
 2586 
            '===============> layer di input
 2587 
            RicevoDaNodoCorrente = M_INPUT(IInput, JInput) * M_Strato1(IInput, JInput, IHidden)
 2588 
           
 2589 
            '===\
 2590 
            '====> Aggiungo alla sommatoria il valore ricevuto
 2591 
            '====> dalla connessione convergente verso il mio neurone
 2592 
            '===/
 2593 
            Sommatoria = Sommatoria + RicevoDaNodoCorrente
 2594 
       
 2595 
        Next
 2596 
    Next
 2597 
    '==\
 2598 
    '===> Valuto l'apporto del Bias Node specifico della mia cella
 2599 
    '==/
 2600 
    BIAS = M_BiasNodes_HIDDEN(IHidden) * M_Strato_HID_BIAS(IHidden)
 2601 
    '==\
 2602 
    '===> Calcolo l'esponente a cui elevare "e"
 2603 
    '===> -1 è la "costante di ripidità" della sigmoide
 2604 
    '==/
 2605 
    ESPONENTE = -1 * (Sommatoria - BIAS)
 2606 
       
 2607 
    '===\
 2608 
    '====> Memorizzo nel nodo corrente il valore ottenuto
 2609 
    '====> a partire da "Sommatoria", secondo il metodo seguente
 2610 
    '===/
 2611 
    M_HIDDEN(IHidden) = 1 / (1 + Exp(ESPONENTE))
 2612 
   
 2613 
Next
 2614 
 
 2615 
 
 2616 
'=================================
 2617 
'= Fase 2 - spazzata layer output
 2618 
'=================================
 2619 
'==============> Per ogni nodo dell'hidden layer
 2620 
For IOutput = 1 To NumCelleStratoOutput
 2621 
    '===============> Azzero la Sommatoria dei valori che
 2622 
    '===============> determinerà l'output (=il valore) del
 2623 
    '===============> mio neurone di output
 2624 
    Sommatoria = 0
 2625 
    '===============> Per tutti i collegamenti dell'Hidden Layer che convergono
 2626 
    '===============> sulla mia cella di output layer
 2627 
    For IHidden = 1 To NumCelleHiddenLayer
 2628 
        '===============> Localizzo il collegamento tra la mia cella
 2629 
        '===============> di output layer e la cella corrente dell'
 2630 
        '===============> hidden layer
 2631 
 
 2632 
        RicevoDaNodoCorrente = M_HIDDEN(IHidden) * M_Strato2(IHidden, IOutput)
 2633 
           
 2634 
        '===\
 2635 
        '====> Aggiungo alla sommatoria il valore ricevuto
 2636 
        '====> dalla connessione convergente verso il mio neurone
 2637 
        '===/
 2638 
        Sommatoria = Sommatoria + RicevoDaNodoCorrente
 2639 
    Next
 2640 
    '==\
 2641 
    '===> Valuto l'apporto del Bias Node specifico della mia cella
 2642 
    '==/
 2643 
    BIAS = M_BiasNodes_OUTPUT(IOutput) * M_Strato_OUT_BIAS(IOutput)
 2644 
    '==\
 2645 
    '===> Calcolo l'esponente a cui elevare "e"
 2646 
    '===> -1 è la "costante di ripidità" della sigmoide
 2647 
    '==/
 2648 
    ESPONENTE = -1 * (Sommatoria - BIAS)
 2649 
       
 2650 
    '===\
 2651 
    '====> Memorizzo nel nodo corrente il valore ottenuto
 2652 
    '====> a partire da "Sommatoria", secondo il metodo seguente
 2653 
    '===/
 2654 
    M_OUTPUT(IOutput) = 1 / (1 + Exp(ESPONENTE))
 2655 
   
 2656 
Next
 2657 
 
 2658 
'========> DEBUG
 2659 
'========> In attesa di potere effettuare il training,
 2660 
'========> restituisco un risultato a caso
 2661 
 
 2662 
'====================================================
 2663 
'= Determino il risultato spazzando i nodi (=CELLE) di output
 2664 
'= "The winner takes it all" - la risposta è il nodo
 2665 
'= con il valore più elevato
 2666 
'====================================================
 2667 
'===============> Azzero il risultato
 2668 
NRisultato = 0
 2669 
ValRisultato = 0
 2670 
'==============> Per ogni nodo dello strato di output
 2671 
For IOutput = 1 To NumCelleStratoOutput
 2672 
    '================> Comunque, mostro il valore
 2673 
    Select Case IOutput
 2674 
        Case 1
 2675 
            Me!VX.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2676 
        Case 2
 2677 
            Me!VO.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2678 
        Case 3
 2679 
            Me!VC.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2680 
        Case 4
 2681 
            Me!VQ.Caption = Format$(M_OUTPUT(IOutput), "0.000000")
 2682 
    End Select
 2683 
    '================> Memorizzo il risultato più alto
 2684 
    If M_OUTPUT(IOutput) > ValRisultato Then
 2685 
        NRisultato = IOutput
 2686 
        ValRisultato = M_OUTPUT(IOutput)
 2687 
    End If
 2688 
Next
 2689 
 
 2690 
'==========================================
 2691 
'= Mostro il risultato
 2692 
'= 1 = "X"
 2693 
'= 2 = "O"
 2694 
'= 3 = "+"
 2695 
'= 4 = "quadrato"
 2696 
'==========================================
 2697 
Select Case NRisultato
 2698 
    Case 1
 2699 
        Me!OttengoICS.BackColor = VERDE
 2700 
    Case 2
 2701 
        Me!OttengoCERCHIO.BackColor = VERDE
 2702 
    Case 3
 2703 
        Me!OttengoCROCE.BackColor = VERDE
 2704 
    Case 4
 2705 
        Me!OttengoQUADRATO.BackColor = VERDE
 2706 
    Case Else
 2707 
        MsgBox "La analisi non ha dato alcun risultato (RISULTATO = 0)."
 2708 
End Select
 2709 
 
 2710 
 
 2711 
Exit_UTILIZZO_Click:
 2712 
    Exit Sub
 2713 
 
 2714 
Err_UTILIZZO_Click:
 2715 
    MsgBox "UTILIZZO_Click: Errore " & Str(Err.Number) & " generato da " _
 2716 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 2717 
    Resume Exit_UTILIZZO_Click
 2718 
End Sub
 2719 
 
 2720 
 
 2721 
 
 2722 
 
 2723 
 
 2724 
 
 2725 
Private Sub SvuotaEsiti()
 2726 
On Error GoTo Err_SVUOTAESITI
 2727 
 
 2728 
Me!ChiedoCERCHIO.BackColor = ROSSO
 2729 
Me!ChiedoCROCE.BackColor = ROSSO
 2730 
Me!ChiedoICS.BackColor = ROSSO
 2731 
Me!ChiedoQUADRATO.BackColor = ROSSO
 2732 
Me!OttengoCERCHIO.BackColor = ROSSO
 2733 
Me!OttengoCROCE.BackColor = ROSSO
 2734 
Me!OttengoICS.BackColor = ROSSO
 2735 
Me!OttengoQUADRATO.BackColor = ROSSO
 2736 
Me!VX.Caption = " "
 2737 
Me!VO.Caption = " "
 2738 
Me!VC.Caption = " "
 2739 
Me!VQ.Caption = " "
 2740 
 
 2741 
Exit_SVUOTAESITI:
 2742 
    Exit Sub
 2743 
 
 2744 
Err_SVUOTAESITI:
 2745 
    MsgBox "SVUOTAESITI: Errore " & Str(Err.Number) & " generato da " _
 2746 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 2747 
    Resume Exit_SVUOTAESITI
 2748 
End Sub
 2749 
 
 2750 
 
 2751 
 
 2752 
 
 2753 
 
 2754 
 
 2755 
 
 2756 
Private Sub SalvaEsempio(CheSoluzione As Integer)
 2757 
'============================================================================
 2758 
'== PER SALVARE NELLA TABELLA ESEMPI QUANTO VISUALIZZATO SUL DISPLAY 10 x 10
 2759 
'== ASSIEME ALLA RELATIVA SOLUZIONE PREVISTA
 2760 
    '= 1 = "X"
 2761 
    '= 2 = "O"
 2762 
    '= 3 = "+"
 2763 
    '= 4 = "quadrato"
 2764 
'==================================================
 2765 
On Error GoTo Err_SalvaEsempio
 2766 
'=====================> Indici locali
 2767 
Dim LocalI As Integer
 2768 
Dim LocalJ As Integer
 2769 
'=====================> Variabile per comporre il nome controllo
 2770 
Dim NomeControllo As String
 2771 
'=====================> Variabili per rappresentare il display
 2772 
Dim vRiga1 As String
 2773 
Dim vRiga2 As String
 2774 
Dim vRiga3 As String
 2775 
Dim vRiga4 As String
 2776 
Dim vRiga5 As String
 2777 
Dim vRiga6 As String
 2778 
Dim vRiga7 As String
 2779 
Dim vRiga8 As String
 2780 
Dim vRiga9 As String
 2781 
Dim vRiga10 As String
 2782 
'=====================> Carattere per memorizzare la cella corrente di display
 2783 
Dim Carattere As String
 2784 
'=\
 2785 
'==> salvo quanto su display in un record della tabella ESEMPI
 2786 
'==> a seconda del valore del parametro Chefile.
 2787 
'=/
 2788 
 
 2789 
' Restituisce il riferimento al database corrente.
 2790 
Set dbs = CurrentDb
 2791 
' Apre la tabella ESEMPI come oggetto Recordset di tipo dynaset.
 2792 
Set rst = dbs.OpenRecordset("ESEMPI", dbOpenTable)
 2793 
 
 2794 
'========================================================
 2795 
' Riverso il contenuto del display 10x10 in 10 variabili
 2796 
' vRigaN, che salvo nei campi RigaN della tabella esempi
 2797 
'========================================================
 2798 
'Svuoto le vRigaN
 2799 
vRiga1 = ""
 2800 
vRiga2 = ""
 2801 
vRiga3 = ""
 2802 
vRiga4 = ""
 2803 
vRiga5 = ""
 2804 
vRiga6 = ""
 2805 
vRiga7 = ""
 2806 
vRiga8 = ""
 2807 
vRiga9 = ""
 2808 
vRiga10 = ""
 2809 
'Svuoto Carattere
 2810 
Carattere = ""
 2811 
'Riempio le vRigaN
 2812 
For LocalI = 1 To 10
 2813 
    For LocalJ = 1 To 10
 2814 
        '============>
 2815 
        NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ))
 2816 
        If Me(NomeControllo).BackColor = 0 Then
 2817 
            Carattere = "1"
 2818 
        Else
 2819 
            Carattere = "0"
 2820 
        End If
 2821 
        Select Case LocalI
 2822 
            Case 1
 2823 
                vRiga1 = vRiga1 + Carattere
 2824 
            Case 2
 2825 
                vRiga2 = vRiga2 + Carattere
 2826 
            Case 3
 2827 
                vRiga3 = vRiga3 + Carattere
 2828 
            Case 4
 2829 
                vRiga4 = vRiga4 + Carattere
 2830 
            Case 5
 2831 
                vRiga5 = vRiga5 + Carattere
 2832 
            Case 6
 2833 
                vRiga6 = vRiga6 + Carattere
 2834 
            Case 7
 2835 
                vRiga7 = vRiga7 + Carattere
 2836 
            Case 8
 2837 
                vRiga8 = vRiga8 + Carattere
 2838 
            Case 9
 2839 
                vRiga9 = vRiga9 + Carattere
 2840 
            Case 10
 2841 
                vRiga10 = vRiga10 + Carattere
 2842 
        End Select
 2843 
    Next
 2844 
Next
 2845 
'===========> Arrivo qui con il display corrente preservato
 2846 
'===========> sotto forma di 10 variabili vRigan
 2847 
'===========> Memorizzo tali variabili nel record di ESEMPI
 2848 
' Aggiungo un nuovo record
 2849 
rst.AddNew
 2850 
'salvo nei campi del record le variabili di memoria
 2851 
rst!Riga1 = vRiga1
 2852 
rst!Riga2 = vRiga2
 2853 
rst!Riga3 = vRiga3
 2854 
rst!Riga4 = vRiga4
 2855 
rst!Riga5 = vRiga5
 2856 
rst!Riga6 = vRiga6
 2857 
rst!Riga7 = vRiga7
 2858 
rst!Riga8 = vRiga8
 2859 
rst!Riga9 = vRiga9
 2860 
rst!Riga10 = vRiga10
 2861 
'salvo quale sia la soluzione da associare
 2862 
rst!Soluzione = CheSoluzione
 2863 
'Salvo il record
 2864 
rst.Update
 2865 
'Chiudo recordset
 2866 
rst.Close
 2867 
'Azzero variabile Database
 2868 
Set dbs = Nothing
 2869 
 
 2870 
 
 2871 
Exit_SalvaEsempio:
 2872 
    Exit Sub
 2873 
 
 2874 
Err_SalvaEsempio:
 2875 
     MsgBox "SalvaEsempio: Errore " & Str(Err.Number) & " generato da " _
 2876 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 2877 
     Resume Exit_SalvaEsempio
 2878 
End Sub
 2879 
 
 2880 
 
 2881 
 
 2882 
 
 2883 
 
 2884 
 
 2885 
Private Function LeggiEsempio(CheRecord As Integer) As Integer
 2886 
'============================================================================
 2887 
'== PER VISUALIZZARE SUL DISPLAY 10 x 10 QUANTO MEMORIZZATO IN FILE ESEMPI
 2888 
'== E RESTITUIRE LA SOLUZIONE ATTESA
 2889 
'==================================================
 2890 
On Error GoTo Err_LeggiEsempio
 2891 
'=====================> Indici locali
 2892 
Dim LocalI As Integer
 2893 
Dim LocalJ As Integer
 2894 
'=====================> Variabile per comporre il nome controllo
 2895 
Dim NomeControllo As String
 2896 
'=====================> Variabili per rappresentare il display
 2897 
Dim vRiga1 As String
 2898 
Dim vRiga2 As String
 2899 
Dim vRiga3 As String
 2900 
Dim vRiga4 As String
 2901 
Dim vRiga5 As String
 2902 
Dim vRiga6 As String
 2903 
Dim vRiga7 As String
 2904 
Dim vRiga8 As String
 2905 
Dim vRiga9 As String
 2906 
Dim vRiga10 As String
 2907 
'=====================> Carattere per memorizzare la cella corrente di display
 2908 
Dim Carattere As String
 2909 
'=====================> Carattere per memorizzare la cella corrente di display
 2910 
Dim CheSoluzione As Integer
 2911 
 
 2912 
'=\
 2913 
'==> salvo quanto su display in un record della tabella ESEMPI
 2914 
'=/
 2915 
 
 2916 
' Restituisce il riferimento al database corrente.
 2917 
Set dbs = CurrentDb
 2918 
' Apre la tabella ESEMPI come oggetto Recordset di tipo dynaset.
 2919 
Set rst = dbs.OpenRecordset("ESEMPI", dbOpenDynaset)
 2920 
 
 2921 
'========================================================
 2922 
' Riverso il contenuto del display 10x10 in 10 variabili
 2923 
' vRigaN, che salvo nei campi RigaN della tabella esempi
 2924 
'========================================================
 2925 
'Svuoto le vRigaN
 2926 
vRiga1 = ""
 2927 
vRiga2 = ""
 2928 
vRiga3 = ""
 2929 
vRiga4 = ""
 2930 
vRiga5 = ""
 2931 
vRiga6 = ""
 2932 
vRiga7 = ""
 2933 
vRiga8 = ""
 2934 
vRiga9 = ""
 2935 
vRiga10 = ""
 2936 
'Svuoto Carattere
 2937 
Carattere = ""
 2938 
 
 2939 
'===========> Arrivo qui con il display corrente preservato
 2940 
'===========> sotto forma di 10 variabili vRigan
 2941 
'===========> Memorizzo tali variabili nel record di ESEMPI
 2942 
' Mi porto al "CheRecord-esimo" Record (il primo è record zero)
 2943 
rst.MoveLast
 2944 
rst.AbsolutePosition = CheRecord - 1
 2945 
'salvo nei campi del record le variabili di memoria
 2946 
vRiga1 = rst!Riga1
 2947 
vRiga2 = rst!Riga2
 2948 
vRiga3 = rst!Riga3
 2949 
vRiga4 = rst!Riga4
 2950 
vRiga5 = rst!Riga5
 2951 
vRiga6 = rst!Riga6
 2952 
vRiga7 = rst!Riga7
 2953 
vRiga8 = rst!Riga8
 2954 
vRiga9 = rst!Riga9
 2955 
vRiga10 = rst!Riga10
 2956 
'salvo quale sia la soluzione da associare
 2957 
CheSoluzione = rst!Soluzione
 2958 
'Chiudo recordset
 2959 
rst.Close
 2960 
'Azzero variabile Database
 2961 
Set dbs = Nothing
 2962 
'Riempio i controlli con le vRigaN
 2963 
For LocalI = 1 To 10
 2964 
    For LocalJ = 1 To 10
 2965 
        Select Case LocalI
 2966 
            Case 1
 2967 
                Carattere = Mid$(vRiga1, LocalJ, 1)
 2968 
            Case 2
 2969 
                Carattere = Mid$(vRiga2, LocalJ, 1)
 2970 
            Case 3
 2971 
                Carattere = Mid$(vRiga3, LocalJ, 1)
 2972 
            Case 4
 2973 
                Carattere = Mid$(vRiga4, LocalJ, 1)
 2974 
            Case 5
 2975 
                Carattere = Mid$(vRiga5, LocalJ, 1)
 2976 
            Case 6
 2977 
                Carattere = Mid$(vRiga6, LocalJ, 1)
 2978 
            Case 7
 2979 
                Carattere = Mid$(vRiga7, LocalJ, 1)
 2980 
            Case 8
 2981 
                Carattere = Mid$(vRiga8, LocalJ, 1)
 2982 
            Case 9
 2983 
                Carattere = Mid$(vRiga9, LocalJ, 1)
 2984 
            Case 10
 2985 
                Carattere = Mid$(vRiga10, LocalJ, 1)
 2986 
        End Select
 2987 
        '============>
 2988 
        NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ))
 2989 
        If Carattere = "1" Then
 2990 
            Me(NomeControllo).BackColor = 0
 2991 
        Else
 2992 
            Me(NomeControllo).BackColor = 16777215
 2993 
        End If
 2994 
       
 2995 
    Next
 2996 
Next
 2997 
'===> Restituisco "CheSoluzione"
 2998 
LeggiEsempio = CheSoluzione
 2999 
 
 3000 
 
 3001 
Exit_LeggiEsempio:
 3002 
    Exit Function
 3003 
 
 3004 
Err_LeggiEsempio:
 3005 
     MsgBox "LeggiEsempio: Errore " & Str(Err.Number) & " generato da " _
 3006 
            & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext
 3007 
     Resume Exit_LeggiEsempio
 3008 
End Function
 3009