VB5 Rapidité du code - Algorithmes génétiques : Objets / Tableaux / Tableaux à une dimenssion

**electroremy** · 31/08/2014, 17h32

Bonjour,

Je suis en train de développer la nouvelle version de CiDess, en VB5 (le logiciel fête les 10 ans de sa sortie cette année). CiDess sert à dessiner des circuits imprimés, il est gratuit. (http://cidess.free.fr/index-fr.html)

Comme nouvelle fonctionnalité, il y aura le perçage du circuit imprimé avec fraiseuse à commande numérique. Une option permet d’optimiser la longueur des trajets de l'usinage ; pour ce faire, j’ai recours aux algorithmes génétiques pour résoudre ce qui n’est rien d’autre qu'une version du très célèbre problème du voyageur de commerce.

Je suis arrivé à mes fins, et ça fonctionne bien.

J’ai voulu optimiser la rapidité de mon code et je suis tombé sur une surprise.

Le code de départ avait recours à des objets et des collections ; le voici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
 
Private Sub OptimiserOrdrePercages_Genetique1(out As OutilCNC) 'AVEC DES OBJETS
    Dim per As PercageCNC
    Dim MaxLong As Double
    Dim MinLong As Double
    Dim MinLongPrec As Double
    Dim MinLongConstantDepuis As Integer
    Dim ListeParcours As Collection
    Dim ListeParcours2 As Collection
    Dim TmpListe As Collection
    Dim p As ParcoursCNC
    Dim p1 As ParcoursCNC
    Dim p2 As ParcoursCNC
    Dim Debut As Single
    Dim NbPercages As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim c As Integer
    Dim ChiffreOK As Boolean
    Dim XP As Double, YP As Double
    Dim Stagnation As Boolean
 
    Dim NbGenerations As Long
    Dim Duree As Single
 
    'Paramètres de l'algorithme :
 
    NbPercages = out.ListePercages.count
 
     Debut = Timer
 
     out.LongAvantOptim = 0
     Set per = out.ListePercages.Item(1)
     XP = per.Xmachine
     YP = per.Ymachine
     For i = 2 To NbPercages
         Set per = out.ListePercages.Item(i)
         out.LongAvantOptim = out.LongAvantOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
         XP = per.Xmachine
         YP = per.Ymachine
     Next i
 
     'Création de la première génération :
     Set ListeParcours = New Collection
     'La liste originale :
     Set p = New ParcoursCNC
     Call p.Nouveau(NbPercages)
     For j = 1 To NbPercages
         Call p.EcrireTableau(j, j)
     Next j
     ListeParcours.Add p
     'Les listes aléatoires :
     Set TmpListe = New Collection
     For i = 2 To ParOpti_NbIndividus
         Set p = New ParcoursCNC
         Call p.Nouveau(NbPercages)
 
         Set TmpListe = New Collection
         For j = 1 To NbPercages
             TmpListe.Add j
         Next j
         Randomize
         For j = 1 To NbPercages
             'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
             k = Int(TmpListe.count * Rnd + 1)
             Call p.EcrireTableau(j, TmpListe.Item(k))
             Call TmpListe.Remove(k)
         Next j
         ListeParcours.Add p
     Next i
     'Calcul du critère de la 1ière génération :
     For i = 1 To ParOpti_NbIndividus
         Set p = ListeParcours.Item(i)
         p.Lg = 0
         Set per = out.ListePercages.Item(p.LireTableau(1))
         XP = per.Xmachine
         YP = per.Ymachine
         For j = 2 To NbPercages
             Set per = out.ListePercages.Item(p.LireTableau(j))
             'Optimisation : la fonction Sqr est couteuse en temps de calcul et n'est pas nécessaire pour faire une comparaison :
             'p.Lg = p.Lg + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
             'p.Lg = p.Lg + (XP - per.Xmachine) ^ 2 + (YP - per.Ymachine) * (YP - per.Ymachine) ^ 2
             p.Lg = p.Lg + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)
             XP = per.Xmachine
             YP = per.Ymachine
         Next j
     Next i
     MinLongPrec = p.Lg
     MinLongConstantDepuis = 0
     out.DebugInfo = ""
 
     'Mesure de la performance :
     NbGenerations = 1
 
     Do '--------------------------------------------------------------------------------------------------------------------------------------
         Randomize
 
         'Mesure de la performance :
         NbGenerations = NbGenerations + 1
 
         'REPRODUCTION :
         For i = 1 To ParOpti_NbReproductions
             'On choisi aléatoirement deux parents :
             k = Int(ParOpti_NbIndividus * Rnd + 1)
             m = Int(ParOpti_NbIndividus * Rnd + 1)
             'Reproduction :
             If k <> m Then
                 Set p1 = ListeParcours.Item(k)
                 Set p2 = ListeParcours.Item(m)
                 'Choix aléatoire du point de croisement :
                 'k=1 => 1.23456789
                 'm=8 => 12345678.9
                 c = Int((NbPercages - 1) * Rnd + 1)
                 'Croisement :
                 Set p = New ParcoursCNC
                 Call p.Nouveau(NbPercages)
                 For j = 1 To c
                     Call p.EcrireTableau(j, p1.LireTableau(j))
                 Next j
                 'Pour p.tableau(c+1...NbPercages) il faut prendre les chiffres de p2.Tableau() dans l'ordre,
                 'à condition que ces chiffres ne soient pas déjà dans p.Tableau(1...k)
                 j = 0
                 m = c
                 Do
                    j = j + 1
                    ChiffreOK = True
                    For k = 1 To c
                         If p.LireTableau(k) = p2.LireTableau(j) Then ChiffreOK = False
                    Next k
                    If ChiffreOK Then
                         m = m + 1
                         Call p.EcrireTableau(m, p2.LireTableau(j))
                    End If
                 Loop Until m = NbPercages Or j = NbPercages
                 ListeParcours.Add p
             End If
         Next i
 
         'MUTATION :
         For i = 1 To ParOpti_NbMutations
             'Choix aléatoire des points de mutation :
             k = Int(NbPercages * Rnd + 1)
             c = Int(NbPercages * Rnd + 1)
             If c <> k Then
                 'Choix aléatoire de l'individu muté :
                 m = Int(ParOpti_NbIndividus * Rnd + 1)
                 Set p1 = ListeParcours.Item(m)
                 Set p = New ParcoursCNC
                 Call p.Nouveau(NbPercages)
                 For j = 1 To NbPercages
                     If j = c Then
                         Call p.EcrireTableau(j, p1.LireTableau(k))
                     ElseIf j = k Then
                         Call p.EcrireTableau(j, p1.LireTableau(c))
                     Else
                         Call p.EcrireTableau(j, p1.LireTableau(j))
                     End If
                 Next j
                 ListeParcours.Add p
             End If
         Next i
 
         'CALCUL DU CRITERE POUR TOUS LES INDIVIDUS :
         'Optimisation : pas besoin de calculer à nouveau le critère pour les membres de la génération précédente :
         'For Each p In ListeParcours 'ListeParcours.Count = ParOpti_NbIndividus + Nombre de reproductions + ParOpti_NbMutations > ParOpti_NbIndividus
         For i = ParOpti_NbIndividus + 1 To ListeParcours.count
             Set p = ListeParcours.Item(i)
             p.Lg = 0
             Set per = out.ListePercages.Item(p.LireTableau(1))
             XP = per.Xmachine
             YP = per.Ymachine
             For j = 2 To NbPercages
                 Set per = out.ListePercages.Item(p.LireTableau(j))
                 'Optimisation : la fonction Sqr est couteuse en temps de calcul et n'est pas nécessaire pour faire une comparaison :
                 'p.Lg = p.Lg + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
                 'p.Lg = p.Lg + (XP - per.Xmachine) ^ 2 + (YP - per.Ymachine) * (YP - per.Ymachine) ^ 2
                 p.Lg = p.Lg + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)
                 XP = per.Xmachine
                 YP = per.Ymachine
             Next j
         Next i
         'Next p
 
         'SELECTION :
         'On supprime le parcours le plus long jusqu'à ce qu'il n'en reste que ParOpti_NbIndividus dans la liste :
         Do
             If ListeParcours.count <= ParOpti_NbIndividus Then Exit Do
             For j = 1 To ListeParcours.count
                 Set p = ListeParcours.Item(j)
                 If j = 1 Then
                     MaxLong = p.Lg
                     k = j
                 Else
                     If p.Lg > MaxLong Then
                         MaxLong = p.Lg
                         k = j
                     End If
                 End If
             Next j
             ListeParcours.Remove k
         Loop
 
         'On détermine si on stagne ou pas :
         Stagnation = True
         'For Each p In ListeParcours
         For j = 1 To ListeParcours.count
             Set p = ListeParcours.Item(j)
             If p.Lg < MinLongPrec Then
                 Stagnation = False
                 MinLongPrec = p.Lg
             End If
         Next j
         'Next p
         If Stagnation Then
             MinLongConstantDepuis = MinLongConstantDepuis + 1
             If MinLongConstantDepuis > ParOpti_MaxMinLongConstatDepuis Then Exit Do
         Else
             MinLongConstantDepuis = 0
         End If
 
         If Timer - Debut > ParOpti_DureeMax Then Exit Do
     Loop '--------------------------------------------------------------------------------------------------------------------------------------
 
     'out.DebugInfo = out.DebugInfo + ";Temps de calcul : " + Format(Timer - Debut) + " secondes"
     'Mesure de la performance :
     Duree = Timer - Debut
     'out.DebugInfo = " Temps de calcul " + Format(Duree) + " secondes - Calcul de " + Format(NbGenerations / Duree, "0.0") + " générations par seconde."
     out.DebugInfo = "Durée " + Format(Duree, "0.000") + "s - " + Format(NbGenerations) + " générations - " + Format(NbGenerations / Duree, "0.0") + " générations par seconde."
 
     'On sélectionne le parcours le plus court :
     'Set p = ListeParcours.Item(K)
     For j = 1 To ListeParcours.count
         Set p = ListeParcours.Item(j)
         If j = 1 Then
             MinLong = p.Lg
             k = j
         Else
             If p.Lg < MinLong Then
                 MinLong = p.Lg
                 k = j
             End If
         End If
     Next j
     Set p = ListeParcours.Item(k)
 
     'Contrôle de sécurité :
     ChiffreOK = True
     For i = 1 To out.ListePercages.count - 1
         k = p.LireTableau(i)
         If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
         For j = i + 1 To out.ListePercages.count
             m = p.LireTableau(j)
             If k = m Then ChiffreOK = False
         Next j
     Next i
     k = p.LireTableau(out.ListePercages.count)
     If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
 
     'Affectation :
     If ChiffreOK Then
         'Affectation :
         Set TmpListe = New Collection
         For j = 1 To NbPercages
             Set per = out.ListePercages.Item(p.LireTableau(j))
             TmpListe.Add per
         Next j
         Set out.ListePercages = TmpListe
         'out.LongApresOptim = MinLong
         out.LongApresOptim = 0
         Set per = out.ListePercages.Item(1)
         XP = per.Xmachine
         YP = per.Ymachine
         For i = 2 To NbPercages
             Set per = out.ListePercages.Item(i)
             out.LongApresOptim = out.LongApresOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
             XP = per.Xmachine
             YP = per.Ymachine
         Next i
     Else
         MsgBox "Contrôle de sécurité échoué"
         out.LongApresOptim = -1
     End If
 
