Chapitre 2

Automates Cellulaires

Processus Cognitifs Distribués

Jean-Paul Sansonnet

 

 

1 Principe des Automates Cellulaires

2 Automates à une dimension

3 Le Jeu de la Vie de Conway

4 Automate Autoreproducteur de Langton

 

1 Principe des Automates Cellulaires

• Automates Euclidiens

• Espace substrat des états

Les automates cellulaires ont pour caractéristique de posséder un espace substrat des états qui est muni d'une géométrie. Souvent, cette géométrie est de type euclidien ; on travaille dans un tableau fini, à N dimensions :
    - N = 1 : on a un vecteur,
    - N = 2 : on a une matrice,
    - etc.

On peut imaginer d'autres types de réseaux que le réseau “carré” (on dit aussi Manhattan) ci-dessus

Certains types de voisinages sont équivalents à des réseaux carrés ou bien présentent des dualités entre-eux.

• Types de voisinages dans une matrice

Si on considère un espace euclidien à deux dimensions, i.e. une simple matrice, on eput définir plusieurs types de voisinages pour un point x _ (i, j) de la matrice :
-- des voisinages d'ordre 1 : les cases à une distance de d = 1 d'un point quelconque x _ (i, j),
-- des voisinages d'ordre k > 1 : toutes les cases à une distance d <= k d'un point quelconque x _ (i, j),

Pour un voisinage d'ordre 1 on considère généralement trois types de schémas classiques :

Le voisinage de Moore est l'union du voisinage NEWS (pour North, East, West, South) et du voisinage en croix.

• Fonctions élémentaires d'accès aux voisins

Nous nous plaçons dans le cas d'un espace euclidien borné à N dimensions défini par une liste de bornes de dimensions ld, possédant N éléments. La position d'une case est donnée par une liste d'indices li, possédant N éléments.

On définit les deux fonctions d'accès aux voisins élémentaires : ISucc et IPred. Elles prennent comme arguments li, ld et l'axe a (la dimension sur laquelle on veut accéder à un voisin). Elles renvoient l'adresse du successeur (respectivement du prédécesseur) de la case désignée par li.

Clear[ISucc, IPred] ISucc[li_, ld_, a_, w_: wrap] /; li === w := w ISucc[li_, ld_, a_, w_: wrap] := Module[{lli = li, k = ld [[ a ]], i = li [[ a ]] + 1}, <br />          If[i <= k, lli [[ a ]] = i ; lli, <br />              If[w =!= wrap, w, lli [[ a ]] = Mod[i, k] ; lli]]] <br /> IPred[li_, ld_, a_, w_: wrap] /; li === w := w IPred[li_, ld_, a_, w_: wrap] := Module[{lli = li, k = ld [[ a ]], i = li [[ a ]] - 1}, <br />          If[i >= 1, lli [[ a ]] = i ; lli, <br />              If[w =!= wrap, w, lli [[ a ]] = k - Mod[i, k] ; lli]]]

• Espace euclidien torique

Un argument optionnel w des fonctions IPred et ISucc permet de spécifier la valeur des cases aux bords de l'espace substrat ; si w = wrap alors on considère que l'espace euclidien est torique, i.e. que le successeur de la dernière case d'un axe a est la première case de cet axe (resp. le prédécesseur de la première case est la dernière du même axe).

Dans le cas d'un espace à une dimension, on obtient une topologie en anneau ou k-cycle (ici, k = 8)

En combinant les k-cyles en deux dimensions, on obtient une matrice torique

• Trois voisinages typiques : News, Cross, Moore

A partir des fonctions primitives IPred et ISucc on peut définir les trois fonctions de voisinage typiques : INews, ICross, IMoore :

Clear[INews, ICross, IMoore] INews[li_, ld_, w_: wrap] := <br />      Flatten[Table[{IPred[li, ld, i, w], ISucc[li, ld, i, w]}, {i, Length[li]}], 1] <br /> ICross[li_, ld_, w_: wrap] := {<br />          IPred[IPred[li, ld, 1, w], ld, 2, w], <br />          ISucc[IPred[li, ld, 1, w], ld, 2, w], <br />          IPred[ISucc[li, ld, 1, w], ld, 2, w], <br />          ISucc[ISucc[li, ld, 1, w], ld, 2, w]} <br /> IMoore[li_, ld_, w_: wrap] := <br />      Join[INews[li, ld, w], ICross[li, ld, w]]

Les fonctions de voisinage ci-dessus définissent un champ local autour de la case x _ (i, j)d'adresse li={i,j}. On peut demander, pour un tableau t au point li, les valeurs de ce champ grâce à Fieldvalue

