IFS Fraktali v Mathematici

Andrej Bauer

To so stari zapiski iz leta 2008. Od tedaj se je v Mathematici marsikaj posodobilo, v osnovi pa še vedno vse deluje.

Dvodimenzionalni grafični elementi

Osnovni dvodimenzionalni elementi v Mathematici so:

Point[{x,y}]				točka s koordinatama (x,y)
Line[{{(Subscript[x, 1]),(Subscript[y, 1])},…,{(Subscript[x, n]),(Subscript[y, n])}}]		lomljena črta skozi točke ((Subscript[x, 1]),(Subscript[y, 1])),…,((Subscript[x, n]),(Subscript[y, n]))
Circle[{x,y},r]				krožnica s središčem (x,y) in polmerom r
Circle[{x,y},(Subscript[r, 1]),(Subscript[r, 2])]			elipsa s središčem (x,y) in polmeroma (Subscript[r, 1]) in (Subscript[r, 2])
Disk[{x,y},r]				krog s središčem (x,y) in polmerom r
Disk[{x,y},(Subscript[r, 1]),(Subscript[r, 2])]			polna elipsa s središčem (x,y) in polmeroma (Subscript[r, 1]) in (Subscript[r, 2])
Polygon[{{(Subscript[x, 1]),(Subscript[y, 1])},…,{(Subscript[x, n]),(Subscript[y, n])}}]	poligon z oglišči ((Subscript[x, 1]),(Subscript[y, 1])),…,((Subscript[x, n]),(Subscript[y, n]))
Rectangle[{(Subscript[x, 1]),(Subscript[y, 1])},{(Subscript[x, 2]),(Subscript[y, 2])}]		pravokotnik z nasprotnima ogliščema ((Subscript[x, 1]),(Subscript[y, 1])) in ((Subscript[x, 2]),(Subscript[y, 2]))
Text[t,{x,y}]				besedilo t s koordinatami (x,y)

Poleg osnovnih elemntov imamo še elemente, s katerimi nadzorujemo barve, debeline črt ipd. Naštejmo nekaj takih elementov:

RGBColor[r,g,b]		nastavi trenutno barvo na barvo z RGB komponentami r, g in b
Hue[h,s,v]			nastavi trenutno barvo na barvo s HSV komponentami h, s in v
Hue[h]				nastavi trenutno barvo na barvo h
AbsolutePointSize[r]		nastavi premer točke na d
PointSize[r]			nastavi premer točke na r-ti delež širine slike
AbsoluteThickness[t]		nastavi debelino črt na t
Thickness[r]			nastavi debelino črte na r-ti delež širine slike

Dvodimnzionalna slika je predstavljena z izrazom oblike

Graphics[{(Subscript[e, 1]),…,(Subscript[e, n])}]

kjer so (Subscript[e, 1]),…,(Subscript[e, n]) grafični elementi, ki opisujejo sliko. Izrazi (Subscript[e, i]) so lahko tudi poljubno vgnezdeni seznami, ki vsebujejo grafične elemente. Sliko prikažemo z ukazom Show. Narišimo sliko, ki vsebuje črn kvadrat in rdeč krog v kvadratu:

abstraktnaSlika =Graphics[{Rectangle[{-2,-2},{2,2}], RGBColor[1,0,0],Disk[{0,0},1]}]

Pa še ena malo bolj kičasta slika:

psiho=Graphics[Table[{Hue[h],Disk[{0,0},h]},{h,1,0,-0.01}]]

Sliko lahko z ukazom Export shranimo v datoteko, v enem od mnogih formatov (GIF, JPG, Encapsulated Postscript, PDF,…):

??Export

Export["~/Desktop/psiho.pdf", psiho]

Še en primer uporabe ukaza Export:

pic = Plot3D[Sin[Sqrt[x^2+y^2]], {x,-8,8},{y,-8,8},Mesh->False]

Export["~/Desktop/graf3d.eps",pic,"EPS"]

Ukaz Manipulate

Ukaz Manipulate je novost v Mathematici 6.0. Z njim lahko naredimo preproste animacije ali slike, ki so odvisne od parametrov.

Manipulate[Plot[Sin[a x + b], {x, -Pi, Pi}], {a,-5,5},{b,-5,5}]

Prikažemo lahko poljubno sliko, tudi 3D.

Manipulate[Plot3D[Sin[Sqrt[a x^2+y^2]],{x,-5,5},{y,-5,5}],{a,0,10}]

Kupiti bo treba hitrejši računalnik...

