Mathematica Source Code
Here is the Mathematica source code for the images on the site. This code was written using Mathematica 2.2, but it can easily be used in other versions of Mathematica as well.
All code on this page was written by Mustafa Kulenovic and Joe DeAlmo.
This code defines some basic shapes, which will be transformed to create fractal designs.
point = {{0,0},{0,0}};
segment = {{0,0},{1,0}};
vertical = {{0,0}, {0,1}};
triangle = {{0,0},{1,0},{0.5,N[Sqrt[3]/2]},{0,0}};
square = {{0,0},{0,1},{1,1},{1,0},{0,0}};
diamond = {{0.5,0},{0,0.5},{-0.5,0},{0,-0.5},{0.5,0}};
hexagon = {{0,0}, {1,0}, {3/2,Sqrt[3]/2}, {1,Sqrt[3]},
{0,Sqrt[3]}, {-1/2,Sqrt[3]/2}, {0,0}};
Iterated Function Systems
This is the code for all of the IFS used on the site.
sf1[x_] :=
{x[[1]]/2,x[[2]]/2}//N;
sf2[x_] := {0.5+x[[1]]/2,x[[2]]/2}//N;
sf3[x_] := {0.25+x[[1]]/2,0.25*Sqrt[3]+x[[2]]/2}//N;
sierpinski = {sf1,sf2,sf3};
kf1[x_] :=
{x[[1]]/3,x[[2]]/3}//N;
kf4[x_] := {x[[1]]/3+2/3,x[[2]]/3}//N;
kf2[x_] := {x[[1]]/6-Sqrt[3]*x[[2]]/6+1/3,
Sqrt[3]*x[[1]]/6+x[[2]]/6}//N;
kf3[x_] := {x[[1]]/6+Sqrt[3]*x[[2]]/6+1/2,
-Sqrt[3]*x[[1]]/6+x[[2]]/6+1/(2*Sqrt[3])}//N;
koch = {kf1,kf2,kf3,kf4};
Koch tree (Modified Koch curve)
ktf1[x_] :=
{3*x[[1]]/12,3*x[[2]]/12}//N;
ktf4[x_] := {7*x[[1]]/12+5/12,2*x[[2]]/3}//N;
ktf2[x_] := {x[[1]]/12-2*x[[2]]/9+3/12,
2*x[[1]]/3+2*x[[2]]/9}//N;
ktf3[x_] := {x[[1]]/12+2*x[[2]]/9+1/3,
-2*x[[1]]/3+2*x[[2]]/9+2/3}//N;
kochtree = {ktf1,ktf2,ktf3,ktf4};
tf1[x_] :=
{x[[1]],x[[2]]}//N;
tf2[x_] := {x[[1]]/6-x[[2]]/3,x[[1]]/6+x[[2]]/3+3/4}//N;
tf3[x_] := {x[[1]]/6+x[[2]]/3,-x[[1]]/6+x[[2]]/3+3/4}//N;
tf4[x_] := {x[[1]]/6-x[[2]]/2,x[[1]]/6+x[[2]]/3+1/3}//N;
tf5[x_] := {x[[1]]/6+x[[2]]/2,-x[[1]]/6+x[[2]]/3+1/3}//N;
tf6[x_] := {x[[1]]/2,x[[2]]/2+1}//N;
tf7[x_] := {x[[1]]/6-x[[2]]/3,x[[1]]/6+x[[2]]/3+1}//N;
tf8[x_] := {x[[1]]/6+x[[2]]/3,-x[[1]]/6+x[[2]]/3+1}//N;
simpletree = {tf1, tf7, tf8};
tree = {tf1, tf2, tf3, tf4, tf5, tf6};
snf1[x_] :=
{x[[1]]/3,x[[2]]/3}//N;
snf2[x_] := {x[[1]]/3+2/3,x[[2]]/3}//N;
snf3[x_] := {x[[1]]/3-1/3,x[[2]]/3+Sqrt[3]/3}//N;
snf4[x_] := {x[[1]]/3+1/3,x[[2]]/3+Sqrt[3]/3}//N;
snf5[x_] := {x[[1]]/3+1,x[[2]]/3+Sqrt[3]/3}//N;
snf6[x_] := {x[[1]]/3,x[[2]]/3+2*Sqrt[3]/3}//N;
snf7[x_] := {x[[1]]/3+2/3,x[[2]]/3+2*Sqrt[3]/3}//N;
snowflake = {snf1, snf2, snf3, snf4, snf5, snf6, snf7};
sn2f1[x_] :=
{x[[1]]/4,x[[2]]/4}//N;
sn2f2[x_] := {x[[1]]/4+3/4,x[[2]]/4}//N;
sn2f3[x_] := {x[[1]]/4-3/8,x[[2]]/4+3*Sqrt[3]/8}//N;
sn2f4[x_] := {x[[1]]/2+1/4,x[[2]]/2+Sqrt[3]/4}//N;
sn2f5[x_] := {x[[1]]/4+9/8,x[[2]]/4+3*Sqrt[3]/8}//N;
sn2f6[x_] := {x[[1]]/4,x[[2]]/4+3*Sqrt[3]/4}//N;
sn2f7[x_] := {x[[1]]/4+3/4,x[[2]]/4+3*Sqrt[3]/4}//N;
snowflake2 = {sn2f1, sn2f2, sn2f3, sn2f4, sn2f5, sn2f6, sn2f7};
This code is used to iterate the IFS and plot it graphically.
mapshape[f_,s_]
:= Map[f,s]; (* s is a list of points *)
mapshapelist[f_,l_] := Map[mapshape[f,#]&,l];
(* l is a list of lists of points *)
ifsshapelist[ifs_,l_] :=
Flatten[Map[mapshapelist[#,l]&,ifs],1];
(* ifs is a list of maps *)
iterateifs[ifs_,shape_,n_] :=
Nest[ifsshapelist[ifs,#]&,{shape},n];
plotifs[ifs_,shape_,n_]
:= Module[{l,glist},
l= iterateifs[ifs,shape,n];
glist = Map[Line,l];
Show[Graphics[{Thickness[.001]}~Join~glist],
AspectRatio->Automatic]
]
This code will compute the fractal dimension of an IFS.
singvals[tr_] :=
With[{a=tr[[2,1]]-tr[[1,1]],b=tr[[2,2]]-tr[[1,2]],
c=tr[[3,1]]-tr[[1,1]],d=tr[[3,2]]-tr[[1,2]]},
{Sqrt[0.5*((a^2+b^2+c^2+d^2)-
Re[Sqrt[(a^2+b^2+c^2+d^2)^2+8*a*b*c*d-4*(a^2*d^2+b^2*c^2)]])],
Sqrt[0.5*((a^2+b^2+c^2+d^2)+
Re[Sqrt[(a^2+b^2+c^2+d^2)^2+8*a*b*c*d-4*(a^2*d^2+b^2*c^2)]])]}]
svpowers[s_,sv_] := sv[[1]]*sv[[2]]^(s-1)
fractaldimension[ifs_,n_:1] := Module[{l,sol},
sv = Map[singvals[#]&,
iterateifs[ifs,{{0,0},{1,0},{0,1}},n]];
sol = FindRoot[
Function[s,Apply[Plus,Map[svpowers[s,#]&,sv]]][s]==1,{s,0,2}];
s/.sol
]
This is the code to randomly plot an IFS, i.e. use it for the Chaos Game.
maprandom[ifs_,x0_]
:=
ifs[[Random[Integer,{1,Length[ifs]}]]][x0]
ifsorbit[ifs_,x0_,n_,nskip_:0] :=
NestList[maprandom[ifs,#]&,Nest[maprandom[ifs,#]&,x0,n],n];
plotifsrandom[ifs_,x0_:{0,0},n_:5000,nskip_:100]
:=
(
ListPlot[ ifsorbit[ifs,x0,n,nskip],
AspectRatio->Automatic,
Axes->False,
PlotStyle->{PointSize[.005]}];
)
This code will create the simple fractal interpolation example used at the beginning of section 3.3.
s2f1[x_] :=
{x[[1]]/2,x[[2]]/2}//N;
s2f2[x_] := {x[[1]]/2+1/2,x[[2]]/2+1/2}//N;
square2 = {s2f1,s2f2};