Iterated Affine Transformations of (ℝ^2)

Initialization

Which[
	 $MachineName=="math"||$MachineName=="severi"||$MachineName=="buma10",
	                    WorkingDirectory="/home/paul/tmp",                    
	$MachineName=="H3F63",
	                    WorkingDirectory="c:/backup folder/ma226",
	True,
	                    WorkingDirectory="/Users/paul/Desktop"
];

SetDirectory[WorkingDirectory]

Clear[DumpEPS]
DumpEPS[graphic_,filename_]:=Export[filename<>".eps",graphic,"EPS"]

Off[General::spell1]

$TextStyle={FontFamily->"Courier-Bold", FontSize -> 18};

SierpinskiIt[pt_]:=Switch[RandomInteger[{1,3}],
1,{0.5` pt[[1]],0.5` pt[[2]]},
2,{0.5` pt[[1]]+0.5`,0.5` pt[[2]]},
3,{0.5` pt[[1]]+0.25`,0.5` pt[[2]]+0.5`}]

SierpinskiIts[pt_,maxits_]:=NestList[SierpinskiIt, pt, maxits]

SierpinskiIts[pt_,minits_,maxits_]:=Drop[NestList[SierpinskiIt, pt, maxits],minits]

See Barnsley's "Fractals Everywhere" p. 87:

BarnsleyMap1[pt_]:= {0.0,0.16pt[[2]]}

BarnsleyMap2[pt_]:= {0.2pt[[1]]-0.26pt[[2]],0.23pt[[1]]+0.22pt[[2]]+1.6}

BarnsleyMap3[pt_]:= {-0.15pt[[1]]+0.28pt[[2]],0.26pt[[1]]+0.24pt[[2]]+0.44}

BarnsleyMap4[pt_]:= {0.85pt[[1]]+0.04pt[[2]],-0.04pt[[1]]+0.85pt[[2]]+1.6}

BarnsleyIt[pt_]:=Module[{r=RandomInteger[{0,99}]},Which[r<1,{0.`,0.16` pt[[2]]},r<8,{0.2` pt[[1]]-0.26` pt[[2]],0.23` pt[[1]]+0.22` pt[[2]]+1.6`},r<15,{-0.15` pt[[1]]+0.28` pt[[2]],0.26` pt[[1]]+0.24` pt[[2]]+0.44`},True,{0.85` pt[[1]]+0.04` pt[[2]],-0.04` pt[[1]]+0.85` pt[[2]]+1.6`}]]

BarnsleyIts[pt_,maxits_]:=NestList[BarnsleyIt, pt, maxits]

BarnsleyIts[pt_,minits_,maxits_]:=Drop[NestList[BarnsleyIt, pt, maxits],minits]

Sierpinski

ListPlot[SierpinskiIts[{0.5,0.25},1],
PlotStyle->PointSize[0.02],
PlotRange->{{0,1},{0,1}},
AspectRatio->Automatic,
Ticks->{{0,1},{0,1}}]

ListPlot[SierpinskiIts[{0.5,0.25},2],
PlotStyle->PointSize[0.02],
PlotRange->{{0,1},{0,1}},
AspectRatio->Automatic,
Ticks->{{0,1},{0,1}}]

ListPlot[SierpinskiIts[{0.5,0.25},10000],
PlotRange->All,
AspectRatio->Automatic,
Ticks->{{0,1},{0,1}}]

SierpinskiTriangle=ListPlot[SierpinskiIts[{0.5,0.25},10000,100000],PlotRange->All,AspectRatio->Automatic,Ticks->{{0,1},{0,1}}]

Barnsley

ListPlot[BarnsleyIts[{0.,0.},50000],
PlotRange->{{-5.5,5.5},{0,10.5}},
AspectRatio->Automatic,
Ticks->{{-5,5},{5,10}}]

ListPlot[BarnsleyIts[{0.,0.},100,50000],
PlotRange->{{-5.5,5.5},{0,10.5}},
AspectRatio->Automatic,
Ticks->{{-5,5},{5,10}}]

ListPlot[BarnsleyIts[{0.,0.},100,50000],
PlotRange->{{-5.5,5.5},{0,10.5}},
AspectRatio->Automatic,
Axes->None]

Figures for handout

DumpEPS[SierpinskiTriangle,"SierpinskiTriangle"];

$TextStyle={FontFamily->"Courier-Bold", FontSize -> 8};

fern1=ListPlot[BarnsleyIts[{0.`,0.`},10000,50000],PlotRange->{{-5.5`,5.5`},{0,10.5`}},AspectRatio->Automatic,Ticks->{{-5,5},{5,10}}]

fern2=ListPlot[BarnsleyIts[{0.`,0.`},10000,50000],PlotRange->{{-5.5`,5.5`},{0,10.5`}},AspectRatio->Automatic,Axes->None]

ferns=Show[GraphicsRow[{fern1,fern2}]]

DumpEPS[ferns,"BarnsleyFern"];

DumpEPS[fern1,"BarnsleyFernWithAxes"];

DumpEPS[fern2,"BarnsleyFernWithoutAxes"];

domain=Show[Graphics[Line[{{-5,0},{5,0},{5,10},{-5,10},{-5,0}}]]]

image1=Show[Graphics[Line[BarnsleyMap1/@{{-5,0},{5,0},{5,10},{-5,10},{-5,0}}]]]

image2=Show[Graphics[Line[BarnsleyMap2/@{{-5,0},{5,0},{5,10},{-5,10},{-5,0}}]]]

image3=Show[Graphics[Line[BarnsleyMap3/@{{-5,0},{5,0},{5,10},{-5,10},{-5,0}}]]]

image4=Show[Graphics[Line[BarnsleyMap4/@{{-5,0},{5,0},{5,10},{-5,10},{-5,0}}]]]

BarnsleyFunctions=Show[domain,image1,image2,image3,image4,AspectRatio->Automatic]

Show[domain,image2,AspectRatio->Automatic]

DumpEPS[BarnsleyFunctions,"BarnsleyFunctions"];