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 |
|