Clear[FieldValue] FieldValue[t_, li_, IFunc_, w_: wrap] := <br />      Map[If[# === w, w, Part[t, Sequence @@ #]] &, IFunc[li, Dimensions[t], w]]

•Fonction d'inversion du champ : WhoHasValue

Inversement, la fonction WhoHasvalue interroge le champ autour d'un case et renvoie la liste des indices des cases qui possèdent une valeur v que l'on spécifie

Clear[WhoHasValue] WhoHasValue[t_, li_, IFunc_, v_, w_: wrap] := <br />          Join @@ Map[If[If[# === w, w, <br />                      Part[t, Sequence @@ #]] === v, {#}, {}] &, IFunc[li, Dimensions[t], w]]

• Accès élémentaires aux voisins

Soit la matrice lettres de dimensions 5 × 5 qui possède comme état initial les valeurs suivantes

lettres = ("a"   "b"   "c"   "d"   "e") ;             "f"   "g"   "h"   "i"   "j"             "k"   "l"   "m"   "n"   "o"             "p"   "q"   "r"   "s"   "t"             "u"   "v"   "w"   "x"   "y"

Exemple 1 : On cherche le prédécesseur de la lettre "l" qui est à l'adresse {3,2} sur la colonne (i.e. selon la dimension 1 de la matrice). On obtient l'indice de l'élément désiré par

i = IPred[{3, 2}, {5, 5}, 1]

{2, 2}

Ensuite, on peut demander la valeur de la case i

lettres [[ Sequence @@ i ]]

g

Exemple 2 : On cherche le successeur en ligne (i.e. selon la dimension 2 de la matrice) de la lettre "o" d'adresse {3,5}. On utilise l'option par défaut (wrap) qui spécifie que la matrice est rebouclée sur elle-même en un tore à deux dimensions

lettres [[ Sequence @@ ISucc[{3, 5}, {5, 5}, 2] ]]

k

• Champ de valeurs sur un voisinage

On peut demander la liste des adresses des voisins de "m" selon une fonction de voisinage comme Moore

IMoore[{3, 3}, {5, 5}]

{{2, 3}, {4, 3}, {3, 2}, {3, 4}, {2, 2}, {2, 4}, {4, 2}, {4, 4}}

Ensuite, il est possible de demander le champ des valeurs assocées à ce voisinage

FieldValue[lettres, {3, 3}, IMoore]

{h, r, l, n, g, i, q, s}

Si on se trouve au bord, on peut utiliser l'option par défaut (wrap) ou bien spécifier la valeur que doit avoir toute case qui se situe hors de la matrice lettres

FieldValue[lettres, {2, 5}, IMoore, "•"]

{e, o, i, •, d, •, n, •}

On voit que trois des cases demandées sont dans le vide.

• Etude d'un processus de lissage : Smooth

• Le processus de lissage : Smooth

Le processus de lissage Smooth est un processus discret. Au temps n+1, il  fait la moyenne des valeurs entre une case x et ses quatre voisines en mode News au temps n. Cela correspond à la formule

x _ (i, j) (n + 1) = 1/2 (   x _ (i, j) (n) + (x _ (i - 1, j - 1) (n) + x _ (i + 1, j) (n) + x _ (i, j - 1) (n) + x _ (i, j + 1) (n))/4)

La fonction Smooth reprend cette formule et l'applique en parallèle à tous les éléments d'un tableau t

Clear[Smooth] Smooth[t_] := MapIndexed[<br />          1/2 ( t [[ Sequence @@ #2 ]] + 1/4 Plus @@ FieldValue[t, #2, INews]) &, <br />          t, {-1}]

Exemple : Une valeur isolée (1) est placée au centre d'un tableau à deux dimensions, nommé pic, contenant une valeur neutre (0)

pic = (0   0   0   0   0   0   0) ;         0   0   0   0   0   0   0         0   0   0   0   0   0   0         0   0   0   1   0   0   0         0   0   0   0   0   0   0         0   0   0   0   0   0   0         0   0   0   0   0   0   0

• Lissage d'un pic

Nous prenons comme condition initiale du processus de lissage Smooth le tableau pic défini plus haut

ListPlot3D[pic] ;

[Graphics:HTMLFiles/index_35.gif]

La fonction de service SmoothTable3D effectue l'affichage en 3 dimensions  de la séquence de tableaux qui constitue la trajectoire du processus Smooth

Clear[SmoothTable3D] SmoothTable3D[lt_, k_, opts___] := MShow[Map[ListPlot3D[#, opts, <br />                  DisplayFunction -> Identity] &, lt], Slicing -> k]

SmoothTable3D[NestList[Smooth, pic, 7], 4, <br />      PlotRange -> {{1, 7}, {1, 7}, {0, 1}}]

[Graphics:HTMLFiles/index_38.gif]

Le pic se répand sur la surface de l'automate comme une tâche d'huile. Au bout d'un certain nombre d'étapes, toutes les cases ont la même valeur.

• Visualisation bidimensionnelle de Smooth

La fonction de service SmoothTable2D effectue l'affichage en 2D de la séquence de tableaux qui constitue la trajectoire du processus Smooth

Clear[SmoothTable2D] SmoothTable2D[lt_, n_: 5] := MShow[Map[ListDensityPlot[1 - #, <br />                  DisplayFunction -> Identity, Frame -> None, Mesh -> False] &, lt], Slicing -> n]

croix = (0   0   0   1   0   0   0) ;           0   0   0   1   0   0   0           0   0   0   1   0   0   0           1   1   1   0   1   1   1           0   0   0   1   0   0   0           0   0   0   1   0   0   0           0   0   0   1   0   0   0

SmoothTable2D[NestList[Smooth, croix, 11], 4]

[Graphics:HTMLFiles/index_42.gif]

•Smooth appliqué  à une CI choisie aléatoirement

On part d'un tableau rempli initialement avec des valeurs aléatoires. Au bout d'un certain temps, on voit apparaître une configuration fixe

SmoothTable2D[l1 = NestList[Smooth, <br />              Array[Random[Integer, 20] &, {5, 5}], 14]]

[Graphics:HTMLFiles/index_44.gif]

Entre deux étapes, il y a conservation de l'énergie globale, c'est juste un déplacement des valeurs sur l'échiquier. Si on calcule la somme des valeurs sur un échiquier elle est constante au cours du processus :

Map[(Plus @@ Flatten[#]) &, l1]

{169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169}

• Image fantôme

En considérant des conditions initiales aléatoires, on constate qu'il apparaît une forme lors de l'affichage

t = Array[Random[Integer, 10] &, {10, 10}] ;

SmoothTable2D[l2 = NestList[Smooth, t, 9], 5]

[Graphics:HTMLFiles/index_49.gif]

SmoothTable3D[l2, 5, Shading -> False]

[Graphics:HTMLFiles/index_51.gif]

L'image vers laquelle converge le processus est assez forte. Cependant, nous savons que le tableau t va évoluer vers une configuration où toutes les cases auront une même valeur. Comment cette image peut-elle se former ? tout devrait être gris ! En fait, la fonction d'affichage utilisée LisDensityPlot est différentielle : elle "étire" les valeurs pour que la plus forte soit noire et la plus faible soit blanche ; au fur et a mesure que la forme se crée, son amplitude diminue (Cf. l'exemple de Sinus^n qui devient carré en diminuant).

• Calcul de la "Dérivée" de Smooth

On calcule de la "dérivée" du processus Smooth i.e. on plote les différences entre les tableaux successifs. On voit que le processus Smooth est qualitativement (i.e. en valeur relative) égal à sa dérivée

MShow[dl2 = Map[With[{l = #}, <br />      ListDensityPlot[MapThread[N[# - #2] &, l, 2], <br />              DisplayFunction -> Identity, Mesh -> False, Frame -> None]] &, <br />              Partition[l2, 2, 1]], Slicing -> 5]

[Graphics:HTMLFiles/index_54.gif]

Le processus dérivé a le même comportement que le processus de lissage Smooth : il tend qualitativement (i.e. en valeur relative) vers une forme stable.

• Application au lissage d'une image

On se donne une image noir et blanc 32 × 32 comme condition initiale

photo = BMBoyHead [[ 1 ]] ; ListDensityPlot[photo, Mesh -> False] ;

[Graphics:HTMLFiles/index_56.gif]

SmoothTable2D[NestList[Smooth, 1 - photo, 8], 3]

[Graphics:HTMLFiles/index_58.gif]

• Problématique de l'évolution d'une population d'habitants bicolores

On considère une zone urbaine vierge où l'on installe deux groupes de population présentant une différence quelconque : un groupe est dit clair et l'autre foncé. Les deux groupes sont mélangés au départ. On considère que les habitants ont le comportement suivant selon la nature de leur voisinage immédiat

  1. Si leur voisinage leur ressemble, ils restent,
  2. Si ils n'ont pas assez de voisins du même groupe, ils déménagent un peu plus loin, là où il y a de la place.

En pratique, on considère une grille où le voisinage d'un habitant est celui de Moore. Le seuil de mobilité est déterminé par un paramètre p, tel que si le nombre de voisins de même groupe n < p alors l'habitant déménage vers une case voisine libre (si il y en a). Le nombre de voisins de Moore étant de 9, et la distribution initiale étant aléatoire entre : les cases vides (état 0) le groupe clair (état 1) et le groupe foncé (état 2), le nombre de voisins du même groupe n que peut espérer un habitant est p = 3.Si ce seuil p n'est pas atteint, il migre.

• Fonction de transition  de la population

La fonction d'évolution de la population travaille sur un voisinage de Moore. On calcule le champ (FieldValue) associé à un habitant et on compte combien il y a d'habitants de même groupe dans ce champ. Si le compte <= p alors on cherche une case vide dans le voisinage de Moore (WhoHasValue[...,0]) et si il y en a on en tire une au sort et on déménage vers cette case.

Clear[PopStep] PopStep[m_, p_: 3] := Module[{m1 = m, l, v, c, nl, nc}, <br />          {nl, nc} = Dimensions[m1] ; <br />      Do[c = m1 [[ i, j ]] ; <br />              Which[<br />                  c === 1, <br />                  l = FieldValue[m1, {i, j}, IMoore] ; <br />                  If[Plus[Count[l, 1]] <= p, <br />                      lv = WhoHasValue[m1, {i, j}, IMoore, 0] ; <br />                      (* Print["1 ", lv] ; *) <br />                      If[lv =!= {}, m1 [[ Sequence @@ Rand[lv] ]] = 1 ; m1 [[ i, j ]] = 0]], <br />                  c === 2, <br />                  l = FieldValue[m1, {i, j}, IMoore] ; <br />                  If[Plus[Count[l, 2]] <= p, <br />                      lv = WhoHasValue[m1, {i, j}, IMoore, 0] ; <br />                      (* Print["2 ", lv] ; *) <br />                      If[lv =!= {}, m1 [[ Sequence @@ Rand[lv] ]] = 2 ; m1 [[ i, j ]] = 0]] <br />             ], {i, 1, nl}, {j, 1, nc}] ; <br />          m1]

• Exemple d'évolution : p = 3

La population initiale est placée dans une zone M1 ayant 5 × 8 cases possibles. Elle est composée de manière aléatoire et équirépartie de case vides (état 0) de cases occupées par un habitant Cyan-clair (état 1) et de cases occupées par un habitant Rouge-foncé (état 2).

M1 = Array[Rand[{0, 1, 2}] &, {10, 16}] ; SeeColors[M1 /. {1 -> 6, 2 -> 7}]

[Graphics:HTMLFiles/index_62.gif]

Le processus de migration des habitants PopStep est itéré 20 fois à partir le la configuration initiale ; On obtient une configuration où les groupes de population se sont fortement regroupés

M30 = Nest[PopStep, M1, 30] ; (* 10 s *)

SeeColors[M30 /. {1 -> 6, 2 -> 7}]

[Graphics:HTMLFiles/index_65.gif]

• Exemples d'évolution : p = 2, p = 4.

Exemple : p = 2. Le regroupement est accéléré (à vérifier )

SeeColors[Nest[PopStep[#, 2] &, M1, 30] /. {1 -> 6, 2 -> 7}]

[Graphics:HTMLFiles/index_67.gif]

Exemple : p = 4. Le regroupement ne se fait pas.

SeeColors[Nest[PopStep[#, 4] &, M1, 30] /. {1 -> 6, 2 -> 7}]

[Graphics:HTMLFiles/index_69.gif]

• Code des fonctions pour les automates

On[General :: spell] ; On[General :: spell1] ;

Clear[ISucc, IPred] ISucc[li_, ld_, a_, w_: wrap] /; li === w := w ISucc[li_, ld_, a_, w_: wrap] := Module[{lli = li, k = ld [[ a ]], i = li [[ a ]] + 1}, <br />          If[i <= k, lli [[ a ]] = i ; lli, <br />              If[w =!= wrap, w, lli [[ a ]] = Mod[i, k] ; lli]]] <br /> IPred[li_, ld_, a_, w_: wrap] /; li === w := w IPred[li_, ld_, a_, w_: wrap] := Module[{lli = li, k = ld [[ a ]], i = li [[ a ]] - 1}, <br />          If[i >= 1, lli [[ a ]] = i ; lli, <br />              If[w =!= wrap, w, lli [[ a ]] = k - Mod[i, k] ; lli]]]

Clear[INews, ICross, IMoore] INews[li_, ld_, w_: wrap] := <br />      Flatten[Table[{IPred[li, ld, i, w], ISucc[li, ld, i, w]}, {i, Length[li]}], 1] <br /> ICross[li_, ld_, w_: wrap] := {<br />          IPred[IPred[li, ld, 1, w], ld, 2, w], <br />          ISucc[IPred[li, ld, 1, w], ld, 2, w], <br />          IPred[ISucc[li, ld, 1, w], ld, 2, w], <br />          ISucc[ISucc[li, ld, 1, w], ld, 2, w]} <br /> IMoore[li_, ld_, w_: wrap] := <br />      Join[INews[li, ld, w], ICross[li, ld, w]]

Clear[FieldValue] FieldValue[t_, li_, IFunc_, w_: wrap] := <br />      Map[If[# === w, w, Part[t, Sequence @@ #]] &, IFunc[li, Dimensions[t], w]]

Clear[WhoHasValue] WhoHasValue[t_, li_, IFunc_, v_, w_: wrap] := <br />          Join @@ Map[If[If[# === w, w, <br />                      Part[t, Sequence @@ #]] === v, {#}, {}] &, IFunc[li, Dimensions[t], w]]

Clear[ColorMap] ColorMap[x_] := Switch[x, 0, White, 1, Cyan, 2, Red]

Clear[SeeColors]      SeeColors[m_, opts___] := (Show[Graphics[RasterArray[<br />                      Map[ColorMap, Reverse[m], {-1}]]], Frame -> True, opts] ;)

Clear[Smooth] Smooth[t_] := MapIndexed[<br />          1/2 ( t [[ Sequence @@ #2 ]] + 1/4 Plus @@ FieldValue[t, #2, INews]) &, <br />          t, {-1}]

Clear[SmoothTable3D] SmoothTable3D[lt_, k_, opts___] := MShow[Map[ListPlot3D[#, opts, <br />                  DisplayFunction -> Identity] &, lt], Slicing -> k]

Clear[SmoothTable2D] SmoothTable2D[lt_, n_: 5] := MShow[Map[ListDensityPlot[1 - #, <br />                  DisplayFunction -> Identity, Frame -> None, Mesh -> False] &, lt], Slicing -> n]

Clear[PopStep] PopStep[m_, p_: 3] := Module[{m1 = m, l, v, c, nl, nc}, <br />          {nl, nc} = Dimensions[m1] ; <br />      Do[c = m1 [[ i, j ]] ; <br />              Which[<br />                  c === 1, <br />                  l = FieldValue[m1, {i, j}, IMoore] ; <br />                  If[Plus[Count[l, 1]] <= p, <br />                      lv = WhoHasValue[m1, {i, j}, IMoore, 0] ; <br />                      (* Print["1 ", lv] ; *) <br />                      If[lv =!= {}, m1 [[ Sequence @@ Rand[lv] ]] = 1 ; m1 [[ i, j ]] = 0]], <br />                  c === 2, <br />                  l = FieldValue[m1, {i, j}, IMoore] ; <br />                  If[Plus[Count[l, 2]] <= p, <br />                      lv = WhoHasValue[m1, {i, j}, IMoore, 0] ; <br />                      (* Print["2 ", lv] ; *) <br />                      If[lv =!= {}, m1 [[ Sequence @@ Rand[lv] ]] = 2 ; m1 [[ i, j ]] = 0]] <br />             ], {i, 1, nl}, {j, 1, nc}] ; <br />          m1]

Off[General :: spell] ; Off[General :: spell1] ;

 

2  Automates à une dimension

• Automates à une dimension et trois entrées

• Automates à une dimension

Un automate linéaire ou à une dimension est composé d'une structure spatiale à une dimension (un vecteur) dont chaque élément possède un état local et d'une fonction de transition locale. Le processus lié à l'automate consiste à itérer la fonction de transition locale en parallèle sur tout le vecteur d'états.

Dans un automate à une dimension, la structure de voisinage est très simple : chaque cellule possède un voisin de gauche et un voisin de droite. Concernant les bords, on peut prendre trois décisions :

Considérer que le vecteur est infini : il n'y a donc pas de bords,

Considérer que le vecteur est de taille finie mais qu'il est organisé en anneau : la dernière case est voisine de la première ; il n'y a donc pas de bord,

Considérer le vecteur tel quel et gérer les singularités aux bords.

• Automates Linéaires Booléens

Les automates linéaires booléens ont des états locaux ϵ {0,1}. La fonction de transition locale prend trois entrées :
    - la valeur s _ i locale,
    - la valeur s _ (i - 1) du voisin de gauche,
    - la valeur s _ (i + 1)du voisin de droite.

Une configuration est donc représentée par un triplet de bits. Il existe donc 2^3 = 8 configurations d'entrée différentes. Une fonction de transition est définie en spécifiant pour chacune de ces 8 entrées l'état résultant € {0,1}. Il y a donc 2^8 combinaisons possibles qui définissent 256 fonctions de transition locales possibles.

Ci-dessus, la fonction n° 90 (soit 01011010 en binaire)

• Définition de la fonction de transition globale

La fonction de transition LinearStep globale sur l'automate L calcule pour chaque état L[[i]] de l'automate, la configuration binaire v en combinant le voisin de gauche, la case courante et le voisin de droite en base 2 :

v = 4 L [[ i - 1 ]] + 2 L [[ i ]] + L [[ i + 1 ]] + 1

{3, 3}

La valeur de la  nouvelle case est donnée par la fonction de transition locale f appliquée à v.

Clear[LinearStep] LinearStep[l_, f_] := Module[{l1 = l, k = Length[l]}, <br />          <br />          (* traitement de la zone régulière *) <br />              Do[<br />                  l1 [[ i ]] = f [[ 4 l [[ i - 1 ]] + 2 l [[ i ]] + l [[ i + 1 ]] + 1 ]], <br />                  {i, 2, k - 1}] ; <br />          <br />          (* traitement des bords *) <br />                  l1 [[ 1 ]] = f [[ 4 l [[ k ]] + 2 l [[ 1 ]] + l [[ 2 ]] + 1 ]] ; <br />                  l1 [[ k ]] = f [[ 4 l [[ k - 1 ]] + 2 l [[ k ]] + l [[ 2 ]] + 1 ]] ; <br />              l1]

Pour la première case et la dernière case, il manque un voisin : on décide qu'il s'agira pour la première case de la dernière et vice versa.

• Fonctions d'affichage des trajectoires

Clear[LinearFunctionTable] LinearFunctionTable[l_, ns_, {p_, q_}] := <br />      MShow[Table[ListDensityPlot[Reverse[1 - NestList[LinearStep[#, IntegerDigits [ i, 2, 8 ]] &, l, ns]], Frame -> False, Mesh -> False, <br />                  DisplayFunction -> Identity], <br />              {i, p, q}], Slicing -> 8]

Clear[LinearCITable] LinearCITable[nf_, ns_, {p_, q_}] := Module[{f = IntegerDigits[nf, 2, 8]}, <br />      MShow[Table[<br />          ListDensityPlot[<br />            Reverse[1 - NestList[LinearStep[#, f] &, IntegerDigits[i, 2, 8], ns]], <br />            Frame -> False, Mesh -> False, DisplayFunction -> Identity], <br />              {i, p, q}], Slicing -> 16]]

• Evolution à partir d'une configuration aléatoire

On construit un automate linéaire L0 de 16 cases ayant pour condition initiale des valeurs aléatoires ϵ {0,1}.

L0 = Array[Rand[{0, 1}] &, {16}]

{0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0}

Les fonctions de transition locales possibles sont numérotés de 0 à 255 i.e. vont de la configuration de trois entrées 000 _ 10 = {0, 0, 0, 0, 0, 0, 0, 0} _ 2 à la configuration 255 _ 10 = {1, 1, 1, 1, 1, 1, 1} _ 2. Pour obtenir la configuration n° i  on peut utiliser l'opérateur IntegerDigits[i, base=2, longueur=8]

f90 = IntegerDigits[90, 2, 8]

{0, 1, 0, 1, 1, 0, 1, 0}

Une fois la fonction choisie et construite, il suffit d'itérer le processus LinearStep n fois sur la condition initiale L0. Comme il s'agit d'un processus discret, on peut utiliser NestList. On obtient une matrice M de n+1 lignes où la ligne k représente l'état de l'automate à l'étape k

M10 = NestList[LinearStep[#, f90] &, L0, 10] ; TableForm[M10, TableSpacing -> {0, 0}]

• Visualisation de la trajectoire de f90

    - La taille de l'automate est de 100 cases,
    - La condition initiale est aléatoire,
    - La fonction locale de transition est f90.
    - La fonction globale de transition est itérée 100 fois.

L = Array[Rand[{0, 1}] &, {100}] ; M = NestList[LinearStep[#, f90] &, L, 100] ;

ListDensityPlot[Reverse[1 - M], <br />      Frame -> False, Mesh -> False] ;

[Graphics:HTMLFiles/index_108.gif]

• Les trajectoires sont circulaires

L'automate linéaire ayant un nombre de cases fini : n ϵ Ν, le nombre total d'états est lui aussi fini et égal à 2^n. Il s'ensuit que la trajectoire du processus doit être circulaire : au bout de k <= 2^n étapes, on doit repasser par une configuration déjà rencontrée.

On utilise un automate de 8 cases qui possède donc 2^8 configurations initiales possibles. Pour chaque configuration initiale, on calcule la longueur de la trajectoire jusqu'à ce qu'on repasse par un état déjà rencontré.

TrajectTable = Map[Module[{L = #, L1 = LinearStep[#, f90], TL = {#}, c = 0}, <br />          While[¬ MemberQ[TL, L1], TL = AppendTo[TL, L1] ; L = L1 ; L1 = LinearStep[L, f90] ; c ++] ; c] &, <br />          Table[IntegerDigits[i, 2, 8], {i, 0, 2^8}]] ;

ListPlot[TrajectTable, Epilog -> {<br />              Text["Fonctions", {229.627, 0.659272}], Text["Longueurs", {24.272, 9.56904}]}] ;

[Graphics:HTMLFiles/index_114.gif]

On voit que la longueur de trajectoire la plus longue (sans repasser par un état déjà parcouru) est de  k =10 étapes, ce qui est très inférieur à la borne théorique : 2^8= 256.

• Trajectoires à partir d'une CI simple

L = Array[0 &, {64}] ; L [[ 32 ]] = 1 ; M = NestList[LinearStep[#, f90] &, L, 30] ; ListDensityPlot[Reverse[1 - M], Frame -> False, AspectRatio -> 1/2] ;

[Graphics:HTMLFiles/index_117.gif]

f250 = IntegerDigits[250, 2, 8] ; L = Array[0 &, {64}] ; L [[ 32 ]] = 1 ; M = NestList[LinearStep[#, f250] &, L, 30] ; ListDensityPlot[Reverse[1 - M], Frame -> False, AspectRatio -> 1/2] ;

[Graphics:HTMLFiles/index_119.gif]

• Evolution des 256 fonctions de transition à partir de la condition initiale {0, 1, 0, 1, 0, 1, 0, 1, ...}

• Table des 256 fonctions de transition

La fonction de service LinearFunctionTable travaille sur un automate linéaire en anneau de 8 cases. Elle prend :

    - une seule condition initiale L,
    - 256 fonctions de transition locales.

C'est la fonction LinearFunctionTable quicalcule les fonctions de transition locales p <= nf < q  et les fait évoluer en itérant ns fois LinearStep sur la condition locale. On obtient une table contenant q-p petites matrices booléennes où chaque petite matrice (de ns lignes et 8 colonnes) est une trajectoire associée à une des q-p fonctions de transition locales.

Clear[LinearFunctionTable] LinearFunctionTable[l_, ns_, {p_, q_}] := <br />      MShow[Table[ListDensityPlot[Reverse[1 - NestList[LinearStep[#, IntegerDigits[i, 2, 8]] &, l, ns]], Frame -> False, Mesh -> False, <br />                  DisplayFunction -> Identity], <br />              {i, p, q}], Slicing -> 8]

Parmi le grand  nombre de conditions initiales possibles (pour 8 cases seulement on a 2^8 = 256) nous avons choisi

L = {0, 1, 0, 1, 0, 1, 0, 1} ;

qui correspond à une distribution homogène de la condition initiale sur l'automate.

• L = {0,1,0,1,0,1,0,1};   Fonctions : 0 .. 63

LinearFunctionTable[L, 10, {0, 63}]

[Graphics:HTMLFiles/index_124.gif]

• L = {0,1,0,1,0,1,0,1};   Fonctions : 64 .. 127

LinearFunctionTable[L, 10, {64, 127}]

[Graphics:HTMLFiles/index_126.gif]

• L = {0,1,0,1,0,1,0,1};    Fonctions : 128 .. 191

LinearFunctionTable[L, 10, {128, 191}]

[Graphics:HTMLFiles/index_128.gif]

• L = {0,1,0,1,0,1,0,1};    Fonctions : 192 .. 255

LinearFunctionTable[L, 10, {192, 255}]

[Graphics:HTMLFiles/index_130.gif]

• Evolution en fonction de conditions initiales

• Evolution en fonction des conditions initiales

La fonction de service LinearCITable prend une seule fonction de transition 0 <= nf < 255 et un automate linéaire en anneau de 8 cases. Elle calcule les configurations initiales allant de p à q et les fait évoluer en itérant ns fois LinearStep. On obtient une table contenant q-p petites matrices booléennes où chaque petite matrice (de ns lignes et 8 colonnes) est une trajectoire associée à une condition initiale.

Clear[LinearCITable] LinearCITable[nf_, ns_, {p_, q_}] := Module[{f = IntegerDigits[nf, 2, 8]}, <br />      MShow[Table[<br />          ListDensityPlot[<br />            Reverse[1 - NestList[LinearStep[#, f] &, IntegerDigits[i, 2, 8], ns]], <br />            Frame -> False, Mesh -> False, DisplayFunction -> Identity], <br />              {i, p, q}], Slicing -> 16]]

Nous avons choisi dans les tables précédentes (portant sur la seule condition initiale {0,1,0,1,0,1,...})des fonctions qui présentent des formes caractéristisques. On constate que pour la très grande majorité des conditions initiales (considérées sur un espace de 8 cases seulement !), les trajectoires exhibent bien qualitativement la même forme. On peut donc dire que chaque fonction de transition a son “caractère” ; certaines fonctions ont plus de caractère que d'autres, au sens où
    - elles exhibent une forme très reconnaissable,
    - elles sont quasi-indépendantes des CIs.

• Fonction = 250;    L = 0 .. 255

LinearCITable[250, 10, {0, 255}]

[Graphics:HTMLFiles/index_133.gif]

• Fonction = 192;    L = 0 .. 255

LinearCITable[192, 10, {0, 255}]

[Graphics:HTMLFiles/index_135.gif]

• Fonction = 80;    L = 0 .. 255

LinearCITable[81, 10, {0, 255}]

[Graphics:HTMLFiles/index_137.gif]

• Fonction = 35;    L = 0 .. 255

LinearCITable[35, 10, {0, 255}]

[Graphics:HTMLFiles/index_139.gif]

• Espace des phases pour un automate à 8 cases

Considérons un automate à une dimension possédant 8 cases rebouclées, à 3 entrées. L'espace des phases global est l'ensemble de tous les états possibles. Il est fonction de :
-- la taille de l'automate : 8 cases => 256 états,
-- le nombre max d'itérations non circulaires : 256,
-- que multiplie le nombre de fonction à 3 entrées : 256.

Le nombre total de bits nécessaires à l'exploration exhaustive de ce processus est de 16 Méga bits, ce qui peut loger en mémoire d'un ordinateur moderne.

• Analyse des comportements observés

Faute d'avoir pu effectuer l'exploration exhaustive de l'espace des phase global associé à un automate à une dimension possédant 8 cases rebouclées, et une fonction de transition locale à 3 entrées, nous avons effectué deux types d'expérimentations :
-- faire varier les fonctions de transition pour un CI fixée,
-- faire varier les CIs pour une fonction de transition fixée.

On observe que la variation des fonctions de transition produit des comportements :
-- assez caractéristiques (ayant une forme décrivable),
-- classables en catégories (comportement quasi équivalents).

On observe que la variation des CIs produit des comportements relativement homogènes, qui semblent caractéristiques de la fonction de transition fixée. Il ressort de tout ceci que les comportements observés sont plus le fait des fonctions de transition que des CIs choisies.

• Interprétation en termes sociobiologiques

Nous pouvons essayer de nous servir de ce phénomène pour en tirer une interprétation portant sur des créatures vivantes possédant un génotype (l'inné) et qui sont plongées dans une culture, dans un environnement (l'acquis).

Deux interprétations complétement opposées de ce schéma sont possibles :

Interprétation 1 : fonction = gènes, CIs = environnement

On considère que la fonction de transition est le "caractère" de la créature et que les CIs correspondent aux conditions contingentes de sa naissance. On en conclut que le caractère l'emporte sur l'environnement de naissance, i.e. que l'inné est plus fort que l'acquis.

Interprétation 2 : fonction = environnement, CIs = gènes

On considère que la fonction de transition est le moteur environnemental (culturel) qui va façonner la créature à partir d'une donnée initiale : son phénotype propre, issu de ses gènes qui correspondent aux CIs. On en conclut que le modelage environnemental l'emporte sur le phénotype propre, i.e. que l'acquis est plus fort que l'inné.

Moralité : le modèle est neutre !

 

3 Le Jeu de la Vie de Conway

Le modèle de J. Conway

Principe du Jeu de la Vie

En 1974, J. Conway a proposé un automate cellulaire dont le fonctionnement est très simple mais dont la richesse des comportements et la puissance de calcul formel étonnent encore.

Le jeu de la Vie fonctionne sur une matrice booléenne (les valeurs d'une case ϵ {0,1}) rebouclée en tore à deux dimensions (il n'y a pas de bords). On part d'une configuration initiale aléatoire ou bien ad hoc et on itére le processus suivant :

Soit s _ (i, j)(t) l'état de la case s _ (i, j). On calcule le nombre v de voisins à 1 dans le voisinage de Moore (8 voisins) de celle case. L'état s _ (i, j)(t+1) est définit par :
    - si v = 2 : s _ (i, j)(t),
    - si v = 3 : 1
    - sinon : 0.

Intuitivement, dans une vision PPSN, cela correspond à la modélisation du comportement naturel suivant :
-- Si une cellule est à 0 et qu'elle est entourée de 3 voisins elle “naît”
-- Si une cellule est à 1, elle reste à 1 si elle possède 2 ou  3 voisins à 1. Dans les autres cas, elle “meurt” d'isolement
      (0 voisin à 1) ou d'étouffement (4, 5, 6, 7, 8 voisins à 1).

• Construction de la matrice du jeu de la Vie

La fonction de service MakeRandLife construit une matrice initialisée avec des valeurs {0,1} choisies aléatoirement. Elle laisse tout autour de la matrice, une bordure d'épaisseur une-case remplie de valeurs 0.

Clear[MakeRandLife] MakeRandLife[nl_, nc_] := Module[{m = Array[0 &, {nl, nc}]}, <br />          Do[m[[i, j]] = Rand[{0, 1}], {i, 2, nl - 1}, {j, 2, nl - 1}] ; m]

MatrixForm[MakeRandLife[6, 6]]

( 0   0   0   0   0   0 )    0   1   1   0   1   0    0   1   1   1   0   0    0   1   0   0   1   0    0   0   0   1   1   0    0   0   0   0   0   0

Dans notre implémentation, cette bordure permet de ne pas tenir compte des bords ce qui simplifie et accélère la fonction LifeStep qui effectue une transition du processus sur une matrice m

Clear[LifeStep] LifeStep[m_] := Module[{m1 = m, nl, nc, v}, <br />          {nl, nc} = Dimensions[m] ; <br />          Do[v = Plus[<br />                      m [[ i - 1, j - 1 ]], m [[ i - 1, j ]], m [[ i - 1, j + 1 ]], <br />                      m [[ i, j - 1 ]], m [[ i, j + 1 ]], <br />                      m [[ i + 1, j - 1 ]], m [[ i + 1, j ]], m [[ i + 1, j + 1 ]]] ; <br />              m1 [[ i, j ]] = Switch[v, 2, m1 [[ i, j ]], 3, 1, _, 0] <br />             , {i, 2, nl - 1}, {j, 2, nc - 1}] ; <br />          m1]

• Exécution du jeu de la Vie

La fonction de service LifeTable permet de visualiser les différentes étapes du jeu de la vie sous forme d'une table de matrices

Clear[LifeTable]      LifeTable[m_, k_, s_, opts___] := MShow[<br />          ListDensityPlot[Reverse[1 - #], opts, AspectRatio -> 1, Frame -> False, DisplayFunction -> Identity] & /@ NestList[LifeStep, m, k], Slicing -> s] ;

LifeTable[MakeRandLife[6, 6], 4, 5]

[Graphics:HTMLFiles/index_152.gif]

LifeTable[MakeRandLife[11, 11], 23, 8]

[Graphics:HTMLFiles/index_154.gif]

• Exemples de trajectoires

Dancs ces exemples, on constate que l'évolution converge vers certaines configurations qui sont stables : ce sont des attracteurs de la dynamique du jeu de la Vie.

LifeTable[MakeRandLife[11, 11], 20, 7]

[Graphics:HTMLFiles/index_156.gif]

LifeTable[MakeRandLife[11, 11], 20, 7]

[Graphics:HTMLFiles/index_158.gif]

• Exemples de patterns typiques du jeu de la vie

• Patterns  typiques : états fixes

Ce pattern évolue vers un état stable : un carré

LifeTable[(0   0   0   0   0   0), 3, 4]             0   1   1   0   0   0             0   1   0   0   0   0             0   0   0   0   0   0             0   0   0   0   0   0             0   0   0   0   0   0

Syntax :: sntxi :  Incomplete expression; more input is needed. \" \"

[Graphics:HTMLFiles/index_161.gif]

Ce pattern évolue aussi vers un état stable : rond ou nid d'abeille

LifeTable[(0   0   0   0   0   0), 4, 5]             0   0   0   0   0   0             0   0   0   1   0   0             0   1   1   1   0   0             0   0   0   0   0   0             0   0   0   0   0   0

[Graphics:HTMLFiles/index_163.gif]

• Patterns  typiques : clignotants

Ce pattern évolue vers un cycle de période 2. On appelle ce type de patterns des clignotants

LifeTable[(0   0   0   0   0   0), 3, 4]             0   0   1   0   0   0             0   0   1   0   0   0             0   0   1   0   0   0             0   0   0   0   0   0             0   0   0   0   0   0

[Graphics:HTMLFiles/index_165.gif]

LifeTable[(0   0   0   0   0   0), 3, 4]             0   0   0   1   0   0             0   0   1   0   1   0             0   0   0   0   0   0             0   0   0   1   0   0             0   0   0   0   0   0

[Graphics:HTMLFiles/index_167.gif]

• Gliders

Un glider est un pattern qui a et n'a pas de période. En fait sa forme a une période 4 mais elle se trouve translatée d'une case à droite et d'une case en bas.Ce déplacement linéaire en diagonale fait que ce pattern, placé sur une matrice infinie, possède une période infinie. Le pattern d'un glider est défini par :

Glider1 = (1   0   0) ;             0   1   1             1   1   0

La fonction de service PatternCopy permet de copier un pattern sur une matrice plus vaste

Clear[PatternCopy] PatternCopy[m_, p_, {i_, j_}] := Module[{m1 = m}, <br />          MapIndexed[(m1 [[ #2 [[ 1 ]] + i, #2 [[ 2 ]] + j ]] = #) &, p, {-1}] ; m1]

LifeTable[PatternCopy[Array[0 &, {11, 11}], <br />          Glider1, {1, 1}], 7, 4]

[Graphics:HTMLFiles/index_171.gif]

• Un autre Glider de quasi-période 4

Glider2 = (0   1   0) ;             0   0   1             1   1   1

LifeTable[PatternCopy[Array[0 &, {11, 11}], <br />          Glider2, {1, 1}], 7, 4]

[Graphics:HTMLFiles/index_174.gif]

• Canon à Gliders

• Le pattern : Glider Gun

On peut construire des configurations qui ont des comportements non triviaux : par exemple le "canon à gliders” ci-dessous est une configuration qui possède une quasi-période longue de 30 cycles et qui produit un glider. Ce glider se déplace et peut être vu comme "éjecté" du canon

GliderGun = (1   1   0   0   0   1   1   0   0) ;               0   1   1   1   1   1   0   0   0               0   1   1   0   1   1   0   0   0               0   1   1   0   1   1   0   0   0               0   0   1   1   1   0   0   0   0               0   0   0   0   0   0   0   0   0               0   0   0   0   0   0   0   0   0               0   0   0   0   0   0   0   0   0               0   0   0   0   0   0   0   0   0               0   0   0   0   1   1   1   0   0               0   0   0   0   1   1   1   0   0               0   0   0   1   0   0   0   1   0               0   0   1   0   0   0   0   0   1               0   0   0   1   0   0   0   1   0               0   0   0   0   1   1   1   0   0

LifeTable[GliderGun, 0, 1, AspectRatio -> 2]

[Graphics:HTMLFiles/index_177.gif]

• Exécution du canon à gliders

LifeTable[PatternCopy[Array[0 &, {41, 21}], GliderGun, {12, 3}], 39, 10, <br />      Mesh -> False, AspectRatio -> 2] (* + 60 *)

[Graphics:HTMLFiles/index_179.gif]

On constate que la configuration 30 (première à gauche de la ligne du bas) est égale à la configuration de départ 0 (première à gauche de la ligne du haut), à ceci près qu'elle a émis deux scories (deux nids d'abeilles fixes) et un glider que l'on voit planer vers le nord-est (configurations  31 à 39 ... etc.) alors que le canon reprend une phase de 30 cycles qui produira un nouveau glider.

• Pattern : Eater

La configuration connue sous le nom de Eater (mangeur) possède une période 15 Cycles. Elle peut entrer en collision avec un glider et le détruire sans être pour autant elle-même perturbée.

Eater = (0   1   0) ;           0   1   0           1   0   1           0   1   0           0   1   0           0   1   0           0   1   0           1   0   1           0   1   0           0   1   0

M1 = PatternCopy[Array[0 &, {18, 11}], Eater, {4, 4}] ; LifeTable[M1, 0, 1, AspectRatio -> 3/2]

[Graphics:HTMLFiles/index_182.gif]

• Visualisation de la trajectoire d'un Eater

La configuration Eater possède une période de 15 cycles. Elle passe par 14 formes différentes très caractéristiques :

LifeTable[M1, 15, 6, AspectRatio -> 3/2, Mesh -> False]

[Graphics:HTMLFiles/index_184.gif]

• Construction d'une situation de eating

On construit une situation (bien synchronisée !) où le glider éjecté arrive près d'un eater dans la position relative suivante

Le type de Glider éjecté par un canon à gliders peut prendre à un moment donné la forme suivante

Glider3 = (1   1   0) ;             0   1   1             1   0   0

•Eating d'un glider envoyé par un canon

M2 = PatternCopy[PatternCopy[<br />    Array[0 &, {35, 20}], M1, {6, 5}], Glider3, {26, 8}] ;    LifeTable[M2, 0, 1, AspectRatio -> 35/20]

[Graphics:HTMLFiles/index_188.gif]

LifeTable[M2, 17, 6, AspectRatio -> 1, Mesh -> False]

[Graphics:HTMLFiles/index_190.gif]

Le Eater a mangé le glider et a repris sa forme initiale.

•Fonctions du jeu de la vie

Clear[MakeRandLife] MakeRandLife[nl_, nc_] := Module[{m = Array[0 &, {nl, nc}]}, <br />          Do[m[[i, j]] = Rand[{0, 1}], {i, 2, nl - 1}, {j, 2, nl - 1}] ; m]

Clear[PatternCopy] PatternCopy[m_, p_, {i_, j_}] := Module[{m1 = m}, <br />          MapIndexed[(m1 [[ #2 [[ 1 ]] + i, #2 [[ 2 ]] + j ]] = #) &, p, {-1}] ; m1]

Clear[LifeStep] LifeStep[m_] := Module[{m1 = m, nl, nc, v}, <br />          {nl, nc} = Dimensions[m] ; <br />          Do[v = Plus[<br />                      m [[ i - 1, j - 1 ]], m [[ i - 1, j ]], m [[ i - 1, j + 1 ]], <br />                      m [[ i, j - 1 ]], m [[ i, j + 1 ]], <br />                      m [[ i + 1, j - 1 ]], m [[ i + 1, j ]], m [[ i + 1, j + 1 ]]] ; <br />              m1 [[ i, j ]] = Switch[v, 2, m1 [[ i, j ]], 3, 1, _, 0] <br />             , {i, 2, nl - 1}, {j, 2, nc - 1}] ; <br />          m1]

Clear[LifeTable]      LifeTable[m_, k_, s_, opts___] := MShow[<br />          ListDensityPlot[Reverse[1 - #], opts, AspectRatio -> 1, Frame -> False, DisplayFunction -> Identity] & /@ NestList[LifeStep, m, k], Slicing -> s] ;

 

4 Automate Autoreproducteur de Langton

• Présentation de l'automate de C. Langton

• Le concept d'automate autoreproducteur de Von Neumann

Au début des années 50, John Von Neumann a étudié le problème de l'autoreproduction des automates cellulaires. Il s'agit de construire un automate cellulaire capable de reproduire la forme initiale qu'il possède sur sa matrice cellulaire. Cette forme initiale est formée de l'image des états internes de l'automate. John Von Neumann a découvert un automate à 29 états qui possède cette propriété mais sa table de transition est d'une complexité extrême.

En 1984, C. Langton a proposé un automate cellulaire capable de se reproduire et ne possédant que 8 états internes : 0, 1, 2, 3, 4, 5, 7. Dans les années 80, cet automate est devenu le fer de lance de l'école "Artificial Life" auquel il a servi de paradigme (depuis, Byl a proposé une version ayant moins d'états mais elle est moins "lisible").

L'automate de Langton est un système dynamique discret : Le temps se déroule en étapes énumérables : à chaque nouvelle étape n+1 correspond une nouvelle matrice M[n+1] = LF[M[n]] où LF est la fonction de transition spécifique à l'automate de Langton.

• Forme initiale de l'automate de Langton

La forme initiale de l'automate de Langton est donnée par la matrice 10 ×15 d'états suivante

Langton = (0   2   2   2   2   2   2   2   2   0   0   0   0   0   0) ;             2   1   7   0   1   4   0   1   4   2   0   0   0   0   0             2   0   2   2   2   2   2   2   0   2   0   0   0   0   0             2   7   2   0   0   0   0   2   1   2   0   0   0   0   0             2   1   2   0   0   0   0   2   1   2   0   0   0   0   0             2   0   2   0   0   0   0   2   1   2   0   0   0   0   0             2   7   2   0   0   0   0   2   1   2   0   0   0   0   0             2   1   2   2   2   2   2   2   1   2   2   2   2   2   0             2   0   7   1   0   7   1   0   7   1   1   1   1   1   2             0   2   2   2   2   2   2   2   2   2   2   2   2   2   0

Afin de pouvoir mieux visualiser la forme définie par cette matrice, on construit des fonctions de service : SeeStates, SeeGray et SeeColors

SeeStates[Langton, "."]

. 2 2 2 2 2 2 2 2 . . . . . .
2 1 7 . 1 4 . 1 4 2 . . . . .
2 . 2 2 2 2 2 2 . 2 . . . . .
2 7 2 . . . . 2 1 2 . . . . .
2 1 2 . . . . 2 1 2 . . . . .
2 . 2 . . . . 2 1 2 . . . . .
2 7 2 . . . . 2 1 2 . . . . .
2 1 2 2 2 2 2 2 1 2 2 2 2 2 .
2 . 7 1 . 7 1 . 7 1 1 1 1 1 2
. 2 2 2 2 2 2 2 2 2 2 2 2 2 .

Les états ayant pour valeur 0 sont représentés par des "."

• Fonctions d'affichages : SeeStates, SeeGray, SeeColors

Clear[ColorMap] ColorMap[x_] := Switch[x, <br />          0, White, 1, Blue, 2, Black, 3, Magenta, 4, Green, 5, Grass, 6, Cyan, 7, Red]

Clear[SeeStates, SeeGray, SeeColors]      SeeStates[m_, zero_: ""] := TableForm[m /. {0 -> zero}, TableSpacing -> {0, 0}]      SeeGray[m_, opts___] := (ListDensityPlot[Reverse[7 - m], Mesh -> False, opts] ;)      SeeColors[m_, opts___] := (Show[Graphics[RasterArray[<br />                      Map[ColorMap, Reverse[m], {-1}]]], opts] ;)

• Construction de l'automate cellulaire de Langton

Pour définir l'automate cellulaire proprement dit, il faut placer la forme initiale Langton sur une matrice plus vaste où les états ont pour valeur par défaut 0. cela est fait par la fonction MakeLangton qui construit une matrice nl × nc et recopie la forme Langton en i,j.

Clear[MakeLangton] MakeLangton[nl_, nc_, i_, j_] := Module[{t = Array[0 &, {nl, nc}]}, <br />          MapIndexed[(t [[ #2 [[ 1 ]] + i, #2 [[ 2 ]] + j ]] = #) &, Langton, {-1}] ; t]

Nous construisons l'état initial de l'automate : M1

M1 = MakeLangton[16, 32, 5, 1] ; SeeColors[M1, AspectRatio -> 1/2, Frame -> True]

[Graphics:HTMLFiles/index_202.gif]

La matrice cellulaire M1 est plus grande que Langton pour laisser de la place afin que la forme puisse se reproduire (à droite). Les états sont représentés par des niveaux de gris allant de 0 (blanc) à 7 (noir).

• Visualisation  tridimensionnelle  de l'automate

On peut donner un peu de vie à la forme de Langton en la “gauffrant" sur une surface en papier. Ceci se fait grâce à la fonction ListPlot3D

ListPlot3D[Reverse[MakeLangton[16, 20, 2, 2]], ViewPoint -> {0.952, -2.558, 2.000}] ;

[Graphics:HTMLFiles/index_204.gif]

Les pics correspondent à la présence de l'état 7. On remarque clairement le rôle de “tuyau“ ou de “mur” joué par l'état 2.

• La fonction de Transition de l'automate de Langton

• La Fonction de Transition  de Langton

La fonction de Transition de l'automate de langton, LangtonFunction, est de type classique : Pour un élément m _ (i, j)(t) de la matrice cellulaire à l'instant t, la valeur de cet élément à l'instant t+1 est calculé en fonction de la valeur v de cet élément à l'instant t et des valeurs des 4 voisins (voisinage NEWS) à l'instant t.

La fonction de transition est construite à partir d'une table de transition, appelée LangtonTable, qui est de la forme :

LangtonTable = {<br />      {liste des configurations (v, n, e, s, w) -> état 1}, <br />      {liste des configurations (v, n, e, s, w) -> état 2}, <br />          ... <br />      {liste des configurations (v, n, e, s, w) -> état 7} <br />     } (* * sinon l ' état est 0 **)

Clear[LangtonFunction] Do[Map[(LangtonFunction[#] = i) &, LangtonTable [[ i ]]], {i, Length[LangtonTable]}] ; LangtonFunction[_] := 0

• Une étape de Langton

La fonction LangtonStep effectue un seul pas discret de calcul. A partir d'une matrice m, elle fournit la matrice à l'instant suivant en appliquant à chaque élément de m la fonction de transition

Clear[LangtonStep] LangtonStep[m_] := Module[{m1 = m, a, b, c, x, v, n, e, w, s, nl, nc}, <br />          {nl, nc} = Dimensions[m] ; <br />          Do[v = m1 [[ i, j ]] ; <br />              n = m [[ i - 1, j ]] ;      s = m [[ i + 1, j ]] ; <br />              e = m [[ i, j + 1 ]] ;      w = m [[ i, j - 1 ]] ; <br />              If[{v, n, s, e, w} === {0, 0, 0, 0, 0}, m1 [[ i, j ]] = 0, <br />                  a = 1000 s + 100 w + 10 n + e ; b = 1000 w + 100 n + 10 e + s ; <br />                  c = 1000 n + 100 e + 10 s + w ; x = 1000 e + 100 s + 10 w + n ; <br />              If[a > x, x = a] ; If[b > x, x = b] ; If[c > x, x = c] ; <br />                  m1 [[ i, j ]] = LangtonFunction[10000 v + x]] <br />             , {i, 2, nl - 1}, {j, 2, nc - 1}] ; <br />          m1]

Cette fonction est optimisée de deux manières :

Pour accélérer notablement les calculs, on teste et on traite à part la configuration par défaut :
{v, n, s, e, w} === {0, 0, 0, 0, 0},

Pour éviter que la table de transition ne soit trop grande, on tire profit des symétries (a, b, c) de la configuration
x = news.

• Exemples d'exécutions

• Les 8 premières étapes de Langton

l = NestList[LangtonStep, M1, 8] ;

TableForm[Partition[SeeStates /@ l, 3], TableSpacing -> {0, 1}]

2 2 2 2 2 2 2 2
2 1 7 1 4 1 4 2
2 2 2 2 2 2 2 2
2 7 2 2 1 2
2 1 2 2 1 2
2 2 2 1 2
2 7 2 2 1 2
2 1 2 2 2 2 2 2 1 2 2 2 2 2
2 7 1 7 1 7 1 1 1 1 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 3
2 7 1 4 1 4 2
2 1 2 2 2 2 2 2 1 2
2 2 2 1 2
2 7 2 2 1 2
2 1 2 2 1 2
2 2 2 1 2
2 7 2 2 2 2 2 2 7 2 2 2 2 2
2 1 7 1 7 1 7 1 1 1 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
2 1 4 1 4 1 2
2 7 2 2 2 2 2 2 1 2
2 1 2 2 1 2
2 2 2 1 2
2 7 2 2 1 2
2 1 2 2 7 2
2 2 2 2 2 2 2 2 2 2 2 2
2 7 1 7 1 7 1 7 1 1 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
2 1 4 1 4 1 1 2
2 2 2 2 2 2 2 1 2
2 7 2 2 1 2
2 1 2 2 1 2
2 2 2 7 2
2 7 2 2 2
2 1 2 2 2 2 2 2 1 2 2 2 2 2
2 7 1 7 1 7 1 7 1 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
2 4 1 4 1 1 1 2
2 1 2 2 2 2 2 2 1 2
2 2 2 1 2
2 7 2 2 7 2
2 1 2 2 2
2 2 2 1 2
2 7 2 2 2 2 2 2 7 2 2 2 2 2
2 1 7 1 7 1 7 1 7 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
3 1 4 1 1 1 1 2
2 4 2 2 2 2 2 2 1 2
2 1 2 2 7 2
2 2 2 2
2 7 2 2 1 2
2 1 2 2 7 2
2 2 2 2 2 2 2 2 2 2 2 2
2 7 1 7 1 7 1 7 1 7 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
2 1 4 1 1 1 1 1 2
2 2 2 2 2 2 2 7 2
2 4 2 2 2
2 1 2 2 1 2
2 2 2 7 2
2 7 2 2 2
2 1 2 2 2 2 2 2 1 2 2 2 2 2
2 7 1 7 1 7 1 7 1 1 1
2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
2 4 1 1 1 1 1 7 2
2 1 2 2 2 2 2 2 2
2 2 2 1 2
2 4 2 2 7 2
2 1 2 2 2
2 2 2 1 2
2 7 2 2 2 2 2 2 7 2 2 2 2 2 2
2 1 7 1 7 1 7 1 7 1 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2
3 1 1 1 1 1 7 2
2 4 2 2 2 2 2 2 1 2
2 1 2 2 7 2
2 2 2 2
2 4 2 2 1 2
2 1 2 2 7 2
2 2 2 2 2 2 2 2 2 2 2 2 2
2 7 1 7 1 7 1 7 1 7 1 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2

• Une reproduction complète de Langton

Il faut 150 étapes pour que l'automate de langton se reproduise complètement

M150 = Nest[LangtonStep, M1, 150] ; (* + 60 s *)

SeeColors[M150, AspectRatio -> 1/2, Frame -> True]

[Graphics:HTMLFiles/index_216.gif]

On obtient deux formes égales, en rotation par rapport à la forme initiale qui donneront 2 nouvelles formes au bout de 150 étapes etc.

• Deux reproductions successives de Langton

On se donne une arène M2, un peu plus grande. Il faut 300 étapes environ pour obtenir 2 reproductions soit 4 formes

M2 = MakeLangton[30, 45, 19, 7] ;

SeeColors[M2, Frame -> True, AspectRatio -> 30/45]

[Graphics:HTMLFiles/index_219.gif]

M300 = Nest[LangtonStep, M2, 300] ; (* + 131 s *)

SeeColors[M300, Frame -> True, AspectRatio -> 30/45]

[Graphics:HTMLFiles/index_222.gif]

• La table de transition de Langton

LangtonTable = {<br /> (* * 1 **) {<br /> 07214, 04421, 07252, 04321, 07721, 04221, 07521, 07512, 06251, 07212, 07000, 06212, <br /> 07221, 07621, 03212, 04212, 11000, 15100, 11010, 16212, 11100, 13221, 16112, 11110, <br /> 12221, 12120, 12111, 12210, 13212, 12100, 15112, 16000, 15122, 12211, 12121, 12001, <br /> 26112, 23202, 25520, 27000, <br /> 34000, 35102, 34200, 32010, <br /> 42220, 43220, <br /> 63121, 62000, 61000, <br /> 72220, 75022, 73202}, <br /> (* * 2 **) {<br /> 02100, 07002, 01100, 02001, 06200, 03202, 07200, 06002, 02010, 03001, 01000, 05220, <br /> 15211, <br /> 24002, 24220, 25120, 22011, 22201, 27200, 22010, 27420, 27222, 26220, 25200, 24122, <br /> 27221, 25210, 27206, 27122, 24203, 22211, 27220, 27720, 24221, 21000, 24201, 24000, <br /> 27201, 22001, 22020, 22100, 23020, 23002, 25020, 26002, 27120, 24422, 22120, 22221, <br /> 25021, 26122, 22210, 23120, 27722, 22000, 22220, 25001, 27022, 26224, 26221, 25221, <br /> 24202, 27202, 25024, 22200, 25502, 25220, 27002, 27622, 26202, <br /> 32000, 36200, <br /> 54212, 52020, 57212, 52120, 52000, 55021, 57002, 53002, 52121, 57202}, <br /> (* * 3 **) {<br /> 06000, <br /> 16022, <br /> 27020, 24200, <br /> 31000, 32001}, <br /> (* * 4 **) {<br /> 14112, 14002, 16402, 14202, 14122, 14222, 14322, 14022, 14212, 14012, 14232, <br /> 54022}, <br /> (* * 5 **) {<br /> 02120, 05200, 05212, 07251, <br /> 17252, 15242, <br /> 27205, 27005, <br /> 52100, 52200, <br /> 62121, 62221, <br /> 75202}, <br /> (* * 6 **) {<br /> 12020, 16202, <br /> 23220, 23200, 23210, <br /> 37000, <br /> 43202}, <br /> (* * 7 **) {<br /> 17212, 13202, 15422, 17222, 17022, 16242, 17002, 17122, 17012, 15420, 17232, 17202, 17026, 17000, 17112, <br /> 25100, <br /> 77000}} ; (* * sinon 0 **)

 


Retour