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