Bonjour,
Suite à mon précédent post (http://www.developpez.net/forums/d14...ux-dimenssion/)
J’ai implémenté, pour la recherche du chemin le plus court lorsque le nombre de perçage est faible (n<6) une méthode directe, plus performante que les algorithmes génétiques.
Cette méthode est simplement une énumération récursive de toutes les permutations possibles. Elle a été faite après avoir examiné un certain nombre de codes sur le net.
Voici le code :
(le code est dans la fonction recursive OptimiserOrdrePercages_Direct_CR)
Ce code marche, mais il n’est pas optimal. Pourquoi ? Parce que la moitié des permutations sont équivalentes à l’autre moitié ; par exemple 3421 est équivalent à 1243 (longueur identique, disposition identique en inversant juste le sens de lecture de droite à gauche)
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 Private Sub OptimiserOrdrePercages_Direct(out As OutilCNC) 'Code directe pour out.ListePercage.count <6 Dim per As PercageCNC Dim i As Integer Dim n As Integer Dim XP As Double, YP As Double Dim TmpListe As Collection Dim Debut As Single Dim msg As String Dim ListePos As Collection Dim Comb As Collection Dim MinComb As Collection Debut = Timer n = out.ListePercages.count If n > 2 And n < 6 Then 'Calcul de la longueur avant optim : out.LongAvantOptim = 0 Set per = out.ListePercages.Item(1) XP = per.Xmachine YP = per.Ymachine For i = 2 To n 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 'Choix : Call OptimiserOrdrePercages_Direct_CR(n, 0, out, ListePos, Comb, MinComb, -1) 'Affectation : msg = "" Set TmpListe = New Collection For i = 1 To n msg = msg + Format(MinComb(i)) + " " Set per = out.ListePercages.Item(MinComb(i)) TmpListe.Add per Next i Set out.ListePercages = TmpListe 'Calcul de la longueur après optim : out.LongApresOptim = 0 Set per = out.ListePercages.Item(1) XP = per.Xmachine YP = per.Ymachine For i = 2 To n 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 out.DebugInfo = "Calcul direct - Durée " + Format(Timer - Debut, "0.000") + "s - " + msg + out.DebugInfo Else If n = 2 Then Set per = out.ListePercages.Item(1) XP = per.Xmachine YP = per.Ymachine Set per = out.ListePercages.Item(2) out.LongAvantOptim = Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)) out.LongApresOptim = out.LongAvantOptim out.DebugInfo = out.DebugInfo + "(pas d'optimisation, il n'y a que deux perçages)" Else out.DebugInfo = out.DebugInfo + "(pas d'optimisation, il n'y a qu'un perçage)" End If End If End Sub Private Sub OptimiserOrdrePercages_Direct_CR(ByRef NbPercages As Integer, ByVal Niveau As Integer, ByRef out As OutilCNC, ByRef ListePos As Collection, ByRef Comb As Collection, ByRef MinComb As Collection, ByRef MinLongComb As Double) Dim i As Integer Dim j As Integer Dim K As Integer Dim Lg As Double If Niveau = 0 Then Set ListePos = New Collection For i = 1 To NbPercages ListePos.Add i Next i Set Comb = New Collection Call OptimiserOrdrePercages_Direct_CR(NbPercages, Niveau + 1, out, ListePos, Comb, MinComb, MinLongComb) Else If Niveau = NbPercages Then K = 0 For i = 1 To ListePos.count j = ListePos.Item(1) ListePos.Remove (1) Comb.Add j If Niveau = NbPercages Then 'Comb contient la combinaison correspondant au parcours à tester : Lg = OptimiserOrdrePercages_Direct_Test(Comb, out) If MinLongComb < 0 Then 'Début : MinLongComb = Lg K = j Else If Lg < MinLongComb Then MinLongComb = Lg K = j End If End If Else Call OptimiserOrdrePercages_Direct_CR(NbPercages, Niveau + 1, out, ListePos, Comb, MinComb, MinLongComb) End If Comb.Remove (Comb.count) ListePos.Add (j) Next i If Niveau = NbPercages And K > 0 Then Set MinComb = New Collection For i = 1 To Comb.count MinComb.Add (Comb.Item(i)) Next i MinComb.Add K End If End If End Sub Private Function OptimiserOrdrePercages_Direct_Test(Comb As Collection, out As OutilCNC) As Double Dim i As Integer Dim per As PercageCNC Dim XP As Double, YP As Double OptimiserOrdrePercages_Direct_Test = 0 Set per = out.ListePercages.Item(Comb.Item(1)) XP = per.Xmachine YP = per.Ymachine For i = 2 To out.ListePercages.count Set per = out.ListePercages.Item(Comb.Item(i)) OptimiserOrdrePercages_Direct_Test = OptimiserOrdrePercages_Direct_Test + Sqr((XP - per.Xmachine) * (XP - per.Xmachine) + (YP - per.Ymachine) * (YP - per.Ymachine)) XP = per.Xmachine YP = per.Ymachine Next i 'DEBUGGAGE : out.DebugInfo = out.DebugInfo + vbCrLf out.DebugInfo = out.DebugInfo + "; Longueur : " + Format(OptimiserOrdrePercages_Direct_Test, "0.00") For i = 1 To Comb.count out.DebugInfo = out.DebugInfo + " " + Format(Comb.Item(i)) Next i ' End Function
Il faut que je modifie cet algorithme (plus exactement le code de la fonction OptimiserOrdrePercages_Direct_CR) pour ne tester que la moitié des combinaisons. Comment y parvenir ?
Voici un exemple de l'affichage des résultats, donnant l’ordre dans lequel les combinaisons sont testées dans le cas n=4 :
1 2 3 4
1 2 4 3
1 3 4 2
1 3 2 4
1 4 2 3
1 4 3 2
2 3 4 1
2 3 1 4
2 4 1 3
2 4 3 1
2 1 3 4
2 1 4 3
3 4 1 2
3 4 2 1
3 1 2 4
3 1 4 2
3 2 4 1
3 2 1 4
4 1 2 3
4 1 3 2
4 2 3 1
4 2 1 3
4 3 1 2
4 3 2 1
Merci
A+
Partager