Fraktali

Afine transformacije

Afina transformacija ravnine je taka preslikava ravnine, ki slika premice v premice. Vsaka afina transformacija je kompizicija linearne preslikave in translacije, kar zapišemo kot množenje z matriko a in translacijo za vektor t:

ClearAll[afina]
afina[a_,t_][{x_,y_}]:=a . {x,y} + t

Definirajmo nekaj osnovnih afinih transformacij:

Kompozicija afine preslikave afina[a,t] in afina[b,s] je afina preslikava afina[a·b,a·s+t]:

ClearAll[kompozicija]
kompozicija[afina[a_,b_],afina[c_,d_]]:=afina[a.c,a.d+b]
kompozicija[u_afina, v_afina, w___]:=kompozicija[kompozicija[u,v],w]

Ker želimo z afinimi transformacijami slikati celotne slike, dodamo še pravila, ki ustrezno preslikajo grafične elemente. Omejimo se na preslikave točk, daljic in poligonov:

afina[a_,b_][Point[x_]]:=Point[afina[a,b][x]]
afina[a_,b_][Line[xs_]]:=Line[afina[a,b]/@xs]
afina[a_,b_][Polygon[xs_]]:=Polygon[afina[a,b]/@xs]
afina[a_,b_][lst_List]:=afina[a,b] /@ lst
afina[a_,b_][c_]:=c

Zadnji primer je za preslikavanje elementov, kot so RGBColor ali PointSize, ki jih afina transformacija ne spremeni (pravzaprav bi lahko spremenili velikost točke, a tega ne bomo počeli).

Osnove izometrije so translacija, rotacija in zrcaljenje preko premice. Definirajmo jih kot afine preslikave. Najprej translacija za smerni vektor (x,y):

ClearAll[translacija]
translacija[x_,y_]:=afina[(({{1, 0}, {0, 1}})),{x,y}]

translacija[1,2]

Rotacija rotacija[ϕ] je rotacija za kot ϕ s središčem v izhodišču. Rotacija rotacija[ϕ,x,y] je rotacija za kot ϕ  s središčem v točki (x,y).

ClearAll[rotacija]
rotacija[ϕ_]:=afina[(({{Cos[ϕ], -Sin[ϕ]}, {Sin[ϕ], Cos[ϕ]}})),{0,0}]
rotacija[ϕ_,x_,y_]:=
kompozicija[translacija[x,y],rotacija[ϕ],translacija[-x,-y]]

rotacija[Pi/4,1,1]

Zrcaljenje lahko podamo na tri načine: zrcaljenje[ϕ] je zrcaljenje preko premice skozi izhodišče z naklonom ϕ; zrcaljenje[ϕ,x,y] je zrcaljenje preko premice skozi točko (x,y) z naklonom ϕ; zrcaljenje[x,y,u,v] je zrcaljenje preko premice določene s točkama (x,y) in (u,v).

ClearAll[zrcaljenje]
zrcaljenje[ϕ_]:=afina[(({{Cos[2ϕ], Sin[2ϕ]}, {Sin[2ϕ], -Cos[2ϕ]}})),{0,0}]
zrcaljenje[ϕ_,x_,y_]:=kompozicija[translacija[x,y],zrcaljenje[ϕ],translacija[-x,-y]]
zrcaljenje[x_,y_,u_,v_]:=
kompozicija[translacija[x,y],zrcaljenje[ArcTan[u-x,v-y]],translacija[-x,-y]]

Pa še razteg v dani točki:

ClearAll[razteg]
razteg[r_]:=afina[(({{r, 0}, {0, r}})),{0,0}]
razteg[r_,x_,y_]:=kompozicija[translacija[x,y],razteg[r],translacija[-x,-y]]

IFS fraktali

Naj bodo (Subscript[f, 1]),...,(Subscript[f, n]):(ℝ^2)->(ℝ^2) afine preslikave ravnine. IFS fraktal (IFS = Iterated function system) je taka neprazna kompaktna podmnožica S⊆(ℝ^2), da velja

S=(Subscript[f, 1])(S)⋃…⋃(Subscript[f, n])(S)

Če vemo, da so preslikave (Subscript[f, 1]),…,(Subscript[f, n]) skrčitve, je taka množica enolično določena, ker je preslikava

S↦(Subscript[f, 1])(S)⋃…⋃(Subscript[f, n])(S)

skrčitev na prostoru nepraznih kompaktnih podmnožic ravnine, opremljenem s Hausdorffovo metriko. (Kateri izrek smo uporabili?)

