[VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Staple1600

XLDnaute Barbatruc
Bonjour à tous


En relisant un vieux numéro de Science et vie (N° 931 - avril 1995)

j'ai eu envie de retranscrire le programme QBasic de la rubrique Informatique amusante en VBA.

Par curiosité, j'aimerais voir de quelle manière vous écririez votre code VBA pour voir la fourmi se promener dans votre tableur préféré ;)

Pour mieux comprendre , je vous invite à lire cet article :
Fourmi de Langton - Wikipédia.

Merci à ceux qui s'intéresseront à la chose.

A toutes fin utiles voici le code QBasic original:

Code:
SCREEN 9:CLS
XF=300: YF=150: DXF=1: DYF=0
DO WHILE INKEYS=""
X=POINT(XF,YF)
IF X=15 THEN GOSUB 1000
IF X=0 THEN GOSUB 2000
PSET(XF,YF),C
XF=XF+DXF:YF=YF+DYF
LOOP
END
1000 C=0
IF DXF=1 AND DYF=0 THEN DXF=0: DYF=1: RETURN
IF DXF=0 AND DYF=1 THEN DXF=-1: DYF=0: RETURN
IF DXF=- AND DYF=0 THEN DXF=0: DYF=-1: RETURN
IF DXF=0 AND DYF=-1 THEN DXF=1: DYF=1: RETURN
2000 C=15
IF DXF=1 AND DYF=0 THEN DXF=0: DYF=-1: RETURN
IF DXF=0 AND DYF=-1 THEN DXF=-1: DYF=0: RETURN
IF DXF=-1 AND DYF=0 THEN DXF=0: DYF=1: RETURN
IF DXF=0 AND DYF=1 THEN DXF=1: DYF=0: RETURN
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Salut Staple :),
Sympa :p.
Petites questions complémentaires :
Quel est le comportement à adopter sur les bords ? Stop ou encore ? Rotation supplémentaire dans le sens prévu au départ ?
Quelle taille de grille ? J'essaie sur du 50 x 50 pour l'instant.
A te lire :cool:
 

Staple1600

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Bonjour JNP


50x50 est la taille que j'utilise (avec un code VBA trouvé sur le net *)


J'ai un petit souci pour transcrire littéralement le "Do while inkey$" du code QBasic

Je suis parti sur cette syntaxe
Code:
Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer

Sub test()
'touche Espace pas actionnée..'(&HD)(&H20) = 0 '(&H2E) = 0
While GetAsyncKeyState(&H20) = 0
 DoEvents
' ici ou pas code de déplacement
Wend
' ou ici ?
MsgBox "test"
End Sub
J'ai un doute pour savoir où mettre le code relatif au déplacement de la fourmi

* : je trouve bizarre de n'avoir trouver qu'une seule implémentation en VBA de la fourmi de Langton sur le net
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re Stapple :),
Je n'ai pas essayé de traduire le code, je suis plutôt parti sur une version personnelle :p...
Mon essai en pièce jointe. Ça donne l'impression de faire ce qu'il faut, mais je ne garanti pas le respect des règles :D.
Je suis passé en 200 x 200, c'est plus beau :rolleyes:...
Mode d'emploi simple. Tu sélectionnes la cellule de départ, et tu donnes la direction que tu veux. Un stop te permet de retrouver la main.
C'est du 2007, mais il devrait fonctionner en antérieur.
A + :cool:
 

Pièces jointes

  • Fourmi.xls
    128.5 KB · Affichages: 236

Staple1600

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re


Voici le code VBA que j'avais trouvé sur le net

Code:
Option Explicit
'auteur : nattou_curry

Const DIR_UP = 0
Const DIR_RIGHT = 1
Const DIR_DOWN = 2
Const DIR_LEFT = 3
Const COLOR_WHITE = &HFFFFFF
Const COLOR_BLACK = &H0


Sub Langtons_ant()
    Dim r_Ant As Long, c_Ant As Long
    Dim dir_Ant As Integer
  '///ajout Staple///
    Dim DirectionDebut$
    Sheets.Add
    With ActiveSheet.Cells
    .ColumnWidth = 0.33
    .RowHeight = 3
    End With
    ActiveWindow.Zoom = 62
    r_Ant = 50: c_Ant = 50
    DirectionDebut = UCase(InputBox("Direction de départ?" _
    & Chr(13) & "Haut : H, Bas: B, Droite : D, Gauche: G" _
    & Chr(13) & " (Réponse autorisées : H, B , D ou G )", "Choix Utilisateur", "H"))
    Select Case DirectionDebut
    Case "H"
    dir_Ant = DIR_UP
    Case "B"
    dir_Ant = DIR_DOWN
    Case "D"
    dir_Ant = DIR_RIGHT
    Case "G"
    dir_Ant = DIR_LEFT
    End Select
   '///fin ajout///
     
    'dir_Ant = DIR_RIGHT 'DIR_UP
    
    Do While 0 < c_Ant And c_Ant <= Columns.Count _
            And 0 < r_Ant And r_Ant <= Rows.Count
        If Cells(r_Ant, c_Ant).Interior.Color = COLOR_BLACK Then
            dir_Ant = (dir_Ant + 1) Mod 4
            Cells(r_Ant, c_Ant).Interior.Color = COLOR_WHITE
        Else
            dir_Ant = (dir_Ant + 3) Mod 4
            Cells(r_Ant, c_Ant).Interior.Color = COLOR_BLACK
        End If
        
        Select Case dir_Ant
            Case DIR_UP
                r_Ant = r_Ant - 1
            Case DIR_RIGHT
                c_Ant = c_Ant + 1
            Case DIR_DOWN
                r_Ant = r_Ant + 1
            Case DIR_LEFT
                c_Ant = c_Ant - 1
        End Select
    Loop
