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)

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

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+