Discussion :

[wmune]

Partie 1 :
Un tableau Excel de n*n cellules est généré. Une forêt aléatoire est construite suivant le principe
suivant : une cellule est tirée au sort, si elle est vide, celle-ci est coloriée en vert, et contient la lettre
A (A comme Arbre). (L’inclusion de lettre est facultative, on pourra utiliser des codes de couleur),
sinon si la cellule contient déjà un arbre et la génération de la forêt s’arrête
(J'ai le code de la première partie)

Partie 2 (note jusqu’à 12/20). Version virus stupide
Un virus mangeur d’arbre apparaît dans la forêt, il se propage de façon aléatoire dans la forêt
générée. Au départ, le virus possède une quantité d’énergie maximale ET. A chaque fois que le virus
se déplace, il dépense une part de cette énergie EU. Lorsque le virus consomme toute son énergie (le
virus meurt. Si le virus mange un arbre, son énergie passe au maximum ET
Pour simplifier, on considère que chaque déplacement du virus sur une cellule du tableau coute une
unité d’énergie EU, et ET=k EU. K est une valeur arbitraire.
Paramètres d’entrées de la partie 2a
La taille n du tableau d’Excel, et la constante k.

Partie 2 b, version virus intelligent, (note jusqu’à 20/20)
Cette fois ci, le virus possède une intelligence. Il est capable de percevoir son environnement proche,
à savoir les 8 cellules voisines :
Voisin Voisin Voisin
Voisin Virus Voisin
Voisin Voisin Voisin
A/ Si un au moins un des voisins est un arbre alors le virus se déplace de façon arbitraire sur un des
arbres et le mange
Arbre
Virus
arbre
Avant déplacement
Après déplacement : Le virus s’est déplacé en bas à droite.
B/Si aucun des voisins n’est un arbre, le virus se déplace aléatoirement à partir de sa position.

S IL VOUS PLAIT AIDEZ MOI A TROUVER LE CODE POUR CETTE SECONDE PARTIE

[luca.donati]

Bonjour, wmune.
Ton exercice est intéressant. Pourrais-tu poster la partie de code que tu as déjà, pour qu'on puisse raisonner plus concrètement?

[Theze]

Bonjour,

Regarde cette discussion :
http://www.developpez.net/forums/d13...reation-virus/
Patrick et moi même avons fait plusieurs propositions qui te donnerons probablement un point de départ. Tu as le virus avec une avance totalement aléatoire et automatique et le virus intelligent avec avancement aléatoire et manuel (qu'il est possible de rendre automatique), il sait où sont ces cibles mais son déplacement vers ces dernières est aléatoire mais si une cellule saine (rouge) se trouve sur son passage (il est en direction de la cible en cours) ou dans son environnement proche elle sera infectée. Pour les tests, il te faut lire les codes et commentaires afin de savoir quoi faire.
par exemple, pour mon dernier code (le virus intelligent) la zone est A1:O36 et certaines des cellules de cette zone doivent avoir le fond colorié en rouge (le nombre importe peu) et un bouton type Formulaire doit être posé sur la feuille à qui tu affecte la macro "Virus". La marche est manuelle donc, il faut cliquer à chaque fois sur le bouton pour faire progresser le virus. Ce dernier est de couleur verte et une fois la cellule infectée, elle devient bleu. Amuse toi !

Hervé.

[Marc-L]

Bonsoir, deuxième post dans ce sujet !

J'ai eu le même exercice sur un autre forum il y a une semaine, j'ai même posté un message et un lien plus tôt en fin d'après-midi mais ce message a été effacé !

Merci de m'en expliquer en MP la raison.

Sinon j'ai deux approches sous le coude pour la définition des huit cellules voisines, et un fonctionnement totalement automatique du virus "intelligent" …

[Theze]

Bonjour,

Pour un avancement totalement automatique du virus. Lancer la proc "Virus" :

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
 
Declare Function GetTickCount Lib "Kernel32" () As Long
 
Dim Tbl() As Long
 
Dim Plage As Range
Dim Cel As Range
 
Dim Lgn As Long
Dim Col As Long
Dim PosCol As Long
Dim PosLgn As Long
Dim J As Long
Dim X As Long
Dim Y As Long
 
Dim Prox As Boolean
Dim Ini As Boolean
 
Sub Minuterie(Milliseconde As Long)
 
    Dim Arret As Long
 
    Arret = GetTickCount() + Milliseconde
 
    Do While GetTickCount() < Arret
 
        DoEvents
 
    Loop
 
End Sub
 
Sub Virus()
 
    Dim PlgProx As Range
    Dim CelProx As Range
    Dim C As Long
    Dim L As Long
 
    On Error GoTo Fin
 
    'initialise les variables
    If Ini = False Then
 
        Initialise
        Ini = True
 
    End If
 
    'effectue une pose d'une demi seconde
    Minuterie 500
 
    'si déjà initialisée, colore en bleu (contaminée) car la cellule est en vert (couleur du virus)
    If PosLgn <> 0 Then Plage(PosLgn, PosCol).Interior.ColorIndex = 5
 
    'supprime la couleur verte
    If Plage(Lgn, Col).Interior.ColorIndex = 10 Then Plage(Lgn, Col).Interior.ColorIndex = -4142
 
    '
    If X <> 0 Then If Plage(X, Y).Interior.ColorIndex = 10 Then Plage(X, Y).Interior.ColorIndex = -4142
 
    'évite d'incrémenter ou de décrémenter si la cible est une cellule à proximité
    If Prox = False Then
 
        'effectue un décalage de ligne et colonne en positif ou négatif selon position par rapport à la cible
        If Plage(Lgn, Col).Row < Tbl(1, J) Then Lgn = Lgn + 1
 
        If Plage(Lgn, Col).Row > Tbl(1, J) Then Lgn = Lgn - 1
 
        If Plage(Lgn, Col).Column < Tbl(2, J) Then Col = Col + 1
 
        If Plage(Lgn, Col).Column > Tbl(2, J) Then Col = Col - 1
 
    End If
 
    'pour l'effet visuel, la cellule en cours est colorée en vert
    If Plage(Lgn, Col).Interior.ColorIndex = -4142 Then Plage(Lgn, Col).Interior.ColorIndex = 10
 
    'si la couleur est rouge ou déjà en bleu
    If Plage(Lgn, Col).Interior.ColorIndex = 3 Or Plage(Lgn, Col).Interior.ColorIndex = 5 Then
 
        'si c'est la cellule cible (en rouge) incrémente pour la cible suivante
        If Plage(Lgn, Col).Address = Cells(Tbl(1, J), Tbl(2, J)).Address Then
 
            J = J + 1
 
        'sinon, si la cellule n'est pas la cellule cible mais qu'elle fait partie des cibles et qu'elle
        'n'a pas encore été contaminée (couleur bleu)
        ElseIf Plage(Lgn, Col).Interior.ColorIndex = 3 Then
 
            'redimensionne le tableau
            RedimTablo Tbl(), Lgn, Col
 
        End If
 
        'mémorise la position
        PosCol = Col
        PosLgn = Lgn
 
        'colore en vert (couleur du virus)
        Plage(Lgn, Col).Interior.ColorIndex = 10
 
    End If
 
    'si la cellule en cours n'est pas en ligne 1 ou colonne 1
    If Lgn > 1 Then L = -1
    If Col > 1 Then C = -1
 
    'mémorise pour supprimer la couleur verte de la cellule précédente
    X = Lgn
    Y = Col
 
    'défini la plage de proximité
    Set PlgProx = Plage.Range(Plage(Lgn, Col).Offset(L, C), Plage(Lgn, Col).Offset(1, 1))
 
    'parcour la plage à la recherche d'une cellule rouge
    For Each CelProx In PlgProx
 
        'si trouvée, redéfini la colonne et la ligne pour se diriger vers elle au prochain clic
        'mets la variable "Prox" à vrai et fin de boucle
        If CelProx.Interior.ColorIndex = 3 Then
 
            Col = CelProx.Column
            Lgn = CelProx.Row
            Prox = True
 
            Exit For
 
        End If
 
        'si rien trouver, pas de cellule à infecter à proximité
        Prox = False
 
    Next CelProx
 
    'appelle à nouveau pour le pas suivant
    Virus
 
Exit Sub
 
Fin:
Reinitialise
 
End Sub
 
Sub Initialise()
 
    Dim I As Long
 
    'défini la plage en dur
    Set Plage = Range("A1:O36")
 
    'la sélection
    'Set Plage = Selection
 
    'mémorise l'emplacement des cellules colorées
    For Each Cel In Plage
 
        If Cel.Interior.ColorIndex = 3 Then
 
            I = I + 1
            ReDim Preserve Tbl(1 To 2, 1 To I)
            Tbl(1, I) = Cel.Row
            Tbl(2, I) = Cel.Column
 
        End If
 
    Next Cel
 
    Randomize
 
    Lgn = Int(Rnd * Plage.Rows.Count) + 1
    Col = Int(Rnd * Plage.Columns.Count) + 1
 
    J = 1
 
    'le tableau est redistribué de façon aléatoire
    Tri Tbl
 
End Sub
 
Sub Reinitialise()
 
    Set Plage = Nothing
    Erase Tbl()
    Set Cel = Nothing
    Ini = False
    Lgn = 0
    Col = 0
    J = 0
    PosCol = 0
    PosLgn = 0
    J = 0
    Prox = False
    X = 0
    Y = 0
 
End Sub
 
Sub Tri(Tablo() As Long)
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Tempo1 As Long
    Dim Tempo2 As Long
    Dim K As Long
 
    'initialise le générateur de nombres aléatoire
    Randomize
 
    'crée le dico
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'boucle tant que toutes les positions non pas été trouvées
    Do
 
        K = Int(Rnd * UBound(Tablo, 2)) + 1
 
        If K <> 0 Then
 
            If Dico.exists(K) = False Then
 
                Dico.Add K, K
 
            End If
 
        End If
 
    Loop While Dico.Count <> UBound(Tablo, 2)
 
    K = 0
 
    'réorganise le tableau pour une avancée aléatoire
    For Each Cle In Dico.Keys
 
        K = K + 1
 
        Tempo1 = Tablo(1, K)
        Tempo2 = Tablo(2, K)
 
        Tablo(1, K) = Tablo(1, Cle)
        Tablo(2, K) = Tablo(2, Cle)
 
        Tablo(1, Cle) = Tempo1
        Tablo(2, Cle) = Tempo2
 
    Next Cle
 
End Sub
 
Sub RedimTablo(Tablo() As Long, Ligne As Long, Colonne As Long)
 
    Dim M As Long
    Dim N As Long
 
    For M = 1 To UBound(Tablo, 2)
 
        'quand trouvée, la supprime en déplacant les valeurs dans les dimensions et fin de boucle M
        If Tablo(1, M) = Ligne And Tablo(2, M) = Colonne Then
 
            For N = M To UBound(Tbl, 2) - 1
 
                Tbl(1, N) = Tbl(1, N + 1)
                Tbl(2, N) = Tbl(2, N + 1)
 
            Next N
 
            Exit For
 
        End If
 
    Next M
 
    'redimensionne en supprimant la dernière dimension qui ne sert plus à rien
    ReDim Preserve Tablo(1 To 2, 1 To UBound(Tablo, 2) - 1)
 
End Sub
 
Sub Colorer()
Dim LaPlage As Range
Dim LaCel As Range
 
    Set LaPlage = Range("A1:O36")
 
    For Each LaCel In LaPlage
 
        If LaCel.Interior.ColorIndex = 5 Then LaCel.Interior.ColorIndex = 3
 
    Next LaCel
 
End Sub

Hervé.

[Marc-L]

Bonjour ! (et merci pour la réponse en MP)

Ma première approche pour les 8 cellules voisines ressemble à celle du lien plus haut, valable si le terrain de jeu commence en colonne 1 ou en ligne 1.
Là le virus est un poil "évolué", il ne revient pas sur ses trois derniers pas (tableau AD) et est invincible, il ne s'arrête que quand il a tout dévoré !

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
Function Aleat(ByVal Rg As Range) As Range
     Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1)
End Function
 
 
Sub Pause(Optional P = 0.04)
      D = Timer:   F = D + P
 
    While Timer < F
       If Timer < D Then F = F - 86400: D = 0
    Wend
 
    DoEvents
End Sub
 
 
Sub ColorBug()
    Dim AD(2)
    Const CI = 44, LC = 16
      Set Rg = [A1].Resize(LC, LC)
    Rg.Clear:  Randomize
 
    Do
        With Aleat(Rg).Interior
            If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
        End With
    Loop
 
    Set Rs = Aleat(Rg)
 
    Do
        With Rs
            .Select
            AD(2) = AD(1):  AD(1) = AD(0):  AD(0) = .Address
 
            If .Interior.ColorIndex = CI Then
               .Interior.ColorIndex = xlNone:  [A1] = [A1] - 1:  If [A1] < 1 Then Exit Do
            End If
 
            Pause
                 C = .Column > 1
                 R = .Row > 1
            Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
        End With
 
        Set Rs = Nothing
 
        For Each Cel In Rc
            If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
        Next
 
        If Rs Is Nothing Then
            Do
                Set Rs = Aleat(Rc)
 
                For Each Cel In AD
                    NO = Rs.Address = Cel:  If NO Then Exit For
                Next
            Loop While NO
        End If
    Loop
End Sub

Ma deuxième approche dans le cas où ce terrain ne commence ni en colonne 1 ni en ligne 1
est d'utiliser l'intersection du terrain et des 8 cases autour du virus et respecte l'énoncé :

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
Function Aleat(ByVal Rg) As Range
   If TypeName(Rg) = "Range" Then Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1) _
                             Else Set Aleat = Range(Rg(Fix(UBound(Rg) * Rnd) + 1))
End Function
 
 
Sub ColoriagePuisRecherche()
    Const CI = 44, LC = 16
      Set Rg = [B2].Resize(LC, LC)
           K = Rg.Count
          EU = K
           M = K
    Union([A1:F1], Rg).Clear:  Randomize
 
    Do
        With Aleat(Rg).Interior
            If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: N = N + 1
        End With
    Loop
 
      [A1] = N
    Set Rs = Aleat(Rg)
 
    Do
        With Rs
            .Select:  EU = EU - 1
 
            If .Interior.ColorIndex = CI Then
               .Interior.ColorIndex = xlNone:  N = N - 1
                If EU < M Then M = EU
                If N = 0 Then [C1] = "EU :  " & EU:  [E1] = "EU mini :  " & M:  Exit Do
                EU = K
 
            ElseIf EU = 0 Then
                .Value = "    MORT !":  [C1] = "Reste :  " & N:  Exit Do
            End If
 
            Set Rc = Application.Intersect(.Offset(-1, -1).Resize(3, 3), Rg)
                 A = .Address
        End With
 
        CA = ""
 
        For Each Cel In Rc
            If Cel.Interior.ColorIndex = CI Then CA = CA & " " & Cel.Address
        Next
 
        Do
            If CA = "" Then Set Rs = Aleat(Rc) Else Set Rs = Aleat(Split(CA))
        Loop While Rs.Address = A
    Loop
End Sub