Kako pa fraktal narišemo? Začnemo z poljubno (neprazno) začetno sliko:

slika={Line[{{0.1,0.1},{0.1,0.9},{0.9,0.9},{0.9,0.1},{0.1,0.1}}]}

Definiramo i-ti približek fraktala, določenega s preslikavami lst={(Subscript[f, 1]),...,(Subscript[f, n])}:

ClearAll[ifs]
ifs[lst_,0]:=slika
ifs[lst_,i_]:=
With[{s=ifs[lst,i-1]},Map[Function[f,f[s]],lst]]

Narišimo nekaj znanih fraktalov.

Trikotnik Sierpinskega

sierpinski={razteg[1/2,0,1],razteg[1/2,1,0],razteg[1/2,0,0]}

ifs[sierpinski,6]//Graphics

Z ukazom Manipulate naredimo bolj prikladno sliko, ki jo lahko uporabnik sam spreminja:

ifs[sierpinski,2]

Manipulate[Graphics[ifs[sierpinski,n]],{n,0,8,1}]

Kochova snežinka (ena stranica)

koch={
razteg[1/3,0,0],
kompozicija[rotacija[Pi/3,1/3,0],razteg[1/3,1/2,0]],
kompozicija[rotacija[-Pi/3,2/3,0],razteg[1/3,1/2,0]],
razteg[1/3,1,0]
}

Manipulate[Graphics[ifs[koch,n]],{n,0,6,1}]

IFS praprot

praprot={
afina[(({{0, 0}, {0, 0.16}})),{0,0}],
afina[(({{0.2, -0.26}, {0.23, 0.22}})),{0,1.6}],
afina[(({{-0.15, 0.28}, {0.26, 0.24}})),{0,0.44}],
afina[(({{0.85, 0.04}, {-0.04, 0.85}})),{0.0, 1.6}]}

ifs[praprot,6]//Graphics

Mengerjeva spužva

Za sladkosce pa še tridimenzionalni fraktal:

ClearAll[afina3D, kompozicija3D,translacija3D,razteg3D]
afina3D[a_,t_][{x_,y_,z_}]:=a . {x,y,z}+t
kompozicija3D[afina3D[a_,t_],afina3D[b_,s_]]:=afina3D[a.b,t+a.s]
kompozicija3D[a_,b_,c___]:=kompozicija3D[kompozicija3D[a,b],c]
translacija3D[x_,y_,z_]:=afina3D[(({{1, 0, 0}, {0, 1, 0}, {0, 0, 1}})),{x,y,z}]
razteg3D[r_]:=afina3D[(({{r, 0, 0}, {0, r, 0}, {0, 0, r}})),{0,0,0}]
razteg3D[r_,x_,y_,z_]:=kompozicija3D[translacija3D[x,y,z],razteg3D[r],translacija3D[-x,-y,-z]]

Tole deluje samo za raztege in translacije:

afina3D[a_,t_][Cuboid[{p_,q_}]]:=Cuboid[{afina3D[a,t][p],afina3D[a,t][q]}]
afina3D[a_,t_][lst_List]:=afina3D[a,t]/@lst

menger={
razteg3D[1/3,0,0,0],
razteg3D[1/3,0,0,1],
razteg3D[1/3,0,1,0],
razteg3D[1/3,0,1,1],
razteg3D[1/3,0,0,0],
razteg3D[1/3,0,0,1],
razteg3D[1/3,0,1,0],
razteg3D[1/3,0,1,1],
razteg3D[1/3,1,0,0],
razteg3D[1/3,1,0,1],
razteg3D[1/3,1,1,0],
razteg3D[1/3,1,1,1],
razteg3D[1/3,1,0,0],
razteg3D[1/3,1,0,1],
razteg3D[1/3,1,1,0],
razteg3D[1/3,1,1,1],
razteg3D[1/3,1/2,0,0],
razteg3D[1/3,0,1/2,0],
razteg3D[1/3,1/2,1,0],
razteg3D[1/3,1,1/2,0],
razteg3D[1/3,1/2,0,1],
razteg3D[1/3,0,1/2,1],
razteg3D[1/3,1/2,1,1],
razteg3D[1/3,1,1/2,1],
razteg3D[1/3,0,0,1/2],
razteg3D[1/3,0,1,1/2],
razteg3D[1/3,1,0,1/2],
razteg3D[1/3,1,1,1/2]
};

slika={Cuboid[{{0,0,0},{1,1,1}}]}
ifs[menger,2]//Graphics3D