End Sub
En attendant de lire d'autres versions VBA, bon dimanche à tous

JNP : j'ai testé ton code sous Excel 2000, cela fonctionne.
Merci pour ta contribution.
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Bonjour à tous,
Salut l'Agrafe :),
Salut JNP :),

Je me suis abonné à cette discussion et je ne le regrette pas.
Je fais tourner (sous XL 2003) "Fourmi.xls" depuis une heure et il est vrai qu'elles sont travailleuses.... (Lire "Les Fourmis" de Werber....)

Bravo.... pour le thème et pour le code

A++ :) et :)
A+ à tous
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Bonjour à tous,

Si j'en avais les compétences, c'est avec plaisir que je l'aurais fait...
Mes 5K de messages ne signifient pas que je sois capable de le faire...

A+ à tous
 

JNP

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re :),
Pas cool ton code, ça part on ne sait où, et on ne peut pas récupérer la main :confused:...
Que dit le mien ?
A + :cool:
 

Staple1600

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re



JNP: J'ai pourtant testé le code que j'ai posté sans souci sous Excel 2000:confused:

Le tien comme je le disais précédemment fonctionne sous Excel 2000.
 

JNP

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re :),
Il est parti en bas à droite en perdition... J'ai été obligé de fermer mon tableur préféré :p.
A +v:cool:
 

Staple1600

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Re


Pour t'en convaincre

voici mon fichier de test

Il me semble que le code produit l'effet escompté:
à savoir qu'un partir d'un certain moment la fourmi emprunte une "sorte d'escalier"

C'est ainsi que commençait l'article de Science et Vie

"L'ordre peut-il surgir soudain d'un chaos régi par une règle fort simple ?"

PS:
Je viens de réaliser que tu es sous Excel 2007, et c'est là que ça coince

Car sous Excel 2000, la macro s'arrête dès que la fourmi atteint la 256ème colonne.

Pour les gens sous Excel 2007

Modifier le code comme ceci:

Remplacer
Do While 0 < c_Ant And c_Ant <= Columns.Count _
And 0 < r_Ant And r_Ant <= Rows.Count

par
Do While 0 < c_Ant And c_Ant <= 125 _
And 0 < r_Ant And r_Ant <= Rows.Count
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Bonjour à tous
Amusant tout ça... J'y vais de mon code, un peu brut de fonderie, mais court :
Code:
[COLOR="DarkSlateGray"]Sub tata()
Dim ol As Integer, oc As Integer, i As Long, k As Integer, x As Long, y As Long
[COLOR="SeaGreen"]'
'Choix des couleurs[/COLOR]
   Range(Cells(1, 1), Cells(256, 256)).Interior.Color = 26367
   y = Cells(1, 1).Interior.Color
   Range(Cells(2, 2), Cells(255, 255)).Interior.ColorIndex = 4 [COLOR="SeaGreen"]'couleur de fond[/COLOR]
   x = Cells(2, 2).Interior.Color
[COLOR="SeaGreen"]'[/COLOR]
   For i = 1 To 6 [COLOR="SeaGreen"]'nombre d'itérations (ou de "fourmis"...)[/COLOR]
      Cells(128, 128).Select [COLOR="SeaGreen"]'localisation du départ[/COLOR]
      ol = -1: oc = 0  [COLOR="SeaGreen"]'direction initiale (vers le haut)[/COLOR]
[COLOR="SeaGreen"]'----- Corps du programme -----[/COLOR]
      Do
         With Selection
            k = 1 + 2 * (.Interior.Color = x)
            If ol Then oc = -k * ol: ol = 0 Else ol = k * oc: oc = 0
            .Interior.Color = (x + y + k * (x - y)) / 2
            .Offset(ol, oc).Select
         End With
         With Selection: k = (.Row > 1) And (.Row < 256) And (.Column > 1) And (.Column < 256): End With
      Loop While k
[COLOR="SeaGreen"]'----- ------------------ -----[/COLOR]
   Next i
End Sub[/COLOR]
Pour l'exemple joint : cliquer sur "En route" et... attendre.​
Bonne soirée.
ROGER2327
#1856
 

Pièces jointes

  • Des petites fourmis.xls
    16 KB · Affichages: 166

Staple1600

XLDnaute Barbatruc
Re : [VBA - Amusement] Fourmi de Langton : Quels seraient vos algorithmes ?

Bonsoir Roger, 13GIBE59

Roger: Merci pour ta contribution.

Je suis comblé (ou plutôt ma curiosité vbaiste l'est ;) )

PS: finalement en cherchant bien, on trouve des exemples réalisés sous Excel
(Enfin au moins un, car je n'ai rien trouvé d'autres à part des "jeu de la vie" sous Excel )

Ici une variante
Le site
La fourmilière
Le fichier Excel
http://ww3.ac-poitiers.fr/math/prof/objets/programmes objets/fourmiliere.xlsFichier XLS
 
Dernière édition:

Statistiques des forums

Discussions
311 730
Messages
2 081 991
Membres
101 856
dernier inscrit
Marina40