End Sub
 
Class ParcoursCNC
Private Tabl() As Integer
Public Lg As Double
 
Public Sub Nouveau(NombreIndex As Integer)
    ReDim Tabl(1 To NombreIndex)
End Sub
 
Public Function LireTableau(i As Integer) As Integer
    LireTableau = Tabl(i)
End Function
 
Public Sub EcrireTableau(i As Integer, Valeur As Integer)
    Tabl(i) = Valeur
End Sub
End Class

Je pensais que ce code serai plus rapide si je faisais les calculs en ayant recours à des tableaux. Voici donc une deuxième version :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
 
Private Sub OptimiserOrdrePercages_Genetique2(out) 'AVEC UN TABLEAU A DEUX DIMENSIONS
    Dim per As PercageCNC
    Dim MaxLong As Double
    Dim MinLong As Double
    Dim MinLongPrec As Double
    Dim MinLongConstantDepuis As Integer
    Dim TmpListe As Collection
    Dim Debut As Single
    Dim NbPercages As Integer
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim c As Integer
 
    Dim p1 As Integer
    Dim p2 As Integer
    Dim p As Integer
 
    Dim ChiffreOK As Boolean
    Dim XP As Double, YP As Double
    Dim Stagnation As Boolean
    Dim premier As Boolean
 
    Dim TaillePopulation As Integer
 
    Dim NbGenerations As Long
    Dim Duree As Single
 
    NbPercages = out.ListePercages.count
    TaillePopulation = ParOpti_NbIndividus + ParOpti_NbReproductions + ParOpti_NbMutations
 
    ReDim Matrice(NbPercages + 1, TaillePopulation + 1) As Integer
    ReDim Lg(TaillePopulation + 1) As Double
    ReDim Pointeur(TaillePopulation + 1) As Integer
    ReDim ColonneOK(TaillePopulation + 1) As Integer
    'Pointeur(1...NbIndividus) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux parents
    'Pointeur(NbIndividus+1...NbIndividus+ParOpti_NbReproductions) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux enfants
    'Pointeur(NbIndividus+ParOpti_NbReproductions+1...NbIndividus+ParOpti_NbReproductions+ParOptiMutants) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux mutants
    'Lg(i) contient la longeur du parcours de la colonne i (Matrice(.,i))
 
     Debut = Timer
 
    out.LongAvantOptim = 0
    Set per = out.ListePercages.Item(1)
    XP = per.Xmachine
    YP = per.Ymachine
    For i = 2 To NbPercages
        Set per = out.ListePercages.Item(i)
        out.LongAvantOptim = out.LongAvantOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
        XP = per.Xmachine
        YP = per.Ymachine
    Next i
 
     'Création de la première génération :
    For i = 1 To TaillePopulation
        Pointeur(i) = i
    Next i
 
    'La liste originale :
    For j = 1 To NbPercages
        Matrice(j, 1) = j
    Next j
 
    'Les listes aléatoires :
    Set TmpListe = New Collection
    For i = 2 To ParOpti_NbIndividus
        For j = 1 To NbPercages
            TmpListe.Add j
        Next j
        Randomize
        For j = 1 To NbPercages
            'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            k = Int(TmpListe.count * Rnd + 1)
            Matrice(j, i) = TmpListe.Item(k)
            Call TmpListe.Remove(k)
        Next j
    Next i
 
    'Calcul du critère de la 1ière génération :
    For i = 1 To ParOpti_NbIndividus
        Set per = out.ListePercages.Item(Matrice(1, i)) '1ier perçage de l'individu i
        XP = per.Xmachine
        YP = per.Ymachine
        For j = 2 To NbPercages
            Set per = out.ListePercages.Item(Matrice(j, i)) 'Perçage j de l'individu i
            Lg(i) = Lg(i) + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine) 'Longueur de l'individu i
            XP = per.Xmachine
            YP = per.Ymachine
        Next j
    Next i
    MinLongPrec = Lg(1)
    MinLongConstantDepuis = 0
    out.DebugInfo = ""
 
    'Mesure de la performance :
    NbGenerations = 1
 
    Do '--------------------------------------------------------------------------------------------------------------------------------------
        Randomize
 
        'Mesure de la performance :
        NbGenerations = NbGenerations + 1
 
        'REPRODUCTION :
        For i = 1 To ParOpti_NbReproductions
            p = Pointeur(i + ParOpti_NbIndividus) 'p = pointeur de l'enfant n°i, stocké dans Pointeur(ParOpti_NbIndividus+1...ParOpti_NbIndividus+1+ParOptiNbReproductions)
            '
            'On choisi aléatoirement deux parents :
            k = Int(ParOpti_NbIndividus * Rnd + 1)
            Do
                m = Int(ParOpti_NbIndividus * Rnd + 1)
            Loop Until k <> m
            'On cherche les colonnes p1 et p2 correspondant aux parents k et m
            p1 = Pointeur(k)
            p2 = Pointeur(m)
            'Choix aléatoire du point de croisement :
            'k=1 => 1.23456789
            'm=8 => 12345678.9
            c = Int((NbPercages - 1) * Rnd + 1)
            'Croisement :
            For j = 1 To c
                Matrice(j, p) = Matrice(j, p1) 'Le percage j de l'enfant = le percage j du parent 1
            Next j
            'Génome du parent 2 dans l'enfant :
            j = 0
            m = c
            Do
               j = j + 1
               ChiffreOK = True
               'On doit choisir les perçages du parent 2 dans l'ordre, en 'sautant' les percages déjà présents dans l'enfant :
               For k = 1 To c
                    If Matrice(k, p) = Matrice(j, p2) Then ChiffreOK = False
               Next k
               If ChiffreOK Then
                    m = m + 1
                    Matrice(m, p) = Matrice(j, p2)
               End If
            Loop Until m = NbPercages Or j = NbPercages
        Next i
 
        'MUTATION :
        For i = 1 To ParOpti_NbMutations
            p = Pointeur(i + ParOpti_NbIndividus + ParOpti_NbReproductions)
            'p = pointeur du mutant n°i, stocké dans Pointeur(ParOpti_NbIndividus+ParOpti_NbReproductions+1...TaillePopulation)
            '
            'Choix aléatoire des deux perçages qui seront échangés :
            k = Int(NbPercages * Rnd + 1)
            Do
                c = Int(NbPercages * Rnd + 1)
            Loop Until k <> c
            '
            'Choix aléatoire du parent dont le clone sera muté :
            m = Int(ParOpti_NbIndividus * Rnd + 1)
            p1 = Pointeur(m)
            '
            For j = 1 To NbPercages
                If j = c Then
                    Matrice(j, p) = Matrice(k, p1)
                ElseIf j = k Then
                    Matrice(j, p) = Matrice(c, p1)
                Else
                    Matrice(j, p) = Matrice(j, p1)
                End If
            Next j
        Next i
 
        'CALCUL DU CRITERE POUR TOUS LES INDIVIDUS :
        'Optimisation : pas besoin de calculer à nouveau le critère pour les membres de la génération précédente :
        'For Each p In ListeParcours 'ListeParcours.Count = ParOpti_NbIndividus + Nombre de reproductions + ParOpti_NbMutations > ParOpti_NbIndividus
        For i = ParOpti_NbIndividus + 1 To TaillePopulation
            p = Pointeur(i)
            'p est le n° de la colonne de Matrice(,) et le numéro de Lg()
            Lg(p) = 0
            Set per = out.ListePercages.Item(Matrice(1, p))
            XP = per.Xmachine
            YP = per.Ymachine
            For j = 2 To NbPercages
                Set per = out.ListePercages.Item(Matrice(j, p))
                'Optimisation : la fonction Sqr est couteuse en temps de calcul et p'est pas nécessaire pour faire une comparaison :
                'p.Lg = p.Lg + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
                'p.Lg = p.Lg + (XP - per.Xmachine) ^ 2 + (YP - per.Ymachine) * (YP - per.Ymachine) ^ 2
                Lg(p) = Lg(p) + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)
                XP = per.Xmachine
                YP = per.Ymachine
            Next j
        Next i
        'Next p
 
        'SELECTION :
        'Ici on doit réaffecter les pointeurs
        'Plus un parcours (une colonne de Matrice()) a une longeur élevé (mauvais critère), plus son pointeur est long :
        For i = 1 To TaillePopulation
            ColonneOK(i) = 0
        Next i
        '
        For p = 1 To ParOpti_NbIndividus
            'Les pointeurs Pointeur(1...NbIndividus) correspondront aux meilleurs individus, c'est à dire aux NbIndividus colonnes les meilleures
 
            premier = True
            For j = 1 To TaillePopulation 'Pour chaque colonne 'i'
                If ColonneOK(j) = 0 Then 'Les colonnes qui n'ont pas encore un pointeur pointant sur elles
                    If premier Then
                        premier = False
                        MinLong = Lg(j)
                        k = j
                    Else
                        If Lg(j) < MinLong Then
                            MinLong = Lg(j)
                            k = j
                        End If
                    End If
                End If
            Next j
            'Ici, K contient le n° de la colonne la plus courte parmis celles restant à trier
            Pointeur(p) = k
            ColonneOK(k) = 1
        Next p
 
        'Il faut tout de même renuméroter les colonnes 'mauvaises' car elles seront utilsées pour les enfants et les mutants de la génération suivante :
        p = ParOpti_NbIndividus
        For j = 1 To TaillePopulation
            If ColonneOK(j) = 0 Then 'Colonne n'ayant aucun pointeur pointant sur elle
                p = p + 1
                Pointeur(p) = j
                'ColonneOK(j) = 1 superflux
            End If
        Next j
 
    'Pointeur(1...NbIndividus) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux parents
    'Pointeur(NbIndividus+1...NbIndividus+ParOpti_NbReproductions) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux enfants
    'Pointeur(NbIndividus+ParOpti_NbReproductions+1...NbIndividus+ParOpti_NbReproductions+ParOptiMutants) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux mutants
    'Lg(i) contient la longeur du parcours de la colonne i (Matrice(.,i))
 
        'On détermine si on stagne ou pas :
        Stagnation = True
        For j = 1 To ParOpti_NbIndividus
            p = Pointeur(j)
            '
            If Lg(p) < MinLongPrec Then
                Stagnation = False
                MinLongPrec = Lg(p)
            End If
        Next j
        If Stagnation Then
            MinLongConstantDepuis = MinLongConstantDepuis + 1
            If MinLongConstantDepuis > ParOpti_MaxMinLongConstatDepuis Then Exit Do
        Else
            MinLongConstantDepuis = 0
        End If
 
        If Timer - Debut > ParOpti_DureeMax Then Exit Do
    Loop '--------------------------------------------------------------------------------------------------------------------------------------
 
    'out.DebugInfo = out.DebugInfo + ";Temps de calcul : " + Format(Timer - Debut) + " secondes"
    'Mesure de la performance :
    Duree = Timer - Debut
     out.DebugInfo = "Durée " + Format(Duree, "0.000") + "s - " + Format(NbGenerations) + " générations - " + Format(NbGenerations / Duree, "0.0") + " générations par seconde."
 
    'On sélectionne le parcours le plus court :
    'Set p = ListeParcours.Item(K)
    For j = 1 To ParOpti_NbIndividus
        p = Pointeur(j)
        '
        If j = 1 Then
            MinLong = Lg(p)
            k = p
        Else
            If Lg(p) < MinLong Then
                MinLong = Lg(p)
                k = p
            End If
        End If
    Next j
 
    'Contrôle de sécurité :
    ChiffreOK = True
    For i = 1 To out.ListePercages.count - 1
        k = Matrice(i, p) 'Perçage i du meilleur parcours p
        If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
        For j = i + 1 To out.ListePercages.count
            m = Matrice(j, p) 'Perçage j du meilleur parcours p
            If k = m Then ChiffreOK = False
        Next j
    Next i
    k = Matrice(out.ListePercages.count, p) 'dernier Perçage du meilleur parcours p
    If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
 
    'Affectation :
    If ChiffreOK Then
        'Affectation :
        Set TmpListe = New Collection
        For j = 1 To NbPercages
            Set per = out.ListePercages.Item(Matrice(j, p)) 'Perçage j du meilleur parcours p
            TmpListe.Add per
        Next j
        Set out.ListePercages = TmpListe
        'out.LongApresOptim = MinLong
        out.LongApresOptim = 0
        Set per = out.ListePercages.Item(1)
        XP = per.Xmachine
        YP = per.Ymachine
        For i = 2 To NbPercages
            Set per = out.ListePercages.Item(i)
            out.LongApresOptim = out.LongApresOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
            XP = per.Xmachine
            YP = per.Ymachine
        Next i
    Else
        MsgBox "Contrôle de sécurité échoué"
        out.LongApresOptim = -1
    End If
 
