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
|
' Dérivé de l'algo de Baruch et du code original en c# de Alikendarfen
Private Sub AlgoDistance(ByVal ProdInitiale As Double, ByVal DistanceMax As Long)
Dim Mine1 As tMine, Mine2 As tMine
Dim ProductionCourante As Double, t12 As Double, t21 As Double
Dim i As Long, Swap As Long, Distance As Long, j As Long
Dim Ameliore As Boolean
' Démarrage avec la distance la + grande entre les mines
Distance = DistanceMax
Do
Ameliore = False
' Production de départ
ProductionCourante = ProdInitiale
' Parcourt des paires de mines selon le distance entre mines
For i = Distance To UBound(gMines)
Mine1 = gMines(gIndex(i - Distance))
Mine2 = gMines(gIndex(i))
' Temps mine1 avant mine2, partant de la production courante
t12 = (Mine1.Cout / ProductionCourante) + (Mine2.Cout / (ProductionCourante + Mine1.Prod))
' Temps mine2 avant mine1, partant de la production courante
t21 = (Mine2.Cout / ProductionCourante) + (Mine1.Cout / (ProductionCourante + Mine2.Prod))
' Ce gain est il meilleur ?
If (t12 > t21) Then
Swap = gIndex(i - Distance)
gIndex(i - Distance) = gIndex(i)
gIndex(i) = Swap
Ameliore = True
End If
' Production courante jusqu'à i - 1
For j = i - Distance To i - 1
ProductionCourante = ProductionCourante + gMines(gIndex(j)).Prod
Next j
Next i
' Distance réduite si pas d'amélioration
If Not Ameliore Then Distance = Distance - 1
' Tant qu'on améliore ou distance conforme, on continue
Loop While Ameliore Or Distance >= 1
End Sub |
