[Actualité] La possibilité d'une île
par
, 08/05/2017 à 19h18 (2079 Affichages)
Suite du billet précédent.
La lecture du message à l'origine du premier billet m'avait remis en mémoire une brève indication algorithmique trouvée dans un livre paru il y a une vingtaine d'années, et concernant la création de reliefs fractals.
Le processus, très simple à mettre en oeuvre, consistait en la superposition sur un plan horizontal de marches d'escalier aléatoirement positionnées, et de hauteur égale à l'unité. Je n'ai pu remettre la main sur le texte, mais la transposition au triangle ne pose aucune difficulté; c'est l'objet de l'exposé qui suit, avec la description des variantes susceptibles de modifier radicalement l'aspect de l'image obtenue.
# Soit une variable Carte définie comme tableau d'entiers au format LongInt, dont les dimensions maximales correspondent à celles de l'image:
et dont tous les élément utiles ont été initialisés à zéro par les instructions:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 TYPE Tab_LInt = ARRAY[1..Dim_Max, 1..Dim_Max] OF LongInt; VAR Carte: Tab_LInt;
On envisage une série de (N) étapes, au cours desquelles les coordonnées de trois points (A, B, C) du plan (xOy) font l'objet d'un tirage pseudo-aléatoire de densité uniforme, par des instructions du type:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 FOR x:= 1 TO Larg_Image DO FOR y:= 1 TO Haut_Image DO Carte[x, y]:= 0;
On augmente alors de (1) les valeurs de tous les points situés à l'intérieur du triangle (ABC), par le balayage systématique des cases présentes dans le rectangle circonscrit (voir le premier billet).
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 TYPE Point = RECORD x, y: LongInt END; VAR VeA, VeB, VeC, Vmin, Vmax: Point; PROCEDURE TirageABC(VAR V1, V2, V3: Point); VAR i: Byte; Ve: Point; BEGIN FOR i:= 1 TO 3 DO BEGIN Ve.x:= Random(Larg_Image); Inc(Ve.x); Ve.y:= Random(Haut_Image); Inc(Ve.y); CASE i OF 1: V1:= Ve; 2: V2:= Ve; 3: V3:= Ve END END END; TirageABC(VeA, VeB, VeC);
La plus grande valeur obtenue par incrémentation (Zmax) ayant été simultanément déterminée, on définit facilement une échelle de couleurs pour le transfert du pixel correspondant vers le corps de l'image:
Voici ce que donne l'algorithme dans le cas d'images carrées (250x250) et un nombre croissant de tirages, prenant successivement les valeurs:
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 PROCEDURE Init_1_MatIm(Zm, La, Ha: Z_32; VAR C_: Tab_LInt; VAR Ma: Tab_Pix); CONST P000: Pixel = (0, 0, 0); ListeC: ARRAY[0..9] OF Pixel = (( 0, 105, 0), ( 0, 180, 0), ( 0, 255, 0), (170, 255, 0), (255, 255, 0), (255, 170, 0), (210, 165, 0), (165, 165, 165), (210, 210, 210), (255, 255, 255)); VAR i: Byte; x, y, z: Z_32; Kc: Reel; Px: Pixel; BEGIN Kc:= 10 / (Zm + 1); FOR x:= 1 TO La DO FOR y:= 1 TO Ha DO BEGIN z:= C_[x, y]; IF (z>0) THEN BEGIN i:= Trunc(Kc * z); Ma[x, y]:= ListeC[i] END ELSE Ma[x, y]:= P000 END END; Init_1_MatIm(Zmax, Larg_Image, Haut_Image, Carte, Matr_Image);
N1 = 16 , N2 = 256 , N3 = 4096 et N4 = 65536:
Il y a manifestement pour (N) un domaine de valeurs optimales, de l'ordre de quelques centaines à quelques milliers, conduisant à des contours nettement irréguliers et dépourvus de segments rectilignes; par contre un nombre indéfiniment croissant de tirages produit un lissage des frontières, qui représentent à la limite les courbes d'équiprobabilité, pour un triangle quelconque, de contenir un point donné M(x, y).
# Les contours les plus irréguliers s'observant dans la région centrale de l'image, on peut reprendre le tracé en se restreignant au domaine des valeurs les plus élevées [Zmax/2 ; Zmax], par une modification mineure du code:
Les autres données demeurant inchangées, apparaissent les images suivantes:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 FOR x:= 1 TO La DO FOR y:= 1 TO Ha DO BEGIN z:= 2 * C_[x, y]; Dec(z, Zm); IF (z>0) THEN BEGIN i:= Trunc(Kc * z); IF (z<0) THEN i:= 0; Ma[x, y]:= ListeC[i] END ELSE Ma[x, y]:= P000 END
qui montrent, du point de vue de l'irrégularité des contours, une amélioration nette dans le second cas, plus atténuée pour le suivant.