End Sub

Mais cette deuxième version est à ma grande surprise plus lente. Elle est deux à trois fois plus lente que la version avec les objets.

J’ai pensé que l’emploi d’un tableau à deux dimensions était la cause de cette lenteur. J’ai donc fait une troisième version qui n’utilise que des tableaux à une dimension :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
 
Private Sub OptimiserOrdrePercages_Genetique3(out) 'AVEC UN TABLEAU A UNE DIMENSION
    Dim per As PercageCNC
    Dim MaxLong As Double
    Dim MinLong As Double
    Dim MinLongPrec As Double
    Dim MinLongConstantDepuis As Integer
    Dim TmpListe As Collection
    Dim Debut As Single
    Dim NbPercages As Integer
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim c As Integer
 
    Dim p1 As Integer
    Dim p2 As Integer
    Dim p As Integer
 
    Dim q As Integer
    Dim q1 As Integer
    Dim q2 As Integer
 
    Dim ChiffreOK As Boolean
    Dim XP As Double, YP As Double
    Dim Stagnation As Boolean
    Dim premier As Boolean
 
    Dim TaillePopulation As Integer
 
    Dim NbGenerations As Long
    Dim Duree As Single
 
    NbPercages = out.ListePercages.count
    TaillePopulation = ParOpti_NbIndividus + ParOpti_NbReproductions + ParOpti_NbMutations
 
    ReDim Matrice((NbPercages + 1) * (TaillePopulation + 1)) As Integer
    ReDim Lg(TaillePopulation + 1) As Double
    ReDim Pointeur(TaillePopulation + 1) As Integer
    ReDim IndicePointeur(TaillePopulation + 1) As Integer
    ReDim ColonneOK(TaillePopulation + 1) As Integer
    'Pointeur(1...NbIndividus) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux parents
    'Pointeur(NbIndividus+1...NbIndividus+ParOpti_NbReproductions) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux enfants
    'Pointeur(NbIndividus+ParOpti_NbReproductions+1...NbIndividus+ParOpti_NbReproductions+ParOptiMutants) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux mutants
    'Lg(i) contient la longeur du parcours de la colonne i (Matrice(.,i))
 
     Debut = Timer
 
    out.LongAvantOptim = 0
    Set per = out.ListePercages.Item(1)
    XP = per.Xmachine
    YP = per.Ymachine
    For i = 2 To NbPercages
        Set per = out.ListePercages.Item(i)
        out.LongAvantOptim = out.LongAvantOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
        XP = per.Xmachine
        YP = per.Ymachine
    Next i
 
     'Création de la première génération :
    For i = 1 To TaillePopulation
        Pointeur(i) = i
        IndicePointeur(i) = (Pointeur(i) - 1) * NbPercages
    Next i
 
    'La liste originale :
    For j = 1 To NbPercages
        'Matrice(j, 1) = j
        Matrice(j) = j 'IndicePointeur(1) = 0
    Next j
 
    'Les listes aléatoires :
    Set TmpListe = New Collection
    For p = 2 To ParOpti_NbIndividus
        For j = 1 To NbPercages
            TmpListe.Add j
        Next j
        Randomize
        q = IndicePointeur(p) 'Remarque : ici Pointeur(p) = p car on est à la première génération
        For j = 1 To NbPercages
            'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            k = Int(TmpListe.count * Rnd + 1)
            'Matrice(j, p) = TmpListe.Item(k)
            Matrice(j + q) = TmpListe.Item(k)
            Call TmpListe.Remove(k)
        Next j
    Next p
 
    'Calcul du critère de la 1ière génération :
    For p = 1 To ParOpti_NbIndividus
        q = IndicePointeur(p) 'Remarque : ici Pointeur(p) = p car on est à la première génération
        'Set per = out.ListePercages.Item(Matrice(1, p)) '1ier perçage de l'individu p
        Set per = out.ListePercages.Item(Matrice(1 + q)) '1ier perçage de l'individu p
        XP = per.Xmachine
        YP = per.Ymachine
        For j = 2 To NbPercages
            'Set per = out.ListePercages.Item(Matrice(j, p)) 'Perçage j de l'individu p
            Set per = out.ListePercages.Item(Matrice(j + q)) 'Perçage j de l'individu p
            Lg(p) = Lg(p) + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine) 'Longueur de l'individu p
            XP = per.Xmachine
            YP = per.Ymachine
        Next j
    Next p
    MinLongPrec = Lg(1)
    MinLongConstantDepuis = 0
    out.DebugInfo = ""
 
    'Mesure de la performance :
    NbGenerations = 1
 
    Do '--------------------------------------------------------------------------------------------------------------------------------------
        Randomize
 
        'Mesure de la performance :
        NbGenerations = NbGenerations + 1
 
        'REPRODUCTION :
        For i = 1 To ParOpti_NbReproductions
            'p = Pointeur(i + ParOpti_NbIndividus) 'p = pointeur de l'enfant n°i, stocké dans Pointeur(ParOpti_NbIndividus+1...ParOpti_NbIndividus+1+ParOptiNbReproductions)
            q = IndicePointeur(Pointeur(i + ParOpti_NbIndividus))
            '
            'On choisi aléatoirement deux parents :
            k = Int(ParOpti_NbIndividus * Rnd + 1)
            Do
                m = Int(ParOpti_NbIndividus * Rnd + 1)
            Loop Until k <> m
            'On cherche les colonnes p1 et p2 correspondant aux parents k et m
            'p1 = Pointeur(k)
            'p2 = Pointeur(m)
            q1 = IndicePointeur(Pointeur(k))
            q2 = IndicePointeur(Pointeur(m))
            'Choix aléatoire du point de croisement :
            'k=1 => 1.23456789
            'm=8 => 12345678.9
            c = Int((NbPercages - 1) * Rnd + 1)
            'Croisement :
            For j = 1 To c
                'Matrice(j, p) = Matrice(j, p1) 'Le percage j de l'enfant = le percage j du parent 1
                Matrice(j + q) = Matrice(j + q1) 'Le percage j de l'enfant = le percage j du parent 1
            Next j
            'Génome du parent 2 dans l'enfant :
            j = 0
            m = c
            Do
               j = j + 1
               ChiffreOK = True
               'On doit choisir les perçages du parent 2 dans l'ordre, en 'sautant' les percages déjà présents dans l'enfant :
               For k = 1 To c
                    'If Matrice(k, p) = Matrice(j, p2) Then ChiffreOK = False
                    If Matrice(k + q) = Matrice(j + q2) Then ChiffreOK = False
               Next k
               If ChiffreOK Then
                    m = m + 1
                    'Matrice(m, p) = Matrice(j, p2)
                    Matrice(m + q) = Matrice(j + q2)
               End If
            Loop Until m = NbPercages Or j = NbPercages
        Next i
 
        'MUTATION :
        For i = 1 To ParOpti_NbMutations
            'p = Pointeur(i + ParOpti_NbIndividus + ParOpti_NbReproductions)
            q = IndicePointeur(Pointeur(i + ParOpti_NbIndividus + ParOpti_NbReproductions))
            'p = pointeur du mutant n°i, stocké dans Pointeur(ParOpti_NbIndividus+ParOpti_NbReproductions+1...TaillePopulation)
            '
            'Choix aléatoire des deux perçages qui seront échangés :
            k = Int(NbPercages * Rnd + 1)
            Do
                c = Int(NbPercages * Rnd + 1)
            Loop Until k <> c
            '
            'Choix aléatoire du parent dont le clone sera muté :
            m = Int(ParOpti_NbIndividus * Rnd + 1)
            'p1 = Pointeur(m)
            q1 = IndicePointeur(Pointeur(m))
            '
            For j = 1 To NbPercages
                If j = c Then
                    'Matrice(j, p) = Matrice(k, p1)
                    Matrice(j + q) = Matrice(k + q1)
                ElseIf j = k Then
                    'Matrice(j, p) = Matrice(c, p1)
                    Matrice(j + q) = Matrice(c + q1)
                Else
                    'Matrice(j, p) = Matrice(j, p1)
                    Matrice(j + q) = Matrice(j + q1)
                End If
            Next j
        Next i
 
        'CALCUL DU CRITERE POUR TOUS LES INDIVIDUS :
        'Optimisation : pas besoin de calculer à nouveau le critère pour les membres de la génération précédente :
        'For Each p In ListeParcours 'ListeParcours.Count = ParOpti_NbIndividus + Nombre de reproductions + ParOpti_NbMutations > ParOpti_NbIndividus
        For i = ParOpti_NbIndividus + 1 To TaillePopulation
            p = Pointeur(i)
            q = IndicePointeur(p)
            'p est le n° de la colonne de Matrice(,) et le numéro de Lg()
            Lg(p) = 0
            'Set per = out.ListePercages.Item(Matrice(1, p))
            Set per = out.ListePercages.Item(Matrice(1 + q))
            XP = per.Xmachine
            YP = per.Ymachine
            For j = 2 To NbPercages
                'Set per = out.ListePercages.Item(Matrice(j, p))
                Set per = out.ListePercages.Item(Matrice(j + q))
                'Optimisation : la fonction Sqr est couteuse en temps de calcul et p'est pas nécessaire pour faire une comparaison :
                'p.Lg = p.Lg + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
                'p.Lg = p.Lg + (XP - per.Xmachine) ^ 2 + (YP - per.Ymachine) * (YP - per.Ymachine) ^ 2
                Lg(p) = Lg(p) + (XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)
                XP = per.Xmachine
                YP = per.Ymachine
            Next j
        Next i
        'Next p
 
        'SELECTION :
        'Ici on doit réaffecter les pointeurs
        'Plus un parcours (une colonne de Matrice()) a une longeur élevé (mauvais critère), plus son pointeur est long :
        For i = 1 To TaillePopulation
            ColonneOK(i) = 0
        Next i
        '
        For p = 1 To ParOpti_NbIndividus
            'Les pointeurs Pointeur(1...NbIndividus) correspondront aux meilleurs individus, c'est à dire aux NbIndividus colonnes les meilleures
 
            premier = True
            For j = 1 To TaillePopulation 'Pour chaque colonne 'i'
                If ColonneOK(j) = 0 Then 'Les colonnes qui n'ont pas encore un pointeur pointant sur elles
                    If premier Then
                        premier = False
                        MinLong = Lg(j)
                        k = j
                    Else
                        If Lg(j) < MinLong Then
                            MinLong = Lg(j)
                            k = j
                        End If
                    End If
                End If
            Next j
            'Ici, K contient le n° de la colonne la plus courte parmis celles restant à trier
            Pointeur(p) = k
            IndicePointeur(k) = (k - 1) * NbPercages
            ColonneOK(k) = 1
        Next p
 
        'p = Pointeur(i)
        'q = IndicePointeur(p)
        'q = IndicePointeur(Pointeur(i))
 
        'Il faut tout de même renuméroter les colonnes 'mauvaises' car elles seront utilsées pour les enfants et les mutants de la génération suivante :
        p = ParOpti_NbIndividus
        For j = 1 To TaillePopulation
            If ColonneOK(j) = 0 Then 'Colonne n'ayant aucun pointeur pointant sur elle
                p = p + 1
                Pointeur(p) = j
                IndicePointeur(j) = (j - 1) * NbPercages
                'ColonneOK(j) = 1 superflux
            End If
        Next j
 
    'Pointeur(1...NbIndividus) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux parents
    'Pointeur(NbIndividus+1...NbIndividus+ParOpti_NbReproductions) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux enfants
    'Pointeur(NbIndividus+ParOpti_NbReproductions+1...NbIndividus+ParOpti_NbReproductions+ParOptiMutants) contient les n° de colonne 'c' de Matrice(l,c) correspondants aux mutants
    'Lg(i) contient la longeur du parcours de la colonne i (Matrice(.,i))
 
        'On détermine si on stagne ou pas :
        Stagnation = True
        For j = 1 To ParOpti_NbIndividus
            p = Pointeur(j)
            '
            If Lg(p) < MinLongPrec Then
                Stagnation = False
                MinLongPrec = Lg(p)
            End If
        Next j
        If Stagnation Then
            MinLongConstantDepuis = MinLongConstantDepuis + 1
            If MinLongConstantDepuis > ParOpti_MaxMinLongConstatDepuis Then Exit Do
        Else
            MinLongConstantDepuis = 0
        End If
 
        If Timer - Debut > ParOpti_DureeMax Then Exit Do
    Loop '--------------------------------------------------------------------------------------------------------------------------------------
 
    'out.DebugInfo = out.DebugInfo + ";Temps de calcul : " + Format(Timer - Debut) + " secondes"
    'Mesure de la performance :
    Duree = Timer - Debut
     out.DebugInfo = "Durée " + Format(Duree, "0.000") + "s - " + Format(NbGenerations) + " générations - " + Format(NbGenerations / Duree, "0.0") + " générations par seconde."
 
    'On sélectionne le parcours le plus court :
    'Set p = ListeParcours.Item(K)
    For j = 1 To ParOpti_NbIndividus
        p = Pointeur(j)
        '
        If j = 1 Then
            MinLong = Lg(p)
            k = p
        Else
            If Lg(p) < MinLong Then
                MinLong = Lg(p)
                k = p
            End If
        End If
    Next j
 
    q = IndicePointeur(k)
 
    'Contrôle de sécurité :
    ChiffreOK = True
    For i = 1 To out.ListePercages.count - 1
        'k = Matrice(i, p) 'Perçage i du meilleur parcours p
        k = Matrice(i + q) 'Perçage i du meilleur parcours p
        If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
        For j = i + 1 To out.ListePercages.count
            'm = Matrice(j, p) 'Perçage j du meilleur parcours p
            m = Matrice(j + q) 'Perçage j du meilleur parcours p
            If k = m Then ChiffreOK = False
        Next j
    Next i
    'k = Matrice(out.ListePercages.count, p) 'dernier Perçage du meilleur parcours p
    k = Matrice(out.ListePercages.count + q) 'dernier Perçage du meilleur parcours p
    If k < 1 Or k > out.ListePercages.count Then ChiffreOK = False
 
    'Affectation :
    If ChiffreOK Then
        'Affectation :
        Set TmpListe = New Collection
        For j = 1 To NbPercages
            'Set per = out.ListePercages.Item(Matrice(j, p)) 'Perçage j du meilleur parcours p
            Set per = out.ListePercages.Item(Matrice(j + q)) 'Perçage j du meilleur parcours p
            TmpListe.Add per
        Next j
        Set out.ListePercages = TmpListe
        'out.LongApresOptim = MinLong
        out.LongApresOptim = 0
        Set per = out.ListePercages.Item(1)
        XP = per.Xmachine
        YP = per.Ymachine
        For i = 2 To NbPercages
            Set per = out.ListePercages.Item(i)
            out.LongApresOptim = out.LongApresOptim + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine))
            XP = per.Xmachine
            YP = per.Ymachine
        Next i
    Else
        MsgBox "Contrôle de sécurité échoué"
        out.LongApresOptim = -1
    End If
 
