Option Compare Database Option Explicit '=========================================================== ' Quanto segue attiene la creazione di una rete neurale così ' concepita: ' ----------------------------------------- ' STRATO DATI UNO - INPUT - matrice 10 x 10 = 100 nodi (CELLE) ' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti ' STRATO DATI DUE - HIDDEN LAYER - vettore unidimensionale 4 nodi (=CELLE) ' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 collegamenti ' STRATO DATI TRE - OUTPUT - vettore unidimensionale 4 nodi (=CELLE) ' "TERZO STRATO collegamenti" - 4 collegamenti tra celle hidden layer ed ' i rispettivi BIAS NODES ' "QUARTO STRATO collegamenti" - 4 collegamenti tra celle strato output ed ' i rispettivi BIAS NODES '============================================================ Public Const NumCelleStratoInput As Integer = 10 Public Const NumCelleHiddenLayer As Integer = 4 Public Const NumCelleStratoOutput As Integer = 4 Public Const LearningRate As Double = 0.01 Public Const ValoreArbitrario As Double = 0.9 'ValoreArbitrario "momentum"=0.9 Public M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer Public M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double Public M_HIDDEN(NumCelleHiddenLayer) As Double Public M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double Public M_OUTPUT(NumCelleStratoOutput) As Double 'la matrice con i BIAS NODES per le celle di HIDDEN LAYER Public M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double 'la matrice con i BIAS NODES per le celle di STRATO OUTPUT Public M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double 'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES Public M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double 'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES Public M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double '========================================================= 'Per RETROPROPAGAZIONE ERRORI '========================================================= 'cosa mi aspetto di ottenere in output Public M_OUTPUT_DESIDERATI(NumCelleStratoOutput) As Double 'errori in output rispetto alle mie aspettative Public M_ERRORI_OUTPUT(NumCelleStratoOutput) As Double 'errori in hidden layer come calcolati da backward propagation Public M_ERRORI_HIDDEN(NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi strato 1 Public M_ULTIMI_DELTAW_S1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi strato 2 Public M_ULTIMI_DELTAW_S2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double 'ultimi delta applicati ai pesi tra HIDDEN ed i rispettivi BIAS NODES Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi tra OUTPUT ed i rispettivi BIAS NODES Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput) As Double Public dbs As Database ' variabile database per accesso DAO Public rst As Recordset ' variabile recordset per accesso DAO Public strCriteri As String 'stringa criterio di ricerca '===> Colori per visualizzare esiti analisi Public Const ROSSO As Long = 255 Public Const VERDE As Long = 65408 Sub AzzeraTutteLeMatrici() '========================> Per pulizia integrale On Error GoTo Err_Azzera '========================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer Dim LocalK As Integer '========================> Azzera nodi strato input For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput M_INPUT(LocalI, LocalJ) = 0 Next Next '========================> Azzera pesi di strato collegamenti 1 '========================> Azzera ERRORI pesi di strato collegamenti 1 For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput For LocalK = 1 To NumCelleHiddenLayer M_Strato1(LocalI, LocalJ, LocalK) = 0 M_ULTIMI_DELTAW_S1(LocalI, LocalJ, LocalK) = 0 Next Next Next '========================> Azzera nodi hidden layer '========================> Azzera errori in hidden layer '========================> Azzera BIAS NODES per le celle di HIDDEN LAYER '========================> Azzera collegamenti tra HIDDEN LAYER ed i rispettivi BIAS NODES '========================> Azzera ultimi delta pesi tra HIDDEN LAYER ed i BIAS NODES For LocalI = 1 To NumCelleHiddenLayer M_HIDDEN(LocalI) = 0 M_ERRORI_HIDDEN(LocalI) = 0 M_BiasNodes_HIDDEN(LocalI) = 0 M_Strato_HID_BIAS(LocalI) = 0 M_ULTIMI_DELTAW_HB(LocalI) = 0 Next '========================> Azzera pesi di strato collegamenti 2 '========================> Azzera ERRORI pesi di strato collegamenti 2 For LocalI = 1 To NumCelleHiddenLayer For LocalJ = 1 To NumCelleStratoOutput M_Strato2(LocalI, LocalJ) = 0 M_ULTIMI_DELTAW_S2(LocalI, LocalJ) = 0 Next Next '========================> Azzera strato output '========================> Azzera cosa mi aspetto di ottenere in output '========================> Azzera errori in output rispetto alle mie aspettative '========================> Azzera BIAS NODES per le celle di strato output '========================> Azzera collegamenti tra OUTPUT ed i rispettivi BIAS NODES '========================> Azzera ultimi delta pesi tra OUTPUT ed i BIAS NODES For LocalI = 1 To NumCelleStratoOutput M_OUTPUT(LocalI) = 0 M_OUTPUT_DESIDERATI(LocalI) = 0 M_ERRORI_OUTPUT(LocalI) = 0 M_BiasNodes_OUTPUT(LocalI) = 0 M_Strato_OUT_BIAS(LocalI) = 0 M_ULTIMI_DELTAW_OB(LocalI) = 0 Next Exit_Azzera: Exit Sub Err_Azzera: MsgBox "AzzeraTutteLeMatrici: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Azzera End Sub Sub AzzeraTrannePesiCollegamenti() '========================> Per pulizia dei dati ma non dei pesi collegamenti On Error GoTo Err_AzzNocollegamenti Dim LocalI As Integer Dim LocalJ As Integer '========================> Azzera nodi strato input For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput M_INPUT(LocalI, LocalJ) = 0 Next Next '========================> Azzera nodi hidden layer For LocalI = 1 To NumCelleHiddenLayer M_HIDDEN(LocalI) = 0 Next '========================> Azzera strato output '========================> Azzera cosa mi aspetto di ottenere in output For LocalI = 1 To NumCelleStratoOutput M_OUTPUT(LocalI) = 0 M_OUTPUT_DESIDERATI(LocalI) = 0 Next '========================> Non tocco i BIAS NODES, che sono inizializzati ad 1 e '========================> tali devono rimanere! Exit_AzzNocollegamenti: Exit Sub Err_AzzNocollegamenti: MsgBox "AzzeraTrannePesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_AzzNocollegamenti End Sub Sub PredisponiTabellaPesoCollegamenti(Valore As Double) On Error GoTo Err_PredisponiTabellacollegamenti '=================================================================== ' Vinco la tentazione di rendere totalmente parametrica questa fase ' é ovvio che potrei farmi passare come parametro tutto quanto, numero ' dello strato e dimensione dello strato. Altrettanto ovvio è che potrei ' ricorrere ad una tabella di configurazione, con un record per ogni ' strato di pesi, dalla quale leggere ogni informazione necessaria '=================================================================== ' Da consigli ricevuti (vedi commenti iniziali) pare che mi bastino ' quattro celle nell'hidden layer, oltre alle quattro dell'output ' Quindi qui predispongo brutalmente 416 celle di cui 400 nel primo ' strato di pesi, e 16 nel secondo. ' Nel PRIMO STRATO DI collegamenti la cella è localizzata come segue: ' strato di pesi = 1 ' x strato di input ' y stato di input ' x "hidden layer" (fisso a 1 : è un vettore unidimensionale) ' y "hidden layer" (da 1 a 4) '=========================> Totale primo strato: 400 collegamenti ' Nel SECONDO STRATO DI collegamenti la cella è localizzata come segue: ' strato di pesi = 2 ' x "hidden layer" (fisso a 1 : è un vettore unidimensionale) ' y "hidden layer" (da 1 a 4) ' x strato di output (fisso a 1 : è un vettore unidimensionale) ' y strato di output (da 1 a 4) '=========================> Totale secondo strato: 16 collegamenti ' SONO PREVISTI DUE ULTERIORI STRATI ' UNO PER MEMORIZZARE IL PESO DEI COLLEGAMENTI "UNO A UNO" TRA LE CELLE ' DI HIDDEN LAYER ED I RISPETTIVI BIAS NODES ' UNO PER MEMORIZZARE IL PESO DEI COLLEGAMENTI "UNO A UNO" TRA LE CELLE ' DI OUTPUT LAYER ED I RISPETTIVI BIAS NODES ' Sebbene tecnicamente il significato non sia esattamente identico a ' quello degli altri strati, nulla naturalmente impedisce di memorizzare ' e gestire questi collegamenti esattamente come gli altri '====================================================================== ' Nel TERZO STRATO DI collegamenti la cella è localizzata come segue: ' strato di pesi = 3 ' x "hidden layer" (fisso a 1 : è un vettore unidimensionale) ' y "hidden layer" (da 1 a 4) ' x fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE ' y fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE '=========================> Totale terzo strato: 4 collegamenti ' Nel QUARTO STRATO DI collegamenti la cella è localizzata come segue: ' strato di pesi = 4 ' x strato di output (fisso a 1 : è un vettore unidimensionale) ' y strato di output (da 1 a 4) ' x fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE ' y fisso a 00 - uniscono le singole celle alla singola cella di BIAS NODE '=========================> Totale terzo strato: 4 collegamenti '=================================================================== 'Previa eliminazione di tutti i records eventualmente esistenti, 'corredo la tabella PESO_COLLEGAMENTI di un adeguato numero di records, 'La chiave è una stringa del tipo "SIIJJiijj" 'dove: 'S è il numero dello strato di collegamenti 'II e JJ sono gli indici posizionali dello strato "di provenienza" 'ii e jj sono gli indici posizionali dello strato "di destinazione" '==================> Indici Locali Dim LocalItop As Integer Dim LocalJtop As Integer Dim LocalIbottom As Integer Dim LocalJbottom As Integer '==================> Numero strato Dim LocalS As Integer '==================> Chiave di ricerca Dim Chiave As String '==================> Random Seed Dim RND_SEED As Integer '==================> SORTEGGIO SEGNO Dim PIUOMENO As Double '==================> Chiedo conferma della cancellazione '==================> del contenuto corrente della tabella PESO_COLLEGAMENTI If MsgBox("Confermate l'azzeramento della tabella PESO_COLLEGAMENTI?", vbYesNo, "PredisponiTabellacollegamenti") = vbNo Then Exit Sub End If '==================> Svuoto tabella collegamenti DoCmd.RunSQL "Delete * from PESO_COLLEGAMENTI" ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella collegamenti come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable) ' Attiva l'indice associato COORDINATE rst.Index = "COORDINATE" '================================================================================== 'Forzo in associazione ad ogni collegamento un valore random in un range - X / + X '(X è il valore di inizializzazione passatomi nel parametro VALORE. '================================================================================== '========================= 'Inizializzo RANDOM SEED '========================= RND_SEED = 1 '========================= ' PRIMO STRATO - 400 COLLEGAMENTI ' mettono in contatto una matrice 10 x 10 ' con una matrice 1 x 4 '========================= LocalS = 1 'per ogni riga strato sopra For LocalItop = 1 To 10 'per ogni colonna strato sopra For LocalJtop = 1 To 10 'per ogni riga strato sotto For LocalIbottom = 1 To 1 'per ogni colonna strato sotto For LocalJbottom = 1 To 4 'Compongo la chiave da salvare Chiave = LTrim$(Str$(LocalS)) + Format$(LocalItop, "00") + Format$(LocalJtop, "00") + Format$(LocalIbottom, "00") + Format$(LocalJbottom, "00") ' AGGIUNGO NUOVO RECORD rst.AddNew ' salvo chiave rst!Posizione = Chiave '===\ '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore '===/ '=======================> "SORTEGGIO" il segno RND_SEED = RND_SEED + 1 Randomize RND_SEED PIUOMENO = Rnd '=======================> "SORTEGGIO" il VALORE RND_SEED = RND_SEED + 1 Randomize RND_SEED '================================================ ' salvo valore calcolato con il segno sorteggiato '================================================ If PIUOMENO > 0.5 Then rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore Else rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1 End If ' salvo il record rst.Update Next Next Next Next '======================================= ' SECONDO STRATO - 16 COLLEGAMENTI ' mettono in contatto una matrice 1 x 4 ' con una matrice 1 x 4 '======================================= LocalS = 2 'per ogni riga strato sopra For LocalItop = 1 To 1 'per ogni colonna strato sopra For LocalJtop = 1 To 4 'per ogni riga strato sotto For LocalIbottom = 1 To 1 'per ogni colonna strato sotto For LocalJbottom = 1 To 4 'Compongo la chiave da salvare Chiave = LTrim$(Str$(LocalS)) + Format$(LocalItop, "00") + Format$(LocalJtop, "00") + Format$(LocalIbottom, "00") + Format$(LocalJbottom, "00") ' AGGIUNGO NUOVO RECORD rst.AddNew ' salvo chiave rst!Posizione = Chiave '=======================> "SORTEGGIO" il segno RND_SEED = RND_SEED + 1 Randomize RND_SEED PIUOMENO = Rnd '=======================> "SORTEGGIO" il VALORE RND_SEED = RND_SEED + 1 Randomize RND_SEED '===\ '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore '===/ '================================================ ' salvo valore calcolato con il segno sorteggiato '================================================ If PIUOMENO > 0.5 Then rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore Else rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1 End If ' salvo il record rst.Update Next Next Next Next '========================= ' TERZO STRATO - 4 COLLEGAMENTI ' mettono in contatto quattro celle di un vettore 1 x 4 ' con le rispettive celle di BIAS NODE senza incroci '========================= For LocalItop = 1 To NumCelleHiddenLayer 'Compongo la chiave da salvare Chiave = "301" + Format$(LocalItop, "00") + "0000" ' AGGIUNGO NUOVO RECORD rst.AddNew ' salvo chiave rst!Posizione = Chiave '=======================> "SORTEGGIO" il segno RND_SEED = RND_SEED + 1 Randomize RND_SEED PIUOMENO = Rnd '=======================> "SORTEGGIO" il VALORE RND_SEED = RND_SEED + 1 Randomize RND_SEED '===\ '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore '===/ '================================================ ' salvo valore calcolato con il segno sorteggiato '================================================ If PIUOMENO > 0.5 Then rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore Else rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1 End If ' salvo il record rst.Update Next '========================= ' QUARTO STRATO - 4 COLLEGAMENTI ' mettono in contatto quattro celle di un vettore 1 x 4 ' con le rispettive celle di BIAS NODE senza incroci '========================= '========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes For LocalItop = 1 To NumCelleStratoOutput 'Compongo la chiave da salvare Chiave = "401" + Format$(LocalItop, "00") + "0000" ' AGGIUNGO NUOVO RECORD rst.AddNew ' salvo chiave rst!Posizione = Chiave '=======================> "SORTEGGIO" il segno RND_SEED = RND_SEED + 1 Randomize RND_SEED PIUOMENO = Rnd '=======================> "SORTEGGIO" il VALORE RND_SEED = RND_SEED + 1 Randomize RND_SEED '===\ '====> Devo assegnare un peso RANDOM nel range - Valore / + Valore '===/ '================================================ ' salvo valore calcolato con il segno sorteggiato '================================================ If PIUOMENO > 0.5 Then rst!Peso = (Int(100 * Rnd + 1) / 100) * 10 * Valore Else rst!Peso = ((Int(100 * Rnd + 1) / 100) * 10 * Valore) * -1 End If ' salvo il record rst.Update Next 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing Exit_PredisponiTabellacollegamenti: Exit Sub Err_PredisponiTabellacollegamenti: MsgBox "PredisponiTabellaPesoCollegamenti: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_PredisponiTabellacollegamenti End Sub Sub SalvaPesoCollegamento(Strato As Integer, RTop As Integer, CTop As Integer, RBottom As Integer, CBottom As Integer, Valore As Double) On Error GoTo Err_SalvaPesoCollegamento '========================================= 'Salvo nella apposita tabella PESO_COLLEGAMENTI 'il valore DOUBLE del peso collegamento passatomi. 'La chiave è una stringa del tipo "SIIJJiijj" 'dove 'S è il numero dello strato di collegamenti 'II e JJ sono gli indici posizionali della cella "di provenienza" 'ii e jj sono gli indici posizionali della cella "di destinazione" '-------------------------------------------------------------- 'NEL CASO DEI COLLEGAMENTI CON BIAS NODES IL DISCORSO NON VALE! '-------------------------------------------------------------- '"301010000" è il collegamento tra la prima cella hidden ed il suo bias node '"301020000" è il collegamento tra la seconda cella hidden ed il suo bias node '........ '"401010000" è il collegamento tra la prima cella output ed il suo bias node '"401020000" è il collegamento tra la seconda cella output ed il suo bias node '........ '========================================= '==================> Chiave di ricerca Dim Chiave As String 'Compongo la chiave da cercare Chiave = LTrim$(Str$(Strato)) + Format$(RTop, "00") + Format$(CTop, "00") + Format$(RBottom, "00") + Format$(CBottom, "00") ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella collegamenti come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable) ' Attiva l'indice associato COORDINATE rst.Index = "COORDINATE" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "SalvaPesoCollegamento - Chiave di ricerca " & Chiave & "non trovata" 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing Exit Sub End If 'Ricerca riuscita - mi porto in modalità EDIT rst.Edit 'salvo nel campo peso il VALORE passato come parametro rst!Peso = Valore 'Salvo il record rst.Update 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing Exit_SalvaPesoCollegamento: Exit Sub Err_SalvaPesoCollegamento: MsgBox "SalvaPesoCollegamento: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SalvaPesoCollegamento End Sub Function LeggiPesoCollegamento(Strato As Integer, RTop As Integer, CTop As Integer, RBottom As Integer, CBottom As Integer) As Double On Error GoTo Err_LeggiPesoCollegamento '========================================= 'Leggo dalla apposita tabella peso_collegamenti 'il valore DOUBLE del peso del collegamento passatomi. 'La chiave è una stringa del tipo "SIIJJiijj" 'dove 'S è il numero dello strato di collegamenti 'II e JJ sono gli indici posizionali della cella "sopra" 'ii e jj sono gli indici posizionali della cella "sotto" '-------------------------------------------------------------- 'NEL CASO DEI COLLEGAMENTI CON BIAS NODES IL DISCORSO NON VALE! '-------------------------------------------------------------- '"301010000" è il collegamento tra la prima cella hidden ed il suo bias node '"301020000" è il collegamento tra la seconda cella hidden ed il suo bias node '........ '"401010000" è il collegamento tra la prima cella output ed il suo bias node '"401020000" è il collegamento tra la seconda cella output ed il suo bias node '........ '========================================= '==================> Chiave di ricerca Dim Chiave As String '==================> Valore da restituire Dim Ridai As Double 'Compongo la chiave da cercare Chiave = LTrim$(Str$(Strato)) + Format$(RTop, "00") + Format$(CTop, "00") + Format$(RBottom, "00") + Format$(CBottom, "00") ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella PESO_COLLEGAMENTI come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset("PESO_COLLEGAMENTI", dbOpenTable) ' Attiva l'indice associato COORDINATE rst.Index = "COORDINATE" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "LeggiPesoCollegamento - Chiave di ricerca " & Chiave & "non trovata" Ridai = 0 Else 'Ricerca riuscita - salvo nel campo RIDAI il valore dato Ridai = rst!Peso End If 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing LeggiPesoCollegamento = Ridai Exit_LeggiPesoCollegamento: Exit Function Err_LeggiPesoCollegamento: MsgBox "LeggiPesoColegamento: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_LeggiPesoCollegamento End Function Sub LeggiTuttiIPesiCollegamenti() On Error GoTo Err_LeggiTutticollegamenti '========================================= 'Leggo dalla apposita tabella PESO_COLLEGAMENTI 'tutti i pesi relativi ai collegamenti, e li 'metto nelle apposite matrici '========================================= '========================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer Dim LocalK As Integer '==================> Chiave di ricerca Dim Chiave As String '==================> Nome Tabella PESO_COLLEGAMENTI Dim NomeTabella As String Dim Trovata As Boolean Dim tdfCiclo As TableDef '==================> Chiedo il nome della Tabella PESO_COLLEGAMENTI da usare 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)) '==================> verifico l'esistenza della tabella ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Per ora, non so se esiste Trovata = False ' Spazzo tutte le TableDefs For Each tdfCiclo In dbs.TableDefs If tdfCiclo.name = NomeTabella Then Trovata = True End If Next '=========================> Se la tabella peso collegamenti indicata non esiste, non proseguo If Trovata = False Then Beep MsgBox "La tabella " & NomeTabella & " non esiste! Sospendo l'esecuzione." Exit Sub End If '==================> Accedo a tabella ' Apre la tabella peso collegamenti indicata come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset(NomeTabella, dbOpenTable) ' Attiva l'indice associato COORDINATE rst.Index = "COORDINATE" ' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti ' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 CELLE ' TERZO STRATO collegamenti HIDDEN LAYER / BIAS NODES - vettore unidimensionale 4 CELLE ' QUARTO STRATO collegamenti STRATO OUTPUT / BIAS NODES - vettore unidimensionale 4 CELLE '========================> Legge pesi collegamenti strato 1 tra INPUT e HIDDEN For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput For LocalK = 1 To NumCelleHiddenLayer 'Compongo la chiave da cercare Chiave = "1" + Format$(LocalI, "00") + Format$(LocalJ, "00") + "01" + Format$(LocalK, "00") 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else M_Strato1(LocalI, LocalJ, LocalK) = rst!Peso End If Next Next Next '========================> Legge pesi collegamenti strato 2 tra hidden e output For LocalI = 1 To NumCelleHiddenLayer For LocalJ = 1 To NumCelleStratoOutput 'Compongo la chiave da cercare Chiave = "201" + Format$(LocalI, "00") + "01" + Format$(LocalJ, "00") 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else M_Strato2(LocalI, LocalJ) = rst!Peso End If Next Next '========================> Legge pesi collegamenti strato 3 tra hidden e Bias Nodes For LocalI = 1 To NumCelleHiddenLayer 'Compongo la chiave da cercare Chiave = "301" + Format$(LocalI, "00") + "0000" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else M_Strato_HID_BIAS(LocalI) = rst!Peso End If Next '========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes For LocalI = 1 To NumCelleStratoOutput 'Compongo la chiave da cercare Chiave = "401" + Format$(LocalI, "00") + "0000" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "LeggiTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else M_Strato_OUT_BIAS(LocalI) = rst!Peso End If Next 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing '============> Avviso di avere provveduto MsgBox "Tutti i pesi dei collegamenti sono stati letti dalla tabella " & NomeTabella Exit_LeggiTutticollegamenti: Exit Sub Err_LeggiTutticollegamenti: MsgBox "LeggiTuttiIPesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_LeggiTutticollegamenti End Sub Sub ScriviTuttiIPesiCollegamenti() On Error GoTo Err_ScriviTutticollegamenti '========================================= 'Leggo dalle apposite matrici tutti i valori 'relativi al peso dei collegamenti, e li 'metto nella apposita tabella '========================================= '========================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer Dim LocalK As Integer '==================> Chiave di ricerca Dim Chiave As String '==================> Nome Tabella PESO_COLLEGAMENTI Dim NomeTabella As String Dim Trovata As Boolean Dim tdfCiclo As TableDef '==================> Chiedo il nome della Tabella PESO_COLLEGAMENTIcollegamenti da usare 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)) '==================> verifico l'esistenza della tabella ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Per ora, non so se esiste Trovata = False ' Spazzo tutte le TableDefs For Each tdfCiclo In dbs.TableDefs If tdfCiclo.name = NomeTabella Then Trovata = True End If Next '=========================> Se la tabella peso collegamenti indicata non esiste, non proseguo If Trovata = False Then Beep MsgBox "La tabella " & NomeTabella & " non esiste! Sospendo l'esecuzione." Exit Sub End If '==================> Accedo a tabella ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella PESO_COLLEGAMENTI come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset(NomeTabella, dbOpenTable) ' Attiva l'indice associato COORDINATE rst.Index = "COORDINATE" ' PRIMO STRATO collegamenti - matrice tridimensionale 10 x 10 x 4 = 400 collegamenti ' STRATO DATI DUE - HIDDEN LAYER - vettore unidimensionale 4 celle ' SECONDO STRATO collegamenti - matrice bidimensionale 4 x 4 = 16 collegamenti '========================> Scrive pesi collegamenti strato 1 - tra Input e Hidden For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput For LocalK = 1 To NumCelleHiddenLayer 'Compongo la chiave da cercare Chiave = "1" + Format$(LocalI, "00") + Format$(LocalJ, "00") + "01" + Format$(LocalK, "00") 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else '=============> Mi porto in modalità modifica record rst.Edit '=============> Salvo il peso della cella corrente rst!Peso = M_Strato1(LocalI, LocalJ, LocalK) '=============> Salvo il record rst.Update End If Next Next Next '========================> Scrive pesi collegamenti strato 2 - tra Hidden e Output For LocalI = 1 To NumCelleHiddenLayer For LocalJ = 1 To NumCelleStratoOutput 'Compongo la chiave da cercare Chiave = "201" + Format$(LocalI, "00") + "01" + Format$(LocalJ, "00") 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "ScriviTuttiIPesiCollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else '=============> Mi porto in modalità modifica record rst.Edit '=============> Salvo il peso della cella corrente rst!Peso = M_Strato2(LocalI, LocalJ) '=============> Salvo il record rst.Update End If Next Next '========================= ' TERZO STRATO - 4 COLLEGAMENTI ' mettono in contatto quattro celle di un vettore 1 x 4 ' con le rispettive celle di BIAS NODE senza incroci '========================= For LocalI = 1 To NumCelleHiddenLayer 'Compongo la chiave da cercare Chiave = "301" + Format$(LocalI, "00") + "0000" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else '=============> Mi porto in modalità modifica record rst.Edit '=============> Salvo il peso della cella corrente rst!Peso = M_Strato_HID_BIAS(LocalI) '=============> Salvo il record rst.Update End If Next '========================= ' QUARTO STRATO - 4 COLLEGAMENTI ' mettono in contatto quattro celle di un vettore 1 x 4 ' con le rispettive celle di BIAS NODE senza incroci '========================= '========================> Legge pesi collegamenti strato 4 tra Output e Bias Nodes For LocalI = 1 To NumCelleStratoOutput 'Compongo la chiave da cercare Chiave = "401" + Format$(LocalI, "00") + "0000" 'Mi porto su record corrispondente alla chiave rst.Seek "=", Chiave 'Prevedo l'eventualità di un errore If rst.NoMatch Then MsgBox "ScriviTuttiIcollegamenti - Chiave di ricerca " & Chiave & "non trovata" Else '=============> Mi porto in modalità modifica record rst.Edit '=============> Salvo il peso della cella corrente rst!Peso = M_Strato_OUT_BIAS(LocalI) '=============> Salvo il record rst.Update End If Next 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing Exit_ScriviTutticollegamenti: Exit Sub Err_ScriviTutticollegamenti: MsgBox "ScriviTuttiIPesiCollegamenti: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_ScriviTutticollegamenti End Sub Sub FillMatriceInput(matricedati() As Integer) '================================================== 'Trasferisco una matrice di dati 10 x 10 in M_INPUT '================================================== On Error GoTo Err_FillMatriceInput '========================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer '========================> Azzera strato input For LocalI = 1 To NumCelleStratoInput For LocalJ = 1 To NumCelleStratoInput M_INPUT(LocalI, LocalJ) = matricedati(LocalI, LocalJ) Next Next Exit_FillMatriceInput: Exit Sub Err_FillMatriceInput: MsgBox "FillMatriceInput: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillMatriceInput End Sub ================================= ================================= ==== F O R M =================== ================================= ================================= Option Compare Database Option Explicit '============> Matrice che contiene quanto visualiuzzato sul display '============> 10 x 10 a video - metodologicamente non attiene alla '============> rete neurale, ma è un semplice stratagemma per rappresentare '============> un problema a video Dim MatriceVideo(10, 10) As Integer '============> queste righe sono uno stratagemma che metodologicamente '============> non attiene alla rete neurale, per riempire rapidamente '============> il display 10 x 10 su video con una figura (pattern) da '============> usare come input per la analisi o l'addestramento Dim Righevideo(10) As String Public Sub ColoraCella(quale As String) 'Error trap On Error GoTo Err_ColoraCella If Me(quale).BackColor = 0 Then Me(quale).BackColor = 16777215 Else Me(quale).BackColor = 0 End If Exit_ColoraCella: Exit Sub Err_ColoraCella: MsgBox "ColoraCella: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_ColoraCella End Sub Private Sub Form_Open(Cancel As Integer) 'Error trap On Error GoTo Err_Form_Open 'Pulisco il riquadro video PulisciDisplay 'Svuoto "MatriceVideo" SvuotaMatriceVideo '=========================> Tutte a "rosso" le caselle degli esiti SvuotaEsiti '=========================> Me!prova.Caption = "" '=========================== 'Mostro spiegazione iniziale '=========================== Me.Presentazione.Top = 0 Me.Presentazione.Left = 0 Me.Presentazione.Width = 8610 Me.Presentazione.Height = 6100 Me.Presentazione.Visible = True Exit_Form_Open: Exit Sub Err_Form_Open: MsgBox "FORM_OPEN: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Form_Open End Sub Private Sub Chiudi_Click() On Error GoTo Err_Chiudi_Click 'Chiudo la form DoCmd.Close Exit_Chiudi_Click: Exit Sub Err_Chiudi_Click: MsgBox "Chiudi: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Chiudi_Click End Sub Private Sub Inizializza_Click() On Error GoTo Err_IniClick '=========================> Tutte a "rosso" le caselle degli esiti SvuotaEsiti If MsgBox("Questa inizializzazione svuoterà gli strati della rete neurale! Procedo?", vbYesNo, "Attenzione!") = vbYes Then '====================> Azzero tutte le matrici AzzeraTutteLeMatrici '====================================================================== ' Leggo da tabella PESO COLLEGAMENTI (o da altra indicata dall'utente) ' i i valori da porre nelle matrici dei collegamenti '====================================================================== '====================> Riempio i vettori dei collegamenti LeggiTuttiIPesiCollegamenti End If Exit_IniClick: Exit Sub Err_IniClick: MsgBox "Pulsante Inizializza: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_IniClick End Sub Private Sub Presentazione_Click() On Error GoTo Err_Presentazione 'Faccio sparire il riquadro iniziale di testo 'per prima cosa, passo il "fuoco" da un'altra parte, così da 'potere rendere invisibile il controllo corrente Me.Chiudi.SetFocus Me.Presentazione.Visible = False Exit_Presentazione: Exit Sub Err_Presentazione: MsgBox "Presentazione_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Presentazione End Sub Sub PulisciDisplay() On Error GoTo Err_PulisciDisplay Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String '============================ ' Pulisco il display 10x10 '============================ For LocalI = 1 To 10 For LocalJ = 1 To 10 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo 'elemento della matrice di Score Me(NomeCTRL).Caption = " " Me(NomeCTRL).BackColor = 16777215 Next Next Exit_PulisciDisplay: Exit Sub Err_PulisciDisplay: MsgBox "PulisciDisplay: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_PulisciDisplay End Sub Private Sub R1C1_Click() ColoraCella ("R1C1") End Sub Private Sub R1C2_Click() ColoraCella ("R1C2") End Sub Private Sub R1C3_Click() ColoraCella ("R1C3") End Sub Private Sub R1C4_Click() ColoraCella ("R1C4") End Sub Private Sub R1C5_Click() ColoraCella ("R1C5") End Sub Private Sub R1C6_Click() ColoraCella ("R1C6") End Sub Private Sub R1C7_Click() ColoraCella ("R1C7") End Sub Private Sub R1C8_Click() ColoraCella ("R1C8") End Sub Private Sub R1C9_Click() ColoraCella ("R1C9") End Sub Private Sub R1C10_Click() ColoraCella ("R1C10") End Sub Private Sub R2C1_Click() ColoraCella ("R2C1") End Sub Private Sub R2C2_Click() ColoraCella ("R2C2") End Sub Private Sub R2C3_Click() ColoraCella ("R2C3") End Sub Private Sub R2C4_Click() ColoraCella ("R2C4") End Sub Private Sub R2C5_Click() ColoraCella ("R2C5") End Sub Private Sub R2C6_Click() ColoraCella ("R2C6") End Sub Private Sub R2C7_Click() ColoraCella ("R2C7") End Sub Private Sub R2C8_Click() ColoraCella ("R2C8") End Sub Private Sub R2C9_Click() ColoraCella ("R2C9") End Sub Private Sub R2C10_Click() ColoraCella ("R2C10") End Sub Private Sub R3C1_Click() ColoraCella ("R3C1") End Sub Private Sub R3C2_Click() ColoraCella ("R3C2") End Sub Private Sub R3C3_Click() ColoraCella ("R3C3") End Sub Private Sub R3C4_Click() ColoraCella ("R3C4") End Sub Private Sub R3C5_Click() ColoraCella ("R3C5") End Sub Private Sub R3C6_Click() ColoraCella ("R3C6") End Sub Private Sub R3C7_Click() ColoraCella ("R3C7") End Sub Private Sub R3C8_Click() ColoraCella ("R3C8") End Sub Private Sub R3C9_Click() ColoraCella ("R3C9") End Sub Private Sub R3C10_Click() ColoraCella ("R3C10") End Sub Private Sub R4C1_Click() ColoraCella ("R4C1") End Sub Private Sub R4C2_Click() ColoraCella ("R4C2") End Sub Private Sub R4C3_Click() ColoraCella ("R4C3") End Sub Private Sub R4C4_Click() ColoraCella ("R4C4") End Sub Private Sub R4C5_Click() ColoraCella ("R4C5") End Sub Private Sub R4C6_Click() ColoraCella ("R4C6") End Sub Private Sub R4C7_Click() ColoraCella ("R4C7") End Sub Private Sub R4C8_Click() ColoraCella ("R4C8") End Sub Private Sub R4C9_Click() ColoraCella ("R4C9") End Sub Private Sub R4C10_Click() ColoraCella ("R4C10") End Sub Private Sub R5C1_Click() ColoraCella ("R5C1") End Sub Private Sub R5C2_Click() ColoraCella ("R5C2") End Sub Private Sub R5C3_Click() ColoraCella ("R5C3") End Sub Private Sub R5C4_Click() ColoraCella ("R5C4") End Sub Private Sub R5C5_Click() ColoraCella ("R5C5") End Sub Private Sub R5C6_Click() ColoraCella ("R5C6") End Sub Private Sub R5C7_Click() ColoraCella ("R5C7") End Sub Private Sub R5C8_Click() ColoraCella ("R5C8") End Sub Private Sub R5C9_Click() ColoraCella ("R5C9") End Sub Private Sub R5C10_Click() ColoraCella ("R5C10") End Sub Private Sub R6C1_Click() ColoraCella ("R6C1") End Sub Private Sub R6C2_Click() ColoraCella ("R6C2") End Sub Private Sub R6C3_Click() ColoraCella ("R6C3") End Sub Private Sub R6C4_Click() ColoraCella ("R6C4") End Sub Private Sub R6C5_Click() ColoraCella ("R6C5") End Sub Private Sub R6C6_Click() ColoraCella ("R6C6") End Sub Private Sub R6C7_Click() ColoraCella ("R6C7") End Sub Private Sub R6C8_Click() ColoraCella ("R6C8") End Sub Private Sub R6C9_Click() ColoraCella ("R6C9") End Sub Private Sub R6C10_Click() ColoraCella ("R6C10") End Sub Private Sub R7C1_Click() ColoraCella ("R7C1") End Sub Private Sub R7C2_Click() ColoraCella ("R7C2") End Sub Private Sub R7C3_Click() ColoraCella ("R7C3") End Sub Private Sub R7C4_Click() ColoraCella ("R7C4") End Sub Private Sub R7C5_Click() ColoraCella ("R7C5") End Sub Private Sub R7C6_Click() ColoraCella ("R7C6") End Sub Private Sub R7C7_Click() ColoraCella ("R7C7") End Sub Private Sub R7C8_Click() ColoraCella ("R7C8") End Sub Private Sub R7C9_Click() ColoraCella ("R7C9") End Sub Private Sub R7C10_Click() ColoraCella ("R7C10") End Sub Private Sub R8C1_Click() ColoraCella ("R8C1") End Sub Private Sub R8C2_Click() ColoraCella ("R8C2") End Sub Private Sub R8C3_Click() ColoraCella ("R8C3") End Sub Private Sub R8C4_Click() ColoraCella ("R8C4") End Sub Private Sub R8C5_Click() ColoraCella ("R8C5") End Sub Private Sub R8C6_Click() ColoraCella ("R8C6") End Sub Private Sub R8C7_Click() ColoraCella ("R8C7") End Sub Private Sub R8C8_Click() ColoraCella ("R8C8") End Sub Private Sub R8C9_Click() ColoraCella ("R8C9") End Sub Private Sub R8C10_Click() ColoraCella ("R8C10") End Sub Private Sub R9C1_Click() ColoraCella ("R9C1") End Sub Private Sub R9C2_Click() ColoraCella ("R9C2") End Sub Private Sub R9C3_Click() ColoraCella ("R9C3") End Sub Private Sub R9C4_Click() ColoraCella ("R9C4") End Sub Private Sub R9C5_Click() ColoraCella ("R9C5") End Sub Private Sub R9C6_Click() ColoraCella ("R9C6") End Sub Private Sub R9C7_Click() ColoraCella ("R9C7") End Sub Private Sub R9C8_Click() ColoraCella ("R9C8") End Sub Private Sub R9C9_Click() ColoraCella ("R9C9") End Sub Private Sub R9C10_Click() ColoraCella ("R9C10") End Sub Private Sub R10C1_Click() ColoraCella ("R10C1") End Sub Private Sub R10C2_Click() ColoraCella ("R10C2") End Sub Private Sub R10C3_Click() ColoraCella ("R10C3") End Sub Private Sub R10C4_Click() ColoraCella ("R10C4") End Sub Private Sub R10C5_Click() ColoraCella ("R10C5") End Sub Private Sub R10C6_Click() ColoraCella ("R10C6") End Sub Private Sub R10C7_Click() ColoraCella ("R10C7") End Sub Private Sub R10C8_Click() ColoraCella ("R10C8") End Sub Private Sub R10C9_Click() ColoraCella ("R10C9") End Sub Private Sub R10C10_Click() ColoraCella ("R10C10") End Sub Sub FillMatriceVideoX() On Error GoTo Err_FillX '==================================== 'Carico un pattern a X in RIGHEVIDEO '==================================== Righevideo(1) = "1100000011" Righevideo(2) = "0110000110" Righevideo(3) = "0011001100" Righevideo(4) = "0001111000" Righevideo(5) = "0000110000" Righevideo(6) = "0000110000" Righevideo(7) = "0001111000" Righevideo(8) = "0011001100" Righevideo(9) = "0110000110" Righevideo(10) = "1100000011" '=============================================== ' Passo tale pattern nella matrice MATRICEVIDEO '=============================================== FillMatriceVideoconRigheVideo '=============================================== ' Riverso sul display 10 x 10 MATRICEVIDEO '=============================================== MostraMatriceVideo Exit_FillX: Exit Sub Err_FillX: MsgBox "FillMatriceVideoX: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillX End Sub Sub FillMatriceVideoO() On Error GoTo Err_FillO '==================================== 'Carico un pattern a O in RIGHEVIDEO '==================================== Righevideo(1) = "0000110000" Righevideo(2) = "0001111000" Righevideo(3) = "0011001100" Righevideo(4) = "0110000110" Righevideo(5) = "1100000011" Righevideo(6) = "1100000011" Righevideo(7) = "0110000110" Righevideo(8) = "0011001100" Righevideo(9) = "0001111000" Righevideo(10) = "0000110000" '=============================================== ' Passo tale pattern nella matrice MATRICEVIDEO '=============================================== FillMatriceVideoconRigheVideo '=============================================== ' Riverso sul display 10 x 10 MATRICEVIDEO '=============================================== MostraMatriceVideo Exit_FillO: Exit Sub Err_FillO: MsgBox "FillMatriceVideoO: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillO End Sub Sub FillMatriceVideoPiu() On Error GoTo Err_FillPiu '==================================== 'Carico un pattern a + in RIGHEVIDEO '==================================== Righevideo(1) = "0001111000" Righevideo(2) = "0001111000" Righevideo(3) = "0001111000" Righevideo(4) = "1111111111" Righevideo(5) = "1111111111" Righevideo(6) = "1111111111" Righevideo(7) = "1111111111" Righevideo(8) = "0001111000" Righevideo(9) = "0001111000" Righevideo(10) = "0001111000" '=============================================== ' Passo tale pattern nella matrice MATRICEVIDEO '=============================================== FillMatriceVideoconRigheVideo '=============================================== ' Riverso sul display 10 x 10 MATRICEVIDEO '=============================================== MostraMatriceVideo Exit_FillPiu: Exit Sub Err_FillPiu: MsgBox "FillMatriceVideoPiu: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillPiu End Sub Sub FillMatriceVideoQuad() On Error GoTo Err_FillQuad '========================================== 'Carico un pattern a quadrato in RIGHEVIDEO '========================================== Righevideo(1) = "1111111111" Righevideo(2) = "1111111111" Righevideo(3) = "1100000011" Righevideo(4) = "1100000011" Righevideo(5) = "1100000011" Righevideo(6) = "1100000011" Righevideo(7) = "1100000011" Righevideo(8) = "1100000011" Righevideo(9) = "1111111111" Righevideo(10) = "1111111111" '=============================================== ' Passo tale pattern nella matrice MATRICEVIDEO '=============================================== FillMatriceVideoconRigheVideo '=============================================== ' Riverso sul display 10 x 10 MATRICEVIDEO '=============================================== MostraMatriceVideo Exit_FillQuad: Exit Sub Err_FillQuad: MsgBox "FillMatriceVideoQuad: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillQuad End Sub Sub FillMatriceVideoconRigheVideo() On Error GoTo Err_FillMatVideoRigheVideo Dim LocalI As Integer Dim LocalJ As Integer Dim pezzo As String '======================================================== ' Riverso il contenuto di "RIGHEVIDEO" in "MATRICEVIDEO" ' RIGHEVIDEO contiene il disegno di un pattern che previa ' eventuale modifica riverserò in matrice di input per ' addestramento o analisi '======================================================== For LocalI = 1 To 10 For LocalJ = 1 To 10 pezzo = Mid$(Righevideo(LocalI), LocalJ, 1) If pezzo = "1" Then MatriceVideo(LocalI, LocalJ) = 1 Else MatriceVideo(LocalI, LocalJ) = 0 End If Next Next Exit_FillMatVideoRigheVideo: Exit Sub Err_FillMatVideoRigheVideo: MsgBox "FillMatriceVideoconRigheVideo: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillMatVideoRigheVideo End Sub Sub MostraMatriceVideo() On Error GoTo Err_MostraMatriceVideo Dim LocalI As Integer Dim LocalJ As Integer Dim NomeControllo As String '======================================================== ' Rappresento sul display 10 x 10 il pattern memorizzato ' in MatriceVideo - 1 = pixel nero, 0 = pixel bianco '======================================================== For LocalI = 1 To 10 For LocalJ = 1 To 10 NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ)) If MatriceVideo(LocalI, LocalJ) = 1 Then Me(NomeControllo).BackColor = 0 Else Me(NomeControllo).BackColor = 16777215 End If Next Next Exit_MostraMatriceVideo: Exit Sub Err_MostraMatriceVideo: MsgBox "MostraMatriceVideo: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraMatriceVideo End Sub Private Sub SalvaE2_Click() On Error GoTo Err_SalvaE2_Click '======> Per risposta utente Dim strInput As String '======> Per parametro da passare con codice pattern Dim ValInput As Integer '= 1 = "X" '= 2 = "O" '= 3 = "+" '= 4 = "quadrato" '=\ '==> Richiedo a quale dei patterns di riferimento '==> è da ricondurre l'esempio '=/ Do 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) Select Case strInput Case "X" ValInput = 1 Exit Do Case "O" ValInput = 2 Exit Do Case "C" ValInput = 3 Exit Do Case "Q" ValInput = 4 Exit Do Case Else Beep End Select Loop '=\ '==> salvo quanto su display in un record della tabella ESEMPI '=/ SalvaEsempio ValInput Exit_SalvaE2_Click: Exit Sub Err_SalvaE2_Click: MsgBox "SalvaE2_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SalvaE2_Click End Sub Private Sub SelectPattern_Click() On Error GoTo Err_SPCLICK Select Case SelectPattern.Value Case 1 FillMatriceVideoX Case 2 FillMatriceVideoO Case 3 FillMatriceVideoPiu Case 4 FillMatriceVideoQuad End Select '=============> resetto per prossima scelta SelectPattern.DefaultValue = 0 Exit_SPCLICK: Exit Sub Err_SPCLICK: MsgBox "SelectPattern_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SPCLICK End Sub Sub FillMatriceVideoconDisplay() On Error GoTo Err_FillMatVideoDisplay Dim LocalI As Integer Dim LocalJ As Integer Dim NomeControllo As String '======================================================== ' Riverso il contenuto del display 10x10 in "MATRICEVIDEO" ' le eventuali modifiche apportate al pattern saranno così ' rappresentate in MATRICEVIDEO ' Pixel nero = 1 - Pixel bianco = 0 '======================================================== For LocalI = 1 To 10 For LocalJ = 1 To 10 NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ)) If Me(NomeControllo).BackColor = 0 Then MatriceVideo(LocalI, LocalJ) = 1 Else MatriceVideo(LocalI, LocalJ) = 0 End If Next Next Exit_FillMatVideoDisplay: Exit Sub Err_FillMatVideoDisplay: MsgBox "FillMatriceVideoDisplay: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_FillMatVideoDisplay End Sub Sub SvuotaMatriceVideo() On Error GoTo Err_SvuotaMatriceVideo '=====================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer '======================================================== ' inizializzo MATRICEVIDEO a zero '======================================================== For LocalI = 1 To 10 For LocalJ = 1 To 10 MatriceVideo(LocalI, LocalJ) = 0 Next Next Exit_SvuotaMatriceVideo: Exit Sub Err_SvuotaMatriceVideo: MsgBox "SvuotaMatriceVideo: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SvuotaMatriceVideo End Sub Private Sub TRAINING_Click() On Error GoTo Err_TRAINING_Click '=========================> Indice Locale per passare da un record esempi all'altro Dim ContaRecords As Integer '=========================> Per input utente Dim strInput As String '=====================> Indici locali Dim IInput As Integer ' due coordinate per l'input layer bidimensionale Dim JInput As Integer ' due coordinate per l'input layer bidimensionale Dim IHidden As Integer ' una sola coordinata per l'hidden layer monodimensionale Dim IOutput As Integer ' una sola coordinata per l'output layer monodimensionale Dim Sommatoria As Double 'la sommatoria dei valori convergenti sulla mia cella Dim SommaErrori As Double 'la somma degli errori misurati, per decidere se c'è da ' correggere oppure no Dim ErroreQuestaCella As Double 'errore della cella corrente Dim ValoreCellaAMonte As Double ' significato "intuitivo" Dim Corr_Di_prima As Double ' la correzione precedentemente applicata al peso corrente Dim DeltaPeso As Double 'differenza da applicare ai pesi Dim Aggiungi As Double 'variabile di transito Dim BIAS As Double 'variabile di transito BIAS cella corrente Dim ESPONENTE As Double 'variabile di transito BIAS '=====================> Ospita il numero del risultato Dim NRisultato As Integer '=====================> Ospita il valore del risultato Dim ValRisultato As Double '=====================> variabile temporanea per calcolo derivate Dim Temp As Double '=====================> Ospita il valore ricevuto dalla '=====================> singola connessione verso di me Dim RicevoDaNodoCorrente As Double '=========================> Su quale set di esempi si svilupperà il training Dim SetEsempi As String '=========================> Quanti records contiene Dim NumRecEsempi As String Dim EsempiFatti As Integer 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 If MsgBox("Confermate la rigenerazione della tabella PESO_COLLEGAMENTI con pesi random nel range - 0.001 / + 0.001?", vbYesNo, "Attenzione!") = vbYes Then '====================> Ricreo la tabella peso_collegamenti PredisponiTabellaPesoCollegamenti 0.001 Else Exit Sub End If Else Exit Sub End If '=========================> Leggo in memoria la tabella pesi rigenerata '====================> Riempio i vettori dei collegamenti LeggiTuttiIPesiCollegamenti '=========================> DEFINISCO IL NOME DEL SET DI ESEMPI SetEsempi = "ESEMPI" '===============================================================> 'Apre la tabella scelta come oggetto Recordset di tipo dynaset. ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb Set rst = dbs.OpenRecordset(SetEsempi, dbOpenTable) '==============> Vedo quanti esempi dovrò esaminare rst.MoveLast NumRecEsempi = rst.RecordCount '==============> Chiudo la tabella: sarà LeggiEsempio a riaprirla ogni volta rst.Close 'Debug Me!prova.Caption = Str$(NumRecEsempi) '==\ '===> Promemoria sui nomi delle matrici '==/ ' M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer ' M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double ' M_HIDDEN(NumCelleHiddenLayer) As Double ' M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double ' M_OUTPUT(NumCelleStratoOutput) As Integer 'la matrice con i BIAS NODES per le celle di HIDDEN LAYER ' M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double 'la matrice con i BIAS NODES per le celle di STRATO OUTPUT ' M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double 'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES ' M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double 'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES ' M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double '========================================================= 'Per RETROPROPAGAZIONE ERRORI '========================================================= 'cosa mi aspetto di ottenere in output 'Public M_OUTPUT_DESIDERATI(NumCelleStratoOutput) As Double 'ultimi delta applicati ai pesi strato 1 'Public M_ULTIMI_DELTAW_S1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi strato 2 'Public M_ULTIMI_DELTAW_S2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double 'ultimi delta applicati ai pesi tra HIDDEN e BIAS CELL 'Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi tra OUTPUT e BIAS CELL 'Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput) As Double '============================================================== '===\ '====> INIZIO - APPLICARE PRIMA DELL'INIZIO DELLA SESSIONE DI TRAINING '===/ '============================================================== 'Devo preservare in apposite matrici il valore ultimo della correzione 'apportata al peso della connessione. Per consentire di referenziare 'fin dal primo esempio questa matrice vi pongo valori nulli. '============================================================== 'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi 'tra INPUT e HIDDEN (strato 1) '============================================================== For IInput = 1 To NumCelleStratoInput For JInput = 1 To NumCelleStratoInput For IHidden = 1 To NumCelleHiddenLayer M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden) = 0 Next Next Next '============================================================== 'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi 'tra HIDDEN e OUTPUT (strato 2) '============================================================== For IHidden = 1 To NumCelleHiddenLayer For IOutput = 1 To NumCelleStratoOutput M_ULTIMI_DELTAW_S2(IHidden, IOutput) = 0 Next Next '=============================================================== 'Inizializzazione a 1 dei Bias Nodes '============================================================== For IHidden = 1 To NumCelleHiddenLayer M_BiasNodes_HIDDEN(IHidden) = 1 Next For IOutput = 1 To NumCelleStratoOutput M_BiasNodes_OUTPUT(IOutput) = 1 Next '=============================================================== 'Inizializzazione a 0 degli ultimi cambiamenti apportati ai pesi 'tra HIDDEN e BIAS CELL, e tra OUTPUT e BIAS CELL '============================================================== For IHidden = 1 To NumCelleHiddenLayer M_ULTIMI_DELTAW_HB(IHidden) = 0 Next For IOutput = 1 To NumCelleStratoOutput M_ULTIMI_DELTAW_OB(IOutput) = 0 Next '============================================================== '===\ '====> FINE - APPLICARE PRIMA DELL'INIZIO DELLA SESSIONE DI TRAINING '===/ '============================================================== '============================================================================ '==================\ /====================== '===================> INIZIO CICLO DI ADDESTRAMENTO <======================= '==================/ \====================== '============================================================================ EsempiFatti = 0 '=======================================> ' LOOP DA RIPETERE PER OGNI ESEMPIO '=======================================> For ContaRecords = 1 To NumRecEsempi '===> Incremento il conteggio degli esempi fatti EsempiFatti = EsempiFatti + 1 Me!prova.Caption = Str$(NumRecEsempi - EsempiFatti) Me!prova.Visible = True Me.Repaint '===> Mi porto al Contarecords-esimo record (meno 1 perchè il primo record è 0) '===> e porto su display 10 x 10 la relativa configurazione. Il risultato '===> previsto mi viene restituito in NRisultato NRisultato = LeggiEsempio(ContaRecords) '=========================> Tutte a "rosso" le caselle degli esiti SvuotaEsiti '=========================> Azzero gli output desiderati For IOutput = 1 To NumCelleStratoOutput M_OUTPUT_DESIDERATI(IOutput) = 0 Next '========================================== '= Mostro il risultato '= E VALORIZZO AD 1 LA SOLA CELLA DELLA M_OUTPUT_DESIDERATI '= RELATIVA AL RISULTATO ATTESO '= 1 = "X" '= 2 = "O" '= 3 = "+" '= 4 = "quadrato" '========================================== Select Case NRisultato Case 1 Me!ChiedoICS.BackColor = VERDE M_OUTPUT_DESIDERATI(1) = 1 Case 2 Me!ChiedoCERCHIO.BackColor = VERDE M_OUTPUT_DESIDERATI(2) = 1 Case 3 Me!ChiedoCROCE.BackColor = VERDE M_OUTPUT_DESIDERATI(3) = 1 Case 4 Me!ChiedoQUADRATO.BackColor = VERDE M_OUTPUT_DESIDERATI(4) = 1 End Select '=========================> Salvo la configurazione del display in MATRICEVIDEO FillMatriceVideoconDisplay '=========================> Trasferisco MATRICEVIDEO in MATRICE INPUT M_INPUT ' Perchè non trasferisco direttamente il "display" 10 x 10 in MATRICEINPUT ' senza avvalermi della matrice di transito MATRICEVIDEO? ' Potrei benissimo farlo in un colpo solo. Visto che comunque ho a ' disposizione MatriceVideo, la sfrutto per creare una routine che accetta una ' matrice come parametro FillMatriceInput MatriceVideo '========================================== '= PER OGNI ESEMPIO, '= Innanzitutto l'addestramento comprende '= un ciclo di analisi "normale", del quale '= valuto il risultato '========================================== Me.Refresh 'Provvisorio! 'Beep 'MsgBox "Altro esempio" 'GoTo Oltre '============================================================================== '==================\ /====================== '===================> INIZIO NORMALE CICLO DI ANALISI <======================= '==================/ \====================== '============================================================================== 'Stop '================================= '= Fase 1 - spazzata hidden layer '================================= '==============> Per ogni nodo dell'hidden layer For IHidden = 1 To NumCelleHiddenLayer '===============> Azzero la Sommatoria dei valori che '===============> determinerà l'output (=il valore) del '===============> mio neurone di hidden layer Sommatoria = 0 '===============> Per tutti i collegamenti provenienti dall'input layer che convergono '===============> sulla mia cella (=NODO) di hidden layer For IInput = 1 To NumCelleStratoInput For JInput = 1 To NumCelleStratoInput '===============> Localizzo il collegamento tra la mia cella '===============> di hidden layer e la cella corrente del '===============> layer di input RicevoDaNodoCorrente = M_INPUT(IInput, JInput) * M_Strato1(IInput, JInput, IHidden) '===\ '====> Aggiungo alla sommatoria il valore ricevuto '====> dalla connessione convergente verso il mio neurone '===/ Sommatoria = Sommatoria + RicevoDaNodoCorrente Next Next '==\ '===> Valuto l'apporto del Bias Node specifico della mia cella '==/ BIAS = M_BiasNodes_HIDDEN(IHidden) * M_Strato_HID_BIAS(IHidden) '==\ '===> Calcolo l'esponente a cui elevare "e" '===> -1 è la "costante di ripidità" della sigmoide '==/ ESPONENTE = -1 * (Sommatoria - BIAS) '===\ '====> Memorizzo nel nodo corrente il valore ottenuto '====> a partire da "Sommatoria", secondo il metodo seguente '===/ M_HIDDEN(IHidden) = 1 / (1 + Exp(ESPONENTE)) Next '================================= '= Fase 2 - spazzata layer output '================================= '==============> Per ogni nodo dello strato di output For IOutput = 1 To NumCelleStratoOutput '===============> Azzero la Sommatoria dei valori che '===============> determinerà l'output (=il valore) del '===============> mio neurone di output Sommatoria = 0 '===============> Per tutti i collegamenti provenienti dall'hidden layer che convergono '===============> sulla mia cella (=NODO) di output layer For IHidden = 1 To NumCelleHiddenLayer '===============> Localizzo il collegamento tra la mia cella '===============> di output layer e la cella corrente dell' '===============> hidden layer RicevoDaNodoCorrente = M_HIDDEN(IHidden) * M_Strato2(IHidden, IOutput) '===\ '====> Aggiungo alla sommatoria il valore ricevuto '====> dalla connessione convergente verso il mio neurone '===/ Sommatoria = Sommatoria + RicevoDaNodoCorrente Next '==\ '===> Valuto l'apporto del Bias Node specifico della mia cella '==/ BIAS = M_BiasNodes_OUTPUT(IOutput) * M_Strato_OUT_BIAS(IOutput) '==\ '===> Calcolo l'esponente a cui elevare "e" '===> -1 è la "costante di ripidità" della sigmoide '==/ ESPONENTE = -1 * (Sommatoria - BIAS) '===\ '====> Memorizzo nel nodo corrente il valore ottenuto '====> a partire da "Sommatoria", secondo il metodo seguente '===/ M_OUTPUT(IOutput) = 1 / (1 + Exp(ESPONENTE)) Next '========> DEBUG '========> In attesa di potere effettuare il training, '========> restituisco un risultato a caso '==================================================== '= Determino il risultato spazzando i nodi (=CELLE) di output '= "The winner takes it all" - la risposta è il nodo '= con il valore più elevato '==================================================== '===============> Azzero il risultato NRisultato = 0 ValRisultato = 0 '==============> Per ogni nodo dello strato di output For IOutput = 1 To NumCelleStratoOutput '================> Comunque, mostro il valore Select Case IOutput Case 1 Me!VX.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 2 Me!VO.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 3 Me!VC.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 4 Me!VQ.Caption = Format$(M_OUTPUT(IOutput), "0.000000") End Select '================> Memorizzo il risultato più alto If M_OUTPUT(IOutput) > ValRisultato Then NRisultato = IOutput ValRisultato = M_OUTPUT(IOutput) End If Next '========================================== '= Mostro il risultato '= 1 = "X" '= 2 = "O" '= 3 = "+" '= 4 = "quadrato" '========================================== Select Case NRisultato Case 1 Me!OttengoICS.BackColor = VERDE Case 2 Me!OttengoCERCHIO.BackColor = VERDE Case 3 Me!OttengoCROCE.BackColor = VERDE Case 4 Me!OttengoQUADRATO.BackColor = VERDE Case Else MsgBox "La analisi non ha dato alcun risultato (RISULTATO = 0)." End Select '============================================================================ '==================\ /====================== '===================> FINE NORMALE CICLO DI ANALISI <======================= '==================/ \====================== '============================================================================ '=========================> Mostro uno per uno l'esito degli '=========================> ultimi dieci esempi If EsempiFatti > (NumRecEsempi - 10) Then MsgBox "La rete neurale ha detto ...." End If '========================================================== 'Mi trovo a questo punto con il layer di output valorizzato '========================================================== '=============================================================== ' Addestramento stile Nikos Drakos ' http://cbl.leeds.ac.uk/nikos/pail/Intml/subsections3.11.4.html '=============================================================== 'Consiglio tecnico: ' Non mettere come VALORI DESIDERATI i valori estremi che ' non saranno raggiunti! bisogna dare all'algoritmo di training ' la possibilità di RAGGIUNGERE E SUPERARE tali valori. ' A esempio, non 1, ma 0.9 ' non 0, ma 0.1 '=========================================================== 'Nota sul gergo tecnico: 'ACTIVATION OF NODE X significa il "valore proprio" del nodo X, 'in altri punti dei commenti chiamato "OUTPUT del neurone", che 'poi è semplicemente il valore memorizzato in cella di matrice 'M_OUTPUT o M_HIDDEN. 'NODE è una cella di uno dei tre strati: INPUT, HIDDEN, OUTPUT 'WEIGHT è il peso (=VALORE) una cella di una delle matrici di "collegamenti" 'o "pesi", ovvero le due matrici di connessione "strato1" e "strato2" '=========================================================== '"SOPRA" (ABOVE) c'è lo strato di output '"SOTTO" c'è lo strato di INPUT 'Quindi la cella "sopra" è quella "VERSO LO STRATO DI OUTPUT" '=========================================================== 'First, the error for the output layer nodes is computed 'using the following formula: 'Ej = (tj-aj)aj(1-aj) 'where 'Ej= error for the node j of the output layer 'tJ= "target" activation for node J of the output lajer 'aj= actual activation for node j of the output layer '=========================================================== 'Ovvero, con riferimento ai vettori: ' M_OUTPUT: Matrice unidimensionale (=vettore) che contiene ' i nodi (=CELLE) dello strato di output ' M_OUTPUT_DESIDERATI: I valori desiderati come obiettivo ' per i nodi (=CELLE) dello strato di output ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore ' associato ai nodi (=CELLE) dello strato di output '=========================================================== '==\ '===> Riempio la matrice degli errori dello strato di OUTPUT '===> ovvero M_ERRORI_OUTPUT(NumCelleStratoOutput) 'Ej = (tj-aj)aj(1-aj) '==/ For IOutput = 1 To NumCelleStratoOutput M_ERRORI_OUTPUT(IOutput) = (M_OUTPUT_DESIDERATI(IOutput) - M_OUTPUT(IOutput)) * M_OUTPUT(IOutput) * (1 - M_OUTPUT(IOutput)) Next '=============================================================== '==================\ /====================== '===================> BACK PROPAGATION <======================= '==================/ \====================== '=============================================================== '=========================================================== '==\ '===> Riempio la matrice degli errori dell'HIDDEN LAYER '===> ovvero M_ERRORI_HIDDEN(NumCelleHiddenLayer) '==/ '============================================================ '=========================================================== 'Then, successively, the error values for all the hidden layer nodes are computed: 'Ei = ai(1-ai)Sommatoria in j di EjWij 'where 'Ei= error for the node i of the hidden layer 'Ej= Error for the node J in the layer above (OUTPUT LAYER NELLO SCHEMA) 'wij= Weight for the connection between node i in the hidden 'layer and node j in the layer above (OUTPUT LAYER NELLO SCHEMA) 'ai= activation of node I in the hidden layer '=========================================================== 'Ovvero, con riferimento ai vettori: ' M_HIDDEN: Matrice unidimensionale (=vettore) che contiene ' i nodi dell'Hidden Layer ' M_ERRORI_HIDDEN: La matrice destinata a contenere l'errore ' associato ai nodi dell'HIDDEN LAYER ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore ' associato ai nodi dell'OUTPUT LAYER ' M_STRATO2: La matrice con i nodi tra l'hidden layer e lo ' strato di output '=========================================================== '==\ '===> Riempio la matrice degli errori dell'HIDDEN LAYER '===> ovvero M_ERRORI_HIDDEN(NumNodiHiddenLayer) '==/ For IHidden = 1 To NumCelleHiddenLayer 'Inizializzo la sommatoria Sommatoria = 0 For IOutput = 1 To NumCelleStratoOutput '====> Valore che va a incrementare la sommatoria '====> variabile inutile creata per leggibilità Aggiungi = M_ERRORI_OUTPUT(IOutput) * M_Strato2(IHidden, IOutput) '=\ '==> Incremento la SOMMATORIA '=/ Sommatoria = Sommatoria + Aggiungi Next '====> Ei = ai(1-ai)Sommatoria in j di EjWij M_ERRORI_HIDDEN(IHidden) = M_HIDDEN(IHidden) * (1 - M_HIDDEN(IHidden)) * Sommatoria Next '===================================================== 'At the end of the error backward propagation phase, 'all nodes of the network (except the input layer nodes) 'will have error values. 'The error value of a node is used to compute new weights 'for the connections which lead to the node. 'Very generally, the weight change is done by using 'the following formula: 'wij = wij + DeltaWij 'where 'Wij is the weight of the connection between node I in 'the previous layer and node J in the output layer or 'in a hidden layer 'DeltaWij is the weight change for the connection between 'node I in the previous layer and node J in the output 'layer or in a hidden layer ' 'The DeltaWij values are computed in the same way for each 'node J in the network: ' 'where 'Beta is the Learning rate 'Ej is the error for node J 'ai activation for node i in the previous layer from which ' the connection originates 'm momentum parameter (a value of 0.9 is used in the model) 'Deltawij' Deltawij for the previous weight change. ' 'The weight change can be done right after the computation 'of DeltaWij values (ON LINE PROCEDURE) 'Alternatively, the Deltawij values can be summed up for 'all input patterns in the training set, and the actual 'weight change is done after each input pattern has been 'presented once (OFF LINE PROCEDURE) '=========================================================== 'Ovvero, con riferimento ai vettori: ' M_INPUT: Matrice bidimensionale (=vettore) che contiene ' i nodi dello strato di input ' M_HIDDEN: Matrice unidimensionale (=vettore) che contiene ' i nodi dell'Hidden Layer ' M_OUTPUT: Matrice unidimensionale (=vettore) che contiene ' i nodi dello strato di output ' M_ERRORI_HIDDEN: La matrice destinata a contenere l'errore ' associato ai nodi dell'HIDDEN LAYER ' M_ERRORI_OUTPUT: La matrice destinata a contenere l'errore ' associato ai nodi dell'HIDDEN LAYER ' M_STRATO1: La matrice con i nodi tra lo strato di input ' e l'hidden layer (tridimensionale di 400 pesi) ' M_STRATO2: La matrice con i nodi tra l'hidden layer e lo ' strato di output (bidimensionale di 16 pesi) ' M_ULTIMI_DELTAW_S1: gli ultimi deltapesi applicati ' a M_strato1 (400) ' M_ULTIMI_DELTAW_S2: gli ultimi deltapesi applicati ' a M_strato2 (16) 'LearningRate=0.01 'ValoreArbitrario "momentum"=0.9 'la matrice con i BIAS NODES per le celle di HIDDEN LAYER 'Public M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double 'la matrice con i BIAS NODES per le celle di STRATO OUTPUT 'Public M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double 'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES 'Public M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double 'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES 'Public M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double 'ultimi delta applicati ai pesi tra HIDDEN ed i rispettivi BIAS NODES 'Public M_ULTIMI_DELTAW_HB(NumCelleHiddenLayer) As Double 'ultimi delta applicati ai pesi tra OUTPUT ed i rispettivi BIAS NODES 'Public M_ULTIMI_DELTAW_OB(NumCelleStratoOutput) As Double '=========================================================== '==\ '===> Strategia on line '==/ '============================================================== 'Applicazione degli errori ai pesi tra INPUT e HIDDEN (strato 1) '============================================================== For IInput = 1 To NumCelleStratoInput For JInput = 1 To NumCelleStratoInput For IHidden = 1 To NumCelleHiddenLayer '=========================================================== ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER '=========================================================== ErroreQuestaCella = M_ERRORI_HIDDEN(IHidden) '=========================================================== ' Rilevo il valore della cella di input layer da cui parte ' la connessione al mio nodo '=========================================================== ValoreCellaAMonte = M_INPUT(IInput, JInput) '==========\ '===========> Leggo la correzione apportata a questo '===========> peso collegamento al ciclo precedente '==========/ Corr_Di_prima = M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden) '======================================================== ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto '======================================================== DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima) '==========\ '===========> Scrivo la correzione applicata ora '===========> per riutilizzo al ciclo successivo '==========/ M_ULTIMI_DELTAW_S1(IInput, JInput, IHidden) = DeltaPeso '======================================================== ' Applico il deltapeso appena calcolato al peso corrente '======================================================== M_Strato1(IInput, JInput, IHidden) = M_Strato1(IInput, JInput, IHidden) + DeltaPeso Next Next Next '============================================================= 'Applicazione degli errori ai pesi tra BIASNODE e HIDDEN LAYER '============================================================= For IHidden = 1 To NumCelleHiddenLayer '=========================================================== ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER '=========================================================== ErroreQuestaCella = M_ERRORI_HIDDEN(IHidden) '=========================================================== ' Rilevo il valore del Bias Node specifico della cella corrente '=========================================================== ValoreCellaAMonte = M_BiasNodes_HIDDEN(IHidden) '==========\ '===========> Leggo la correzione apportata a questo '===========> peso collegamento al ciclo precedente '==========/ Corr_Di_prima = M_ULTIMI_DELTAW_HB(IHidden) '======================================================== ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto '======================================================== DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima) '==========\ '===========> Scrivo la correzione applicata ora '===========> per riutilizzo al ciclo successivo '==========/ M_ULTIMI_DELTAW_HB(IHidden) = DeltaPeso '======================================================== ' Applico il deltapeso appena calcolato al peso corrente '======================================================== M_Strato_HID_BIAS(IHidden) = M_Strato_HID_BIAS(IHidden) + DeltaPeso Next '============================================================== 'Applicazione degli errori ai pesi tra HIDDEN e OUTPUT (strato 2) '============================================================== For IHidden = 1 To NumCelleHiddenLayer For IOutput = 1 To NumCelleStratoOutput '=========================================================== ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER '=========================================================== ErroreQuestaCella = M_ERRORI_OUTPUT(IOutput) '=========================================================== ' Rilevo il valore della cella di hidden layer da cui parte ' la connessione al mio nodo '=========================================================== ValoreCellaAMonte = M_HIDDEN(IHidden) '==========\ '===========> Leggo la correzione apportata a questo '===========> peso collegamento al ciclo precedente '==========/ Corr_Di_prima = M_ULTIMI_DELTAW_S2(IOutput, IHidden) '======================================================== ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto '======================================================== DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima) '==========\ '===========> Scrivo la correzione applicata ora '===========> per riutilizzo al ciclo successivo '==========/ M_ULTIMI_DELTAW_S2(IOutput, IHidden) = DeltaPeso '======================================================== ' Applico il deltapeso appena calcolato al peso corrente '======================================================== M_Strato2(IHidden, IOutput) = M_Strato2(IHidden, IOutput) + DeltaPeso Next Next '============================================================== 'Applicazione degli errori ai pesi tra BIASNODE e STRATO OUTPUT '============================================================== For IOutput = 1 To NumCelleStratoOutput '=========================================================== ' Rilevo l'errore associato al nodo corrente di HIDDEN LAYER '=========================================================== ErroreQuestaCella = M_ERRORI_OUTPUT(IOutput) '=========================================================== ' Rilevo il valore del Bias Node '=========================================================== ValoreCellaAMonte = M_BiasNodes_OUTPUT(IOutput) '==========\ '===========> Leggo la correzione apportata a questo '===========> peso collegamento al ciclo precedente '==========/ Corr_Di_prima = M_ULTIMI_DELTAW_OB(IOutput) '======================================================== ' CALCOLO IL DELTAPESO 'Deltawij' sopra descritto '======================================================== DeltaPeso = (LearningRate * ErroreQuestaCella * ValoreCellaAMonte) + (ValoreArbitrario * Corr_Di_prima) '==========\ '===========> Scrivo la correzione applicata ora '===========> per riutilizzo al ciclo successivo '==========/ M_ULTIMI_DELTAW_OB(IOutput) = DeltaPeso '======================================================== ' Applico il deltapeso appena calcolato al peso corrente '======================================================== M_Strato_OUT_BIAS(IOutput) = M_Strato_OUT_BIAS(IOutput) + DeltaPeso Next '==================================================================== '==================\ /====================== '===================> FINE BACK PROPAGATION <======================= '==================/ \====================== '==================================================================== '================================================ '================================================ ' PASSO ALL'ESEMPIO SUCCESSIVO '================================================ '================================================ Next '========================================================================== '==================\ /====================== '===================> FINE CICLO DI ADDESTRAMENTO <======================= '==================/ \====================== 'Il ciclo di addestramento finisce quando tutti gli esempi sono stati 'esaminati '========================================================================== '========================================== '= Salvo i pesi ad addestramento terminato '========================================== MsgBox "Fine Addestramento - ripeto altre 6 volte" Beep MsgBox "Fine Addestramento - ripeto altre 5 volte" Beep MsgBox "Fine Addestramento - ripeto altre 4 volte" Beep MsgBox "Fine Addestramento - ripeto altre 3 volte" Beep MsgBox "Fine Addestramento - ripeto altre 2 volte" Beep MsgBox "Fine Addestramento - ripeto una altra volta" Beep MsgBox "Fine Addestramento" If MsgBox("Salvo in tabella PESO_COLLEGAMENTI i pesi dei collegamenti ottenuti come risultato dell'addestramento?", vbYesNo, "Attenzione!") = vbYes Then ScriviTuttiIPesiCollegamenti Else MsgBox "Non avete salvato i pesi dei collegamenti nella tabella - i collegamenti addestrati sono attivi in memoria RAM" End If Exit_TRAINING_Click: Exit Sub Err_TRAINING_Click: MsgBox "TRAINING_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_TRAINING_Click End Sub Private Sub UTILIZZO_Click() On Error GoTo Err_UTILIZZO_Click '=====================> Indici locali Dim IInput As Integer ' due coordinata per l'input layer bidimensionale Dim JInput As Integer ' due coordinata per l'input layer bidimensionale Dim IHidden As Integer ' una sola coordinata per l'hidden layer monodimensionale Dim IOutput As Integer ' una sola coordinata per l'output layer monodimensionale Dim Sommatoria As Double 'la sommatoria dei valori convergenti sulla mia cella Dim Aggiungi As Double 'variabile di transito Dim BIAS As Double 'variabile di transito BIAS cella corrente Dim ESPONENTE As Double 'variabile di transito BIAS '=====================> Ospita il numero del risultato Dim NRisultato As Integer '=====================> Ospita il valore del risultato Dim ValRisultato As Double '=====================> Ospita il valore ricevuto dalla '=====================> singola connessione verso di me Dim RicevoDaNodoCorrente As Double '=====================> Avviso 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" If MsgBox("Confermate di volere analizzare quanto visualizzato?", vbYesNo, "Attenzione!") = vbNo Then Exit Sub End If '=========================> Tutte a "rosso" le caselle degli esiti SvuotaEsiti '=========================> Salvo la configurazione del display in MATRICEVIDEO FillMatriceVideoconDisplay '=========================> Trasferisco MATRICEVIDEO in MATRICE INPUT M_INPUT ' Perchè non trasferisco direttamente il "display" 10 x 10 in MATRICEINPUT ' senza avvalermi della matrice di transito MATRICEVIDEO? ' Potrei benissimo farlo in un colpo solo. Visto che comunque ho a ' disposizione MatriceVideo, la sfrutto per creare una routine che accetta una ' matrice come parametro FillMatriceInput MatriceVideo '=============================================================== 'Inizializzazione a 1 dei Bias Nodes '============================================================== For IHidden = 1 To NumCelleHiddenLayer M_BiasNodes_HIDDEN(IHidden) = 1 Next For IOutput = 1 To NumCelleStratoOutput M_BiasNodes_OUTPUT(IOutput) = 1 Next '====================================== '= LEGGO TUTTI I PESI '====================================== 'If MsgBox("Utilizzo i pesi eventualmente già presenti in RAM (NO=Carico il peso dei collegamenti da tabella)?", vbYesNo, "Attenzione!") = vbNo Then ' '============================================================== ' 'Leggo da tabella PESO_COLLEGAMENTI i valori da porre nelle matrici dei collegamenti ' '============================================================== ' '====================> Riempio i vettori dei collegamenti ' LeggiTuttiIPesiCollegamenti 'End If '====================================== '= Qui l'utilizzo '====================================== '==\ '===> Promemoria sui nomi delle matrici '==/ ' M_INPUT(NumCelleStratoInput, NumCelleStratoInput) As Integer ' M_Strato1(NumCelleStratoInput, NumCelleStratoInput, NumCelleHiddenLayer) As Double ' M_HIDDEN(NumCelleHiddenLayer) As Double ' M_Strato2(NumCelleHiddenLayer, NumCelleStratoOutput) As Double ' M_OUTPUT(NumCelleStratoOutput) As Integer 'la matrice con i BIAS NODES per le celle di HIDDEN LAYER ' M_BiasNodes_HIDDEN(NumCelleHiddenLayer) As Double 'la matrice con i BIAS NODES per le celle di STRATO OUTPUT ' M_BiasNodes_OUTPUT(NumCelleStratoOutput) As Double 'vettore di collegamenti tra HIDDEN ed i rispettivi BIAS NODES ' M_Strato_HID_BIAS(NumCelleHiddenLayer) As Double 'vettore di collegamenti tra OUTPUT ed i rispettivi BIAS NODES ' M_Strato_OUT_BIAS(NumCelleStratoOutput) As Double '================================= '= Fase 1 - spazzata hidden layer '================================= '==============> Per ogni nodo dell'hidden layer For IHidden = 1 To NumCelleHiddenLayer '===============> Azzero la Sommatoria dei valori che '===============> determinerà l'output (=il valore) del '===============> mio neurone di hidden layer Sommatoria = 0 '===============> Per tutti i collegamenti dell'input layer che convergono '===============> sulla mia cella di hidden layer For IInput = 1 To NumCelleStratoInput For JInput = 1 To NumCelleStratoInput '===============> Localizzo il collegamento tra la mia cella '===============> di hidden layer e la cella corrente del '===============> layer di input RicevoDaNodoCorrente = M_INPUT(IInput, JInput) * M_Strato1(IInput, JInput, IHidden) '===\ '====> Aggiungo alla sommatoria il valore ricevuto '====> dalla connessione convergente verso il mio neurone '===/ Sommatoria = Sommatoria + RicevoDaNodoCorrente Next Next '==\ '===> Valuto l'apporto del Bias Node specifico della mia cella '==/ BIAS = M_BiasNodes_HIDDEN(IHidden) * M_Strato_HID_BIAS(IHidden) '==\ '===> Calcolo l'esponente a cui elevare "e" '===> -1 è la "costante di ripidità" della sigmoide '==/ ESPONENTE = -1 * (Sommatoria - BIAS) '===\ '====> Memorizzo nel nodo corrente il valore ottenuto '====> a partire da "Sommatoria", secondo il metodo seguente '===/ M_HIDDEN(IHidden) = 1 / (1 + Exp(ESPONENTE)) Next '================================= '= Fase 2 - spazzata layer output '================================= '==============> Per ogni nodo dell'hidden layer For IOutput = 1 To NumCelleStratoOutput '===============> Azzero la Sommatoria dei valori che '===============> determinerà l'output (=il valore) del '===============> mio neurone di output Sommatoria = 0 '===============> Per tutti i collegamenti dell'Hidden Layer che convergono '===============> sulla mia cella di output layer For IHidden = 1 To NumCelleHiddenLayer '===============> Localizzo il collegamento tra la mia cella '===============> di output layer e la cella corrente dell' '===============> hidden layer RicevoDaNodoCorrente = M_HIDDEN(IHidden) * M_Strato2(IHidden, IOutput) '===\ '====> Aggiungo alla sommatoria il valore ricevuto '====> dalla connessione convergente verso il mio neurone '===/ Sommatoria = Sommatoria + RicevoDaNodoCorrente Next '==\ '===> Valuto l'apporto del Bias Node specifico della mia cella '==/ BIAS = M_BiasNodes_OUTPUT(IOutput) * M_Strato_OUT_BIAS(IOutput) '==\ '===> Calcolo l'esponente a cui elevare "e" '===> -1 è la "costante di ripidità" della sigmoide '==/ ESPONENTE = -1 * (Sommatoria - BIAS) '===\ '====> Memorizzo nel nodo corrente il valore ottenuto '====> a partire da "Sommatoria", secondo il metodo seguente '===/ M_OUTPUT(IOutput) = 1 / (1 + Exp(ESPONENTE)) Next '========> DEBUG '========> In attesa di potere effettuare il training, '========> restituisco un risultato a caso '==================================================== '= Determino il risultato spazzando i nodi (=CELLE) di output '= "The winner takes it all" - la risposta è il nodo '= con il valore più elevato '==================================================== '===============> Azzero il risultato NRisultato = 0 ValRisultato = 0 '==============> Per ogni nodo dello strato di output For IOutput = 1 To NumCelleStratoOutput '================> Comunque, mostro il valore Select Case IOutput Case 1 Me!VX.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 2 Me!VO.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 3 Me!VC.Caption = Format$(M_OUTPUT(IOutput), "0.000000") Case 4 Me!VQ.Caption = Format$(M_OUTPUT(IOutput), "0.000000") End Select '================> Memorizzo il risultato più alto If M_OUTPUT(IOutput) > ValRisultato Then NRisultato = IOutput ValRisultato = M_OUTPUT(IOutput) End If Next '========================================== '= Mostro il risultato '= 1 = "X" '= 2 = "O" '= 3 = "+" '= 4 = "quadrato" '========================================== Select Case NRisultato Case 1 Me!OttengoICS.BackColor = VERDE Case 2 Me!OttengoCERCHIO.BackColor = VERDE Case 3 Me!OttengoCROCE.BackColor = VERDE Case 4 Me!OttengoQUADRATO.BackColor = VERDE Case Else MsgBox "La analisi non ha dato alcun risultato (RISULTATO = 0)." End Select Exit_UTILIZZO_Click: Exit Sub Err_UTILIZZO_Click: MsgBox "UTILIZZO_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_UTILIZZO_Click End Sub Private Sub SvuotaEsiti() On Error GoTo Err_SVUOTAESITI Me!ChiedoCERCHIO.BackColor = ROSSO Me!ChiedoCROCE.BackColor = ROSSO Me!ChiedoICS.BackColor = ROSSO Me!ChiedoQUADRATO.BackColor = ROSSO Me!OttengoCERCHIO.BackColor = ROSSO Me!OttengoCROCE.BackColor = ROSSO Me!OttengoICS.BackColor = ROSSO Me!OttengoQUADRATO.BackColor = ROSSO Me!VX.Caption = " " Me!VO.Caption = " " Me!VC.Caption = " " Me!VQ.Caption = " " Exit_SVUOTAESITI: Exit Sub Err_SVUOTAESITI: MsgBox "SVUOTAESITI: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SVUOTAESITI End Sub Private Sub SalvaEsempio(CheSoluzione As Integer) '============================================================================ '== PER SALVARE NELLA TABELLA ESEMPI QUANTO VISUALIZZATO SUL DISPLAY 10 x 10 '== ASSIEME ALLA RELATIVA SOLUZIONE PREVISTA '= 1 = "X" '= 2 = "O" '= 3 = "+" '= 4 = "quadrato" '================================================== On Error GoTo Err_SalvaEsempio '=====================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer '=====================> Variabile per comporre il nome controllo Dim NomeControllo As String '=====================> Variabili per rappresentare il display Dim vRiga1 As String Dim vRiga2 As String Dim vRiga3 As String Dim vRiga4 As String Dim vRiga5 As String Dim vRiga6 As String Dim vRiga7 As String Dim vRiga8 As String Dim vRiga9 As String Dim vRiga10 As String '=====================> Carattere per memorizzare la cella corrente di display Dim Carattere As String '=\ '==> salvo quanto su display in un record della tabella ESEMPI '==> a seconda del valore del parametro Chefile. '=/ ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella ESEMPI come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset("ESEMPI", dbOpenTable) '======================================================== ' Riverso il contenuto del display 10x10 in 10 variabili ' vRigaN, che salvo nei campi RigaN della tabella esempi '======================================================== 'Svuoto le vRigaN vRiga1 = "" vRiga2 = "" vRiga3 = "" vRiga4 = "" vRiga5 = "" vRiga6 = "" vRiga7 = "" vRiga8 = "" vRiga9 = "" vRiga10 = "" 'Svuoto Carattere Carattere = "" 'Riempio le vRigaN For LocalI = 1 To 10 For LocalJ = 1 To 10 '============> NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ)) If Me(NomeControllo).BackColor = 0 Then Carattere = "1" Else Carattere = "0" End If Select Case LocalI Case 1 vRiga1 = vRiga1 + Carattere Case 2 vRiga2 = vRiga2 + Carattere Case 3 vRiga3 = vRiga3 + Carattere Case 4 vRiga4 = vRiga4 + Carattere Case 5 vRiga5 = vRiga5 + Carattere Case 6 vRiga6 = vRiga6 + Carattere Case 7 vRiga7 = vRiga7 + Carattere Case 8 vRiga8 = vRiga8 + Carattere Case 9 vRiga9 = vRiga9 + Carattere Case 10 vRiga10 = vRiga10 + Carattere End Select Next Next '===========> Arrivo qui con il display corrente preservato '===========> sotto forma di 10 variabili vRigan '===========> Memorizzo tali variabili nel record di ESEMPI ' Aggiungo un nuovo record rst.AddNew 'salvo nei campi del record le variabili di memoria rst!Riga1 = vRiga1 rst!Riga2 = vRiga2 rst!Riga3 = vRiga3 rst!Riga4 = vRiga4 rst!Riga5 = vRiga5 rst!Riga6 = vRiga6 rst!Riga7 = vRiga7 rst!Riga8 = vRiga8 rst!Riga9 = vRiga9 rst!Riga10 = vRiga10 'salvo quale sia la soluzione da associare rst!Soluzione = CheSoluzione 'Salvo il record rst.Update 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing Exit_SalvaEsempio: Exit Sub Err_SalvaEsempio: MsgBox "SalvaEsempio: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SalvaEsempio End Sub Private Function LeggiEsempio(CheRecord As Integer) As Integer '============================================================================ '== PER VISUALIZZARE SUL DISPLAY 10 x 10 QUANTO MEMORIZZATO IN FILE ESEMPI '== E RESTITUIRE LA SOLUZIONE ATTESA '================================================== On Error GoTo Err_LeggiEsempio '=====================> Indici locali Dim LocalI As Integer Dim LocalJ As Integer '=====================> Variabile per comporre il nome controllo Dim NomeControllo As String '=====================> Variabili per rappresentare il display Dim vRiga1 As String Dim vRiga2 As String Dim vRiga3 As String Dim vRiga4 As String Dim vRiga5 As String Dim vRiga6 As String Dim vRiga7 As String Dim vRiga8 As String Dim vRiga9 As String Dim vRiga10 As String '=====================> Carattere per memorizzare la cella corrente di display Dim Carattere As String '=====================> Carattere per memorizzare la cella corrente di display Dim CheSoluzione As Integer '=\ '==> salvo quanto su display in un record della tabella ESEMPI '=/ ' Restituisce il riferimento al database corrente. Set dbs = CurrentDb ' Apre la tabella ESEMPI come oggetto Recordset di tipo dynaset. Set rst = dbs.OpenRecordset("ESEMPI", dbOpenDynaset) '======================================================== ' Riverso il contenuto del display 10x10 in 10 variabili ' vRigaN, che salvo nei campi RigaN della tabella esempi '======================================================== 'Svuoto le vRigaN vRiga1 = "" vRiga2 = "" vRiga3 = "" vRiga4 = "" vRiga5 = "" vRiga6 = "" vRiga7 = "" vRiga8 = "" vRiga9 = "" vRiga10 = "" 'Svuoto Carattere Carattere = "" '===========> Arrivo qui con il display corrente preservato '===========> sotto forma di 10 variabili vRigan '===========> Memorizzo tali variabili nel record di ESEMPI ' Mi porto al "CheRecord-esimo" Record (il primo è record zero) rst.MoveLast rst.AbsolutePosition = CheRecord - 1 'salvo nei campi del record le variabili di memoria vRiga1 = rst!Riga1 vRiga2 = rst!Riga2 vRiga3 = rst!Riga3 vRiga4 = rst!Riga4 vRiga5 = rst!Riga5 vRiga6 = rst!Riga6 vRiga7 = rst!Riga7 vRiga8 = rst!Riga8 vRiga9 = rst!Riga9 vRiga10 = rst!Riga10 'salvo quale sia la soluzione da associare CheSoluzione = rst!Soluzione 'Chiudo recordset rst.Close 'Azzero variabile Database Set dbs = Nothing 'Riempio i controlli con le vRigaN For LocalI = 1 To 10 For LocalJ = 1 To 10 Select Case LocalI Case 1 Carattere = Mid$(vRiga1, LocalJ, 1) Case 2 Carattere = Mid$(vRiga2, LocalJ, 1) Case 3 Carattere = Mid$(vRiga3, LocalJ, 1) Case 4 Carattere = Mid$(vRiga4, LocalJ, 1) Case 5 Carattere = Mid$(vRiga5, LocalJ, 1) Case 6 Carattere = Mid$(vRiga6, LocalJ, 1) Case 7 Carattere = Mid$(vRiga7, LocalJ, 1) Case 8 Carattere = Mid$(vRiga8, LocalJ, 1) Case 9 Carattere = Mid$(vRiga9, LocalJ, 1) Case 10 Carattere = Mid$(vRiga10, LocalJ, 1) End Select '============> NomeControllo = "R" + LTrim$(Str$(LocalI)) + "C" + LTrim$(Str$(LocalJ)) If Carattere = "1" Then Me(NomeControllo).BackColor = 0 Else Me(NomeControllo).BackColor = 16777215 End If Next Next '===> Restituisco "CheSoluzione" LeggiEsempio = CheSoluzione Exit_LeggiEsempio: Exit Function Err_LeggiEsempio: MsgBox "LeggiEsempio: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_LeggiEsempio End Function