(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other text-file transfer utility. It should
be read or edited using a copy of Mathematica or MathReader. If you
received this as email, use your mail application or copy/paste to save
everything from the line containing (*^ down to the line containing ^*)
into a plain text file. On some systems you may have to give the file a
name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
The line below identifies what version of Mathematica created this file,
but it can be opened using any other version as well.";
FrontEndVersion = "X Window System Mathematica Notebook Front End Version 2.2";
X11StandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, fontName, "times";
fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, fontName, "times";
fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, fontName, "times";
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, fontName, "times";
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, fontName, "times";
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, fontName, "times";
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, fontName, "times";
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, 12, fontName, "courier";
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-4, 12, fontName, "courier";
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, fontName, "courier";
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, fontName, "courier";
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, fontName, "courier";
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, fontName, "courier";
fontset = name, inactive, noPageBreakInGroup, nohscroll, preserveAspect, M7, italic, B32768, 10, fontName, "times";
fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 12, fontName, "times";
fontset = leftheader, 12, fontName, "times";
fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, italic, 12, fontName, "times";
fontset = leftfooter, 12, fontName, "times";
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "courier";
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 14, fontName, "times";
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, fontName, "times";paletteColors = 128; magnification = 125; currentKernel;
]
:[font = title; inactive; preserveAspect; cellOutline; left; fontColorRed = 32768; fontColorGreen = 32768; backColorRed = 0; backColorGreen = 0; backColorBlue = 0]
Self-Similar Fractals
by Brian H. Marston
http://www.fatdays.com/
webguy@fatdays.com
;[s]
6:0,0;22,1;38,2;39,3;104,4;105,5;131,-1;
6:1,0,0 ,Times,1,24,65535,65535,0;1,0,0 ,Times,1,18,65535,65535,0;1,0,0 ,Times,1,20,65535,65535,0;1,0,0 ,Times,1,12,65535,65535,0;1,0,0 ,Times,1,24,65535,65535,0;1,0,0 ,Times,1,12,65535,65535,0;
:[font = input; inactive; Cclosed; preserveAspect; startGroup]
Initializations
;[s]
1:0,0;15,-1;
1:1,0,0 ,Courier,0,12,0,0,0;
:[font = input; initialization; preserveAspect; endGroup]
*)
Off[General::spell];
Needs["Graphics`Colors`"]
Needs["Graphics`Polyhedra`"]
Off[ParametricPlot3D::ppcom];
Off[ParametricPlot::ppcom];
Off[Plot::plnr];
SetOptions[Limit,Analytic->True];
(*
;[s]
3:0,0;20,1;21,2;185,-1;
3:1,0,0 ,Courier,1,12,0,0,0;1,0,0 ,Courier,1,18,0,0,0;1,0,0 ,Courier,1,12,0,0,0;
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Introduction
:[font = text; inactive; preserveAspect]
"Fractals are about looking closely and seeing more. Fractals have to do with bumps that have bumps, cracks that have crookednesses within crookednesses, and atoms that turn out to be universes. Fractals have to do with the rich structure of our universe that spans all scales from the uncountable galaxies at unthinkable distances to the mysterious inner electric flashes and vibrations of the subatomic realm."
--Tim Wegner and Bert Tyler, Fractal Creations, 2nd ed., p. 13
;[s]
5:0,0;414,1;418,2;445,3;462,4;479,-1;
5:1,0,0 ,Times,0,14,0,0,65535;1,0,0 ,Times,0,12,0,0,0;1,0,0 ,Times,0,12,0,0,65535;1,0,0 ,Times,2,12,0,0,65535;1,0,0 ,Times,0,12,0,0,65535;
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
The Modeling Power of Fractals
:[font = text; inactive; preserveAspect; fontSize = 14; endGroup]
Many objects in nature are so complicated and irregular that they cannot be modeled well using conic sections, polygons, spheres and the other familiar objects of classical geometry. For example, circulatory systems, clouds, trees, mountains, and coastlines cannot be reduced to combinations of simple shapes from classical geometry. Where classical geometry ends as a tool for analyzing the complexity of natural objects, fractal geometry begins. Today, fractals are used to model a wide range of biological and topographical entities and to produce ultra-realistic special effects for movies and video games.
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
How Long is the Coastline of Britain?
:[font = text; inactive; preserveAspect; fontSize = 14; endGroup]
The question "How long is the coastline of Britain?" posed by Benoit Mandelbrot, the father of modern fractal theory, in his book The Fractal Geometry of Nature is not as simple as it appears. The problem is that one's answer to this question depends on the length of the ruler one uses. Unlike circles and the other shapes from classical geometry, coastlines are very irregular. They're full of inlets, bays, and rocky shores. A shorter measuring stick will fit more snugly in these nooks and crannies and increase the estimated length of the coastline. Hence, if we measure the length of Britain's coastline using a mile-long ruler, we will get one value. If we use a shorter ruler, say a yardstick, we will get a larger value because a yardstick can more closely approximate Britain's convoluted boundary. In fact, as the scale of measurement decreases, the estimated length increases without limit. Thus, as the length of the ruler approaches zero, the estimated length of the coastline approaches infinity. This difficulty in measuring due to the irregularity of the object being measured is characteristic of fractal curves and surfaces.
;[s]
3:0,0;130,1;160,2;1153,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Self-Similarity
:[font = special1; inactive; preserveAspect; endGroup]
Fractal theory is grounded in geometry and dimension theory. Geometrically, fractals are independent of scale and appear equally detailed at any level of magnification. This property, called self-similarity, means that any portion of a self-similar fractal curve, if blown up in scale, would appear identical to the whole curve. In other words, if we shrink or enlarge a fractal pattern, its appearence remains unchanged. This repetition of a pattern at all scales, no matter how small, is exhibited by many natural objects. For example, imagine that you are in space looking at the coastline of Britain. As you approach the Earth, the coastline still looks like a coastline. No matter how close you get to Britain's shore, the coastline appears equally complex. Even after you land your spacecraft and get down on your hands and knees with a microscope at the water's edge, the coastline still looks jagged and irregular.
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Fractal dimension
:[font = special1; inactive; preserveAspect; endGroup; endGroup]
The term "fractal," introduced in 1975 by Benoit Mandelbrot, is an abbreviation for "fractional dimension." We all learned in high school that in classical geometry a line is an one dimensional object and a plane is two dimensional. Strangely, if we put enough kinks in a line, the resulting fractal curve will have a dimension somewhere between one and two, so that it is neither a line nor a plane but something in between. Similarly, an extremely convoluted surface will have a dimension beween two and three. Such a figure is called a fractal. For objects of classical geomery, the classical dimension of the object and its fractal dimension are the same. A fractal, on the other hand, is an object that has a fractal dimension that is strictly greater than its classical dimension. Although they are continuous, fractal curves are so rough that they are nowhere differentiable. The concept of fractal dimension provides a way to measure how rough fractal curves are. The more jagged and irregular a curve is, the higher its fractal dimension, a value betwen one and two. Fractional dimension is related to self-similarity in that the easiest way to create a figure that has fractional dimension is through self-similarity.
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Calculating Fractal Dimension
:[font = special1; inactive; preserveAspect]
Consider a line segment divided into N equal pieces. Each of these N pieces can be thought of as a scaled version of the whole segment, with scaling ratio r=1/N. The relation between N and r is clearly Nr=1. For example, if N=3, then r=1/3 and Nr=(3)(1/3)=1. (See the figure generated by the cell below.)
:[font = input; preserveAspect]
Clear[points,line,n]
points=ListPlot[{{0,0},{1/3,0},{2/3,0},{1,0}},
PlotStyle->{Red,PointSize[.02]},Axes->False,
DisplayFunction->Identity];
line=Graphics[Line[{{0,0},{1,0}}]];
Show[{line,
points,
Graphics[Table[
Text["1/3",{n,.01}],{n,1/6,5/6,1/3}]]},
PlotLabel->FontForm["N=3, r=1/3, Nr=1",
{"Times-Bold",14}],
PlotRange->{-.1,.1},
DisplayFunction->$DisplayFunction]
:[font = special1; inactive; preserveAspect]
Now suppose the sides of a square are scaled by a factor r to produce N identical subsquares, each of which is a scaled version of the whole square. The relation between N and r in this case is Nr2=1. For example, if r=1/3, then N=9 and Nr2=(9)(1/9)=1. (See the figure generated by the cell below.)
;[s]
5:0,0;198,1;199,2;242,3;243,4;302,-1;
5:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
Clear[i,j,n,horizontal,vertical]
horizontal=Table[Graphics[Line[{{0,j},{1,j}}]],
{j,0,1,1/3}];
vertical=Table[Graphics[Line[{{i,0},{i,1}}]],
{i,0,1,1/3}];
Show[{
horizontal,
vertical,
Graphics[Table[
Text["1/3",{-.05,n}],{n,1/6,5/6,1/3}]],
Graphics[Table[
Text["1/3",{n,-.05}],{n,1/6,5/6,1/3}]]},
AspectRatio->1,
PlotLabel->FontForm["N=9, r=1/3, Nr^2=1",
{"Times-Bold",14}]]
:[font = special1; inactive; preserveAspect]
Finally, if a cube is scaled in the x, y, and z directions by a factor r to produce N equal subcubes, then the relation is Nr3=1. For example, if r=1/3, then N=27 and Nr3=(27)(1/27)=1. (See the figure generated by the cell below.)
;[s]
5:0,0;125,1;126,2;170,3;171,4;232,-1;
5:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
Clear[i,j,k,n]
Show[{
Table[Graphics3D[Cuboid[{i,j,k},
{i+1/3,j+1/3,k+1/3}]],
{i,0,2/3,1/3},{j,0,2/3,1/3},{k,0,2/3,1/3}],
Graphics3D[Table[
Text["1/3",{n,-.05,-.05}],{n,1/6,5/6,1/3}]],
Graphics3D[Table[
Text["1/3",{1.05,n,-.05}],{n,1/6,5/6,1/3}]],
Graphics3D[Table[
Text["1/3",{-.05,-.05,n}],{n,1/6,5/6,1/3}]]},
Boxed->False,
PlotLabel->FontForm["N=27, r=1/3, Nr^3=1",
{"Times-Bold",14}]]
:[font = special1; inactive; preserveAspect]
The line, square, and cube above have integer dimensions of one, two, and three respectively. Notice that the dimensions of these objects show up as the exponent d in the relation Nrd=1, where N is the number of equal subunits and r is the scaling ratio. In general, if a given set is the union of N essentially disjoint copies of the original that are scaled by a constant factor r, then the value of d that satisfies the equation Nrd=1 is called the fractal dimension or similarity dimension of the set.
;[s]
13:0,0;162,1;165,2;183,3;184,4;434,5;436,6;437,7;439,8;454,9;471,10;475,11;495,12;513,-1;
13:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,0,14,0,0,65535;1,0,0 ,Times,32,14,0,0,65535;1,0,0 ,Times,0,14,0,0,65535;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect]
It turns out that there are configurations for which the value of d in Nrd=1 is not an integer. Such configurations are called self-similar fractals.
;[s]
5:0,0;73,1;74,2;127,3;149,4;154,-1;
5:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect]
The explicit formula for d in terms or N and r is given by the cell below.
:[font = input; preserveAspect]
Solve[n r^d==1,d]
:[font = special1; inactive; preserveAspect]
The logarithm in the formula above can be taken with respect to any positive base different from 1. The following cell defines a function called dimension that takes the values of N and r as input and returns the value of d. This function will be used later in this notebook, so execute it now.
;[s]
3:0,0;146,1;156,2;296,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect; endGroup]
Clear[dimension,d]
dimension[n_Integer?Positive,r_?Positive]:=
Module[{d},
d=Log[1/n]/Log[r]//N]
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Koch Snowflake
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Construction
:[font = special1; inactive; preserveAspect]
The boundary of the Koch Snowflake constructed by Helge Von Koch in 1904 is the union of three congruent self-similar fractals. Each third of the snowflake is constructed by starting with one side of an equilateral triangle and performing an iterative process. The following cell defines a function called Snowflake that illustrates the stages in this iterative process.
;[s]
3:0,0;308,1;317,2;374,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
(* Given a non-negative integer n, the function
Snowflake generates the nth level approximation
to the Koch Snowflake. Code from the Notices of
the AMS Vol.39 #7 Sept 92, page 709 *)
Clear[n,Snowflake,start,finish,doline]
Snowflake[n_Integer?NonNegative]:=
Show[Graphics[
Nest[ (#1/.Line[{start_,finish_}] :>doline[start,
finish]) &,
{Line[{{0,0},{1/2,Sqrt[3]/2}}],
Line[{{1/2,Sqrt[3]/2},{1,0}}],
Line[{{1,0},{0,0}}]},
n]],
AspectRatio->Automatic,PlotRange->All]
doline[start_,finish_]:=
Module[{vec,normal},
vec=finish-start;
normal=Reverse[vec] {-1,1} Sqrt[3]/6;
{Line[{start,start + vec/3}],
Line[{start + vec/3,start + vec/2 + normal}],
Line[{start + vec/2 + normal, start + 2 vec/3}],
Line[{start + 2 vec/3, finish}]
}
];
:[font = special1; inactive; preserveAspect]
The following cell generates a picture of the initial stage of the snowflake's construction.
:[font = input; preserveAspect]
Snowflake[0]
:[font = special1; inactive; preserveAspect]
At the next stage of the snowflake's construction, we remove the middle one-third of each side and add two new segments having the same length as the part that was removed. (See the picture generated by the cell below).
:[font = input; preserveAspect]
Snowflake[1]
:[font = special1; inactive; preserveAspect]
At each stage, we replace the middle-third of every segment in the previous stage by two new segments, creating a "bump" on the original segment. Evaluate the following cells to see the next four stages in the construction of the Koch Snowflake. Warning: Level 5 of the snowflake took me 3 minutes, 22 seconds to generate on an SGI Indy.
;[s]
3:0,0;248,1;255,2;342,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,0,14,65535,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
Snowflake[2]
:[font = input; preserveAspect]
Snowflake[3]
:[font = input; preserveAspect]
Snowflake[4]
:[font = input; preserveAspect; endGroup]
Snowflake[5]
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Dimension
:[font = special1; inactive; preserveAspect]
Each third of the Koch Snowflake converges to a limiting curve K that is a self-similar fractal. If K is scaled by a factor of r=1/3, then there are N=4 copies of the scaled version making up the entire set K. Hence, the fractal dimension of K is given by the following cell.
:[font = input; preserveAspect]
dimension[4,1/3]
:[font = special1; inactive; preserveAspect; endGroup]
Since the dimension of the snowflake (1.26186) is greater than the dimension of the lines making up the curve (1), the Koch Snowflake is a fractal.
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Boundary length
:[font = special1; inactive; preserveAspect]
An important property of the Koch Snowflake is that its boundary has infinite length. This is especially suprising in light of the fact that the snowflake encloses only a finite area (after all, it can be completely covered with a square of paper).
:[font = special1; inactive; preserveAspect]
To show that the boundary of the snowflake has infinite length, it suffices to show that each of the three congruent fractals making up the snowflake has infinite length. Suppose that the initial segment (call it K0) has length 1. Then K1, the curve produced by removing the middle one-third of K0 and adding two new segments having the same length, has length 4/3. The curve K2 at the end of the second stage has length 42/32. Repeating this process, the curve Kn produced after n stages has length 4n/3n. Hence, the length of the limit curve K is given by the following cell.
;[s]
19:0,0;215,1;216,2;239,3;240,4;298,5;299,6;380,7;381,8;425,9;426,10;428,11;429,12;468,13;469,14;506,15;507,16;509,17;510,18;583,-1;
19:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect; endGroup; endGroup]
Limit[(4/3)^n,n->Infinity]
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Sierpinski Gasket
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Construction
:[font = special1; inactive; preserveAspect]
The Sierpinski Gasket, introduced in 1915 by W. Sierpinski, is another self-similar fractal. The following cell defines a function called Gasket that illustrates the stages in the gasket's construction.
;[s]
3:0,0;139,1;145,2;204,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
(* Given a level, the function Gasket generates all the
levels up to and including that level in the construction
of the Sierpinski Gasket, starting with level 0.
Code adapted from the code written by Patrick
Haggerty to produce the graphics for the Sierpinski
Gasket in Dr. Richard Crownover's book Fractals and
Chaos. *)
Clear[Gasket,disp,newF,G,F,sierp,i,j,k,w,trans,group1,group2];
Gasket[level_Integer?NonNegative]:=
Module[{newF,G,F,sierp,i,j,k,trans,group1,group2},
(* trans={{a1,b1,c1,d1,e1,f1},
{a2,b2,c2,d2,e2,f2},
{a3,b3,c3,d3,e3,f3}} represents the
coefficients of the affine transformations of
the iterated function system given by
Ti(x)=|ai bi|x + |ei| i=1,2,3
|ci di| |fi|
which produces the Sierpinski Gasket *)
trans={{1/2,0,0,1/2,0,0},{1/2,0,0,1/2,1/2,0},
{1/2,0,0,1/2,1/4,N[Sqrt[3]]/4}};
group1[list_]:={{list[[1]],list[[2]]},{list[[3]],
list[[4]]}};
group2[list_]:={{list[[5]]},{list[[6]]}};
disp[0]=Show[
Graphics[Polygon[{{0,0},{1/2,Sqrt[3]/2},{1,0}}]],
AspectRatio->Automatic];
F={{0,0},{1/2,Sqrt[3.]/2},{1,0},{0,0}};
G=F;
For[k=1,kAutomatic];];
;]
;[s]
3:0,0;765,1;766,2;1613,-1;
3:1,0,0 ,Courier,1,12,0,0,0;1,0,0 ,Courier,3,14,0,0,0;1,0,0 ,Courier,1,12,0,0,0;
:[font = special1; inactive; preserveAspect]
Construction involves starting with a filled region and successively removing parts of its interior. Let the initial set S0 be a filled equilateral triangle. Subdivide S0 into four smaller triangles by joining the midpoints of the sides of the original triangle. Then remove the interior of the middle triangle. Call the remaining set S1. The next level in the construction of the gasket is obtained by repeating this process of removing the middle triangle for each of the three triangular regions of S1. Continuing this iterative process of removing the middle triangle from each triangle of the previous stage, we obtain a sequence of figures whose intersection is the final gasket S. The following cell displays levels 0-5 in the construction of the Sierpinski Gasket.
;[s]
9:0,0;123,1;124,2;172,3;173,4;341,5;342,6;509,7;510,8;780,-1;
9:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
Gasket[5]
:[font = special1; inactive; preserveAspect]
The following cell displays a table of levels 0-5 of the gasket.
:[font = input; preserveAspect; endGroup]
Show[GraphicsArray[{Table[disp[n],{n,0,2}],
Table[disp[n],{n,3,5}]}]];
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Dimension
:[font = special1; inactive; preserveAspect]
From the construction of the Sierpinski Gasket it is clear that the whole gasket is the union of N=3 essentially disjoint copies of itself, where the scaling ratio is r=1/2 in both the horizontal and vertical directions. The dimension of the final gasket is calculated by the following cell.
:[font = input; preserveAspect; endGroup]
dimension[3,1/2]
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Area Measure
:[font = special1; inactive; preserveAspect]
Strangely, the total area of the parts removed in the construction of the gasket is equal to the area of the equilateral triangle we started with. In the first step we removed 1/4 of the area. In the next step we took out three triangular regions each of which had 1/42 the area of the original. Continuing this series, we find that the total fraction of the area removed was
;[s]
3:0,0;270,1;271,2;378,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect; center]
1/4 + 3(1/42) + 32(1/43) + . . . + 3(n-1)(1/4n) + . . .
;[s]
11:0,0;11,1;12,2;17,3;18,4;22,5;23,6;36,7;41,8;45,9;46,10;59,-1;
11:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect]
This infinite series converges quite quickly to 1, as shown by the following cell which produces a table of partial sums s[n] for n=10,20,...,80.
:[font = input; preserveAspect]
Clear[n,a,k]
a[k_]:=3^(k-1)/(4)^k;1/(1-x);
s[n_]:=Sum[a[k],{k,1,n}]//N;
Table[{n,s[n]},{n,10,80,10}]//TableForm
:[font = special1; inactive; preserveAspect]
This sum can also be found analytically using the fact that
:[font = special1; inactive; preserveAspect; center]
1/(1-x) = 1 + x + x2 + ..., if |x|<1.
;[s]
3:0,0;19,1;20,2;40,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect; endGroup; endGroup]
Since the area removed is equal to the area of the original triangle, the remaining set, the Sierpinski Gasket, has zero area measure. Thus, S is a perfect gasket because it divides its complement (the white regions in the pictures above) into infinitely many triangular regions without using any thickness to do so.
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Menger Sponge
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Construction
:[font = special1; inactive; preserveAspect]
The Menger Sponge, named after Karl Menger, is a three dimensional analog of a gasket. The following cell defines a function called Sponge that produces the stages in the construction of the Menger Sponge.
;[s]
3:0,0;133,1;140,2;208,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,2,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = input; preserveAspect]
(* Given a level as input, the function Sponge outputs a
picture of the Menger Sponge at that level of construction.
Code adapted from code written by Robert M. Dickau available
at MathSource (http://www.wri.com/WWWDocs/mathsource/) *)
Clear[Sponge,level,iters,side,cubmat,i,j,k,n,faces]
Sponge[level_Integer?NonNegative]:=
Module[{iters,side,cubmat,i,j,k,n,faces},
iters = level;
side = 3. ^ iters ;
cubmat (* cuboid-matrix *) =
Table[
If[i==side + 1. || j==side + 1. || k==side + 1.,
(* Pad the table's edges with zeroes; if you want
to see the complement of the sponge, transpose
the 0. and 1. directly below. *)
0., 1.],
{i,1.,side + 1.},{j,1.,side+1.},{k,1.,side+1.}];
Do[ If[
(Mod[Round[i/3.^n + 0.5],3]==2 &&
(Mod[Round[j/3.^n + 0.5],3]==2 ||
Mod[Round[k/3.^n + 0.5],3]==2)) ||
(Mod[Round[j/3.^n + 0.5],3]==2 &&
(Mod[Round[i/3.^n + 0.5],3]==2 ||
Mod[Round[k/3.^n + 0.5],3]==2)) ||
(Mod[Round[k/3.^n + 0.5],3]==2 &&
(Mod[Round[i/3.^n + 0.5],3]==2 ||
Mod[Round[j/3.^n + 0.5],3]==2)),
(* then--taking advantage of eightfold symmetry--... *)
(cubmat[[i,j,k]]=0.;
cubmat[[side+1-i,j,k]]=0.;
cubmat[[i, side+1-j,k]]=0.;
cubmat[[i,j,side+1-k]]=0.;
cubmat[[side+1-i, side+1-j,k]]=0.;
cubmat[[side+1-i,j,side+1-k]]=0.;
cubmat[[i, side+1-j, side+1-k]]=0.;
cubmat[[side+1-i,side+1-j,side+1-k]]=0.;)
(* ...no cuboid goes there *)],
{i,(side+1)/2},{j,(side+1)/2},{k,(side+1)/2},
{n,0.,iters-1.}];
faces = {};
(* Instead of using the Cuboid graphics primitive,
we show only the polygons visible from
viewpoints in the default octant. *)
Do[
If[ cubmat[[i,j,k]]==1. && cubmat[[i,j,k+1.]]==0.
(* That is, if a face belongs at {i,j,k}
and there's nothing hiding it, add the
appropriate polygon to the list. *),
AppendTo[ faces,
(* cuboid tops... *)
{{i,j,k+1.},{i,j+1.,k+1.},
{i+1.,j+1.,k+1.},{i+1.,j,k+1.}}
] ],
{i,1.,side},{j,1.,side},{k,1.,side} ];
(* Since the figure looks the same regardless of which axis
is vertical, the polygon-corner list "faces" is computed
only for the tops of the cuboids, then rotated twice to get
lists of sides and fronts. *)
faces = Join[ faces (*tops*),
(*sides *) Map[ RotateLeft[#,2]&,faces,{2}],
(*fronts*) Map[
RotateLeft[#,1]*{1,-1,1}+{0,side+2,0}&,
faces,{2}]
];
Show[Graphics3D[ {EdgeForm[], Map[ Polygon, faces ]}],
Boxed->False];
]
:[font = special1; inactive; preserveAspect]
Construction of the Menger Sponge begins with a solid cube and involves an iterative process of removing parts of this cube. Call the initial cube M0. M1 is obtained by dividing M0 into 27 identical smaller cubes and taking out the center cube and the 6 cubes that represent the middle of each face of MO (for a total of 7 cubes removed). M2 is constructed by repeating the same process (dividing each subcube of M1 into 27 smaller cubes and removing 7 of them). Continuing in this way, we produce a nested sequence of configurations Mn, whose intersection is the limiting sponge, M. M is the self-similar fractal known as the Menger Sponge.
;[s]
15:0,0;149,1;150,2;154,3;155,4;181,5;182,6;305,7;306,8;343,9;344,10;417,11;418,12;539,13;540,14;647,-1;
15:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,64,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect]
The following cells produce successive levels in the construction of the sponge.
:[font = input; preserveAspect]
Sponge[0]
:[font = input; preserveAspect]
Sponge[1]
:[font = input; preserveAspect]
Sponge[2]
:[font = input; preserveAspect; endGroup]
Sponge[3] (* Warning: This picture took 2 minutes, 51 seconds
to generate on an SGI Indy *)
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Dimension
:[font = special1; inactive; preserveAspect]
The Menger Sponge is the union of N=20 essentially disjoint scaled copies of itself, with scaling ratio r=1/3 in the x, y, and z directions. The dimension of M is calculated by the following cell.
:[font = input; preserveAspect; endGroup]
dimension[20,1/3]
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
Volume Measure
:[font = special1; inactive; preserveAspect]
Strangely, the Menger Sponge has a volume measure of zero. That is, the volumes of the parts eliminated in the construction of the sponge sum to as much volume as was originally there. In the first step, we removed 7/27 of the volume. In the next step, we removed 7 sub-subcubes each having volume 1/272 from each of 20 subcubes for a total of 7(20/272) removed. Continuing in this way, we find that the total fraction of the volume removed was
;[s]
5:0,0;306,1;307,2;355,3;356,4;449,-1;
5:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect; center]
7/27 + 7(20/272) + 7(202/273) + ... + 7(20(n-1)/27n) + ...
;[s]
11:0,0;14,1;15,2;23,3;24,4;27,5;28,6;42,7;47,8;50,9;51,10;58,-1;
11:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = special1; inactive; preserveAspect]
The following cell produces a table of partial sums s[n] of this series for n= 5,10,...60.
:[font = input; preserveAspect]
Clear[n,a,k]
a[k_]:=7(20^(k-1)/27^k)
s[n_]:=Sum[a[k],{k,1,n}]//N;
Table[{n,s[n]},{n,5,60,5}]//TableForm
:[font = special1; inactive; preserveAspect]
Clearly, this series converges to 1, so the sponge is left with zero volume. The sum representing the total volume removed could also be calculated analytically using the fact that
:[font = input; preserveAspect; endGroup; endGroup]
1/(1-x) = 1 + x + x2 + ..., if |x|<1.
;[s]
3:0,0;22,1;23,2;43,-1;
3:1,0,0 ,Times,0,14,0,0,0;1,0,0 ,Times,32,14,0,0,0;1,0,0 ,Times,0,14,0,0,0;
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Problems
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
1
:[font = special1; inactive; preserveAspect]
Determine the fractal dimension of the fractal generated by successively removing the open middle one-thirds of the closed intervals at the previous level as indicated by the cell below.
:[font = input; preserveAspect]
Clear[level]
level[0]=Show[
Graphics[Line[{{0,0},{1,0}}]],
Epilog->{
{PointSize[.025],Red,Point[{0,0}]},
{PointSize[.025],Red,Point[{1,0}]},
{Text["0",{0,-.1}]},
{Text["1",{1,-.1}]}
},
DisplayFunction->Identity];
level[1]=Show[
Graphics[{Line[{{0,0},{1/3,0}}],
Line[{{2/3,0},{1,0}}]}],
Epilog->{
{PointSize[.025],Red,Point[{0,0}]},
{PointSize[.025],Red,Point[{1/3,0}]},
{PointSize[.025],Red,Point[{2/3,0}]},
{PointSize[.025],Red,Point[{1,0}]},
{Text["0",{0,-.1}]},
{Text["1/3",{1/3,-.1}]},
{Text["2/3",{2/3,-.1}]},
{Text["1",{1,-.1}]}
},
DisplayFunction->Identity];
level[2]=Show[
Graphics[{
Line[{{0,0},{1/9,0}}],
Line[{{2/9,0},{1/3,0}}],
Line[{{2/3,0},{7/9,0}}],
Line[{{8/9,0},{1,0}}]}],
Epilog->{
{PointSize[.025],Red,Point[{0,0}]},
{PointSize[.025],Red,Point[{1/9,0}]},
{PointSize[.025],Red,Point[{2/9,0}]},
{PointSize[.025],Red,Point[{1/3,0}]},
{PointSize[.025],Red,Point[{2/3,0}]},
{PointSize[.025],Red,Point[{7/9,0}]},
{PointSize[.025],Red,Point[{8/9,0}]},
{PointSize[.025],Red,Point[{1,0}]},
{Text["0",{0,-.1}]},
{Text["1/9",{1/9,.1}]},
{Text["2/9",{2/9,-.1}]},
{Text["1/3",{1/3,.1}]},
{Text["2/3",{2/3,-.1}]},
{Text["7/9",{7/9,.1}]},
{Text["8/9",{8/9,-.1}]},
{Text["1",{1,.1}]}
},
DisplayFunction->Identity];
Show[GraphicsArray[{{level[0]},{level[1]},
{level[2]}}]]
:[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup]
Answer and Discussion
:[font = special1; inactive; preserveAspect]
The fractal constructed as described above is the union of N=2 disjoint copies of the original unit interval that are scaled by a factor of r=1/3. Hence, the dimension is given by
:[font = input; preserveAspect]
dimension[2,1/3]
:[font = special1; inactive; preserveAspect; endGroup; endGroup]
This fractal is called the middle-thirds Cantor set or the Cantor dust. The fractal properties of the Cantor dust are extremely important. It turns out that the sum of the lengths of the open intervals removed in the construction of the dust is exactly 1, yet the remaining set has the same cardinality as the unit interval [0,1]. It's as though we took the whole line out and were left with just as many points as we started with.
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
2
:[font = special1; inactive; preserveAspect]
Determine the fractal dimensions of the fractals generated as indicated below.
:[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup]
a)
:[font = input; preserveAspect]
Clear[level]
level[0]=ListPlot[{
{0,0},{1,0}},
PlotJoined->True,
PlotStyle->{Red,Thickness[.01]},
Ticks->{{{.25,"1/4"},{.5,"1/2"},{.75,"3/4"},{1,"1"}},
{{.25,"1/4"},{-.25,"-1/4"}}},
DisplayFunction->Identity
]
level[1]=ListPlot[{
{0,0},{.25,0},{.25,.25},{.5,.25},{.5,0},{.5,-.25},
{.75,-.25},{.75,0},{1,0}},
PlotJoined->True,
PlotStyle->{Red,Thickness[.01]},
Ticks->{{{.25,"1/4"},{.5,"1/2"},{.75,"3/4"},{1,"1"}},
{{.25,"1/4"},{-.25,"-1/4"}}},
AspectRatio->Automatic,
DisplayFunction->Identity
]
Show[GraphicsArray[{level[0],level[1]},
DisplayFunction->$DisplayFunction]]
:[font = special1; inactive; Cclosed; preserveAspect; startGroup]
Answer:
:[font = special1; inactive; preserveAspect]
N=8, r=1/4, so
:[font = input; preserveAspect; endGroup; endGroup]
dimension[8,1/4]
:[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup]
b)
:[font = input; preserveAspect]
Clear[level]
level[0]=ListPlot[{
{0,0},{1,0}},
PlotJoined->True,
PlotStyle->{Red,Thickness[.01]},
DisplayFunction->Identity
]
level[1]=ListPlot[{
{0,0},{0,1/6},{1/6,1/6},{1/6,1/3},{1/3,1/3},
{1/2,1/3},{1/2,1/6},{1/3,1/6},{1/3,0},{1/2,0},
{2/3,0},{2/3,-1/6},{1/2,-1/6},{1/2,-1/3},{2/3,-1/3},
{5/6,-1/3},{5/6,-1/6},{1,-1/6},{1,0}},
PlotJoined->True,
PlotStyle->{Red,Thickness[.01]},
DisplayFunction->Identity
]
Show[GraphicsArray[{{level[0],level[1]}},
DisplayFunction->$DisplayFunction]]
:[font = special1; inactive; Cclosed; preserveAspect; startGroup]
Answer:
:[font = special1; inactive; preserveAspect]
N=18, r=1/6, so
:[font = input; preserveAspect]
dimension[18,1/6]
:[font = special1; inactive; preserveAspect; endGroup; endGroup; endGroup]
Notice that the fractal generated in b) is more jagged than the one generated in a) and has a correspondingly higher fractal dimension.
:[font = subsection; inactive; Cclosed; preserveAspect; startGroup]
3
:[font = special1; inactive; preserveAspect]
Determine the fractal dimension of the fractal generated as indicated below.
:[font = input; preserveAspect]
Clear[level]
level[0]=Graphics[
Rectangle[{0,0},{1,1}],
AspectRatio->1,
Axes->True,
DisplayFunction->Identity];
level[1]=Graphics[{
Rectangle[{0,0},{1/3,1}],
Rectangle[{2/3,0},{1,1}],
Rectangle[{1/3,2/3},{2/3,1}],
Rectangle[{1/3,0},{2/3,1/3}]},
AspectRatio->1,
Axes->True,
DisplayFunction->Identity]
Show[GraphicsArray[{level[0],level[1]}],
DisplayFunction->$DisplayFunction]
:[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup]
Answer:
:[font = special1; inactive; preserveAspect]
N=8, r=1/3, so
:[font = input; preserveAspect; endGroup; endGroup; endGroup]
dimension[8,1/3]
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Other Fractal Resources
:[font = subsection; inactive; preserveAspect]
Frequently Asked Questions (FAQ) file for the sci.fractals newsgroup
:[font = special1; inactive; preserveAspect]
This file available at ftp://rtfm.mit.edu/pub/usenet/sci.fractals/ provides an excellent introduction to fractal theory and serves as a comprehensive guide to fractal-related books, FTP sites, World Wide Web pages, and mailing lists.
:[font = subsection; inactive; preserveAspect]
Fractals and Chaos by Dr. Richard M. Crownover
;[s]
2:0,0;18,1;46,-1;
2:1,0,0 ,Times,3,14,0,0,0;1,0,0 ,Times,1,14,0,0,0;
:[font = special1; inactive; preserveAspect]
This notebook is based on section 2.1 of Dr. Crownover's book, which is used as the textbook for his Math 316 class at the University of Missouri-Columbia.
:[font = subsection; inactive; preserveAspect]
Fractal Creations, 2nd Ed. by Tim Wegner and Bert Tyler
;[s]
2:0,0;17,1;55,-1;
2:1,0,0 ,Times,3,14,0,0,0;1,0,0 ,Times,1,14,0,0,0;
:[font = special1; inactive; preserveAspect; endGroup]
Wegner and Tyler are two of the programmers of the extremely popular shareware package FractInt. Their book, published by the Waite Group, includes a copy of FractInt v 18.21 and a CD-ROM of fractal images.
^*)