End Sub

Mais c’est juste très légèrement moins lent (quelques % de gagnés).

Donc soit la gestion des objets et des collections est très performante en VB5, soit la gestion des tableaux est très lente en VB5.

Si quelqu’un ici à une idée pour optimiser mon code qu’il n’hésite pas.

Ce post sera utile à ceux qui cherchent à utiliser les algorithmes génétiques, et à ceux qui souhaitent optimiser leur code.

NB : Cette page explique très bien le principe des algorithmes génétiques : http://fr.wikipedia.org/wiki/Algorit...A9n%C3%A9tique

A+

**electroremy** · 31/08/2014, 17h52

Pour en avoir le cœur net, j’ai refait les tests avec le fichier .EXE (et non pas en mode « debuggage ») :

Chemin A – 77 perçages :
- Version 1 (avec objets) : 566 générations par seconde
- Version 2 (avec tableaux) : 95,8 générations par seconde
- Version 3 (avec tableaux à une dimension) : 97,3 générations par seconde

Chemin B – 12 perçages :
- Version 1 (avec objets) : 3655 générations par seconde
- Version 2 (avec tableaux) : 628,2 générations par seconde
- Version 3 (avec tableaux à une dimension) : 639,9 générations par seconde

La différence est encore plus flagrante.

A noter que le programme exécuté depuis le fichier .EXE est deux fois plus rapide que depuis le débuggeur.

(NB : un perçage est équivalent à une ville dans le problème du voyageur de commerce)

A+

VB5 Rapidité du code - Algorithmes génétiques : Objets / Tableaux / Tableaux à une dimenssion

VB 6 et antérieur

Discussions similaires

Partager

Partager