Fractal Samples

Renan Cabrera 
Academia Nacional de Ciencias de Bolivia

renanbo@hotmail.com
rencabla@ceibo.entelnet.bo
La Paz Bolivia -2000

Abstract
This document contains famous fractal graphics such as a Tree Fractal in 
two dimensions, the Tree Fractal in three dimension, the Gasket , Koch  and finally the Mandelbrot Fractal.

A Tree in Two Dimensions

A tree in two dimensions can be described by two parameters

θ = Angle between branches.
ϵ = Scale factor.
n = Deepness.

Where n was added as a limit recursion.

\(Rot2D[t_] = {{Cos[t], Sin[t]}, {\(-Sin[t]\), Cos[t]}}; 

    \(NextBranches[θ_, ϵ_]\)[\ \ Branch[r1_List, r0_List]\ \ ]
         := 
	Module[{r, α}, 
		\ r\  = \ r1 - r0; 

        \ 	{	Branch[\ r1 + \ \ ϵ*Rot2D[θ].r\ , r1]		, 

            			Branch[\ r1 + \ \ ϵ*Rot2D[\(-θ\)].r\ , r1]
              		}		 // N
		]
\)\(\(NextBranches[θ_, ϵ_]\)[w_List] := \ 
      Map[NextBranches[θ, ϵ], w]; 


    Tree2D[θ_, ϵ_, r_List, n_] := \ 

      NestList[NextBranches[θ, ϵ], Branch[r, {0, 0}]\ , \ n]
           /. Branch[x__] :> Line[{x}]\)

Lets see a particular example with
θ = (π/8)
ϵ = 0.7
n = 5
and initial branch  r = {0,1}

\(\(
Show[Graphics[
		Tree2D[π\/8, 0.7, {0, 1}, 5]
	], 
      PlotRange -> {0, 3}, AspectRatio -> Automatic]\)\)

A Tree in Three Dimensions

A more satisfactory tree grows up in three dimensions with parameters:
α = Branch Angle
ϵ = Scale Factor
m = Number of Branches from previous branch.
n = Deepness

\(Rotz[t_] = {{Cos[t], Sin[t], 0}, {\(-Sin[t]\), Cos[t], 0}, {0, 0, 1}}; 
    
Roty[t_]\  = \ 

      \ {\ {Cos[t], 0, \(-Sin[t]\)}, {0, 1, 0}, {Sin[t], 0, Cos[t]}}; 


    Rot3D[ψ_, θ_] = \ Roty[θ].Rotz[ψ]; 


    SphericalCoordinates[{x_, y_, z_}] = 
      \ {\ Sqrt[x^2 + y^2 + z^2], ArcTan[z, Sqrt[x^2 + z^2]]\ , \ 
        ArcTan[x, y]}; \)

\(\(NextBranches[α_, ϵ_, m_]\)[\ \ 
        Branch[r1_List, r0_List]\ \ ] := 
	
      Module[{r, ψ, θ}, 

        	{r, θ, ψ}\  = \ SphericalCoordinates[r1 - r0]; 
		
        Table[
Branch[
				
              r1 + ϵ*r
                  \ {Sin[α] Cos[φ], 
                      Sin[α] Sin[φ], Cos[α]}.Rot3D[
                      ψ, θ], r1]

            		, {φ, 0, 2  Pi, \(2  Pi\)\/m}] // N

        		\ \ \ \ \ \ \ \ \ \ \ ]
\)\(\(NextBranches[α_, ϵ_, m_]\)[w_List] := \ 
      Map[NextBranches[α, ϵ, m], w]; 


    Tree2D[α_, ϵ_, m_, r_List, n_] := \ 

      NestList[NextBranches[α, ϵ, m], Branch[r, {0, 0, 0}]\ , 
          \ n] /. Branch[x__] :> Line[{x}]\)

And the graph is the following

\(Show[
      Graphics3D[


        Tree2D[α, ϵ, m, r, n] /. 

          			{α -> Pi/8, ϵ -> 0.6, m -> 5, \ 
            r -> \ {0.01, 0, 1}, n -> 4}
	
], AspectRatio -> Automatic, 
      PlotRange -> {{\(-1\), 1}, {\(-1\), 1}, {0, 2.5}}, 
	
      ViewPoint -> {3.369, \ \(-0.040\), \ 0.312}]\)

But we can still give it more life by putting color, thickness and a middle branch.

\(Rotz[t_] = {{Cos[t], Sin[t], 0}, {\(-Sin[t]\), Cos[t], 0}, {0, 0, 1}}; 
    
Roty[t_]\  = \ 

      \ {\ {Cos[t], 0, \(-Sin[t]\)}, {0, 1, 0}, {Sin[t], 0, Cos[t]}}; 

    Rot3D[ψ_, θ_] = \ Roty[θ].Rotz[ψ]; 

    SphericalCoordinates[{x_, y_, z_}] = 
      \ {\ Sqrt[x^2 + y^2 + z^2], ArcTan[z, Sqrt[x^2 + z^2]]\ , \ 
        ArcTan[x, y]}; \)

\(\(NextBranches[α_, ϵ_, m_]\)[\ \ 
        Branch[r1_List, r0_List, th_]\ \ ] := 
	
      Module[{r, ψ, θ}, 

        	{r, θ, ψ}\  = \ SphericalCoordinates[r1 - r0]; 

        		{Branch[ϵ*\((r1 - r0)\) + r1, r1, ϵ*th], 
            Sequence@@
              Table[
Branch[
				
                  r1 + ϵ*r
                      \ {Sin[α] Cos[φ], 
                          Sin[α] Sin[φ], 
                          Cos[α]}.Rot3D[ψ, θ], r1, 
                  ϵ*th]

                		, {φ, 0, 2  Pi, \(2  Pi\)\/m}]} // N

        		\ \ \ \ \ \ \ \ \ \ \ ]
\)\(\(NextBranches[α_, ϵ_, m_]\)[w_List] := \ 
      Map[NextBranches[α, ϵ, m], w]; 


    Tree2D[α_, ϵ_, m_, r_List, th_, n_] := \ 

      NestList[NextBranches[α, ϵ, m], 
          Branch[r, {0, 0, 0}, 1]\ , \ n] /. 
        Branch[r1_, r0_, t_] :> {RGBColor[0, \ 0.6 \((1 - t)\) + 0.4, \ 0], 
            Thickness[th*t], Line[{r1, r0}]}\)

\(Show[
      Graphics3D[


        Tree2D[α, ϵ, m, r, th0, n] /. 

          			{α -> Pi/8, ϵ -> 0.6, m -> 5, \ 
            r -> \ {0.01, 0, 1}, n -> 4, th0 -> 0.03}
	
], 
      AspectRatio -> Automatic, 
      PlotRange -> {{\(-1\), 1}, {\(-1\), 1}, {0, 2.5}}, 
	
      ViewPoint -> {3.369, \ \(-0.040\), \ 0.312}]\)

Gasket Fractal

The Gasket Fractal is very simple and has only as a parameter the deepness "n".

\(\(NextTri[\ Tri[r0_, r1_, r2_]\ ] := 
      		{Tri[r0, \((r0 + r1)\)/2, \((r0 + r2)\)/2], 
			
          Tri[\((r0 + r1)\)/2, r1, \((r1 + r2)\)/2], 
			
          Tri[\((r0 + r2)\)/2, \((r1 + r2)\)/2, r2]} // N
		\)\)

\(\(
NextTri[T_List]\  := \ Map[\ NextTri\ , T]; 


    Gasket[n_] := \ 
      Nest[NextTri, Tri[{0, 0}, {1/2, \@3\/2}, {1, 0}], n] /. \ 
        Tri[w__] -> Polygon[{w}]\)\)

Show[Graphics[Gasket[2]], AspectRatio -> Automatic]

Show[Graphics[Gasket[4]], AspectRatio -> Automatic]

Show[Graphics[Gasket[6]], AspectRatio -> Automatic]

Koch Fractal

Koch gives the points of the snowflake up to deep "n" and the second argument has a form  SnowFlake[{x0,y0},{x1,y1}] or a list of this form as initial points.

Koch[ n , SnowFlake[ {x0,y0},{x1,y1} ]

\(Rot2D[x_, y_] = 
      Module[{c, s}, 
		c\  = \ x/Sqrt[x^2 + y^2]; 
		
        s\ \  = y/Sqrt[x^2 + y^2]; 
		{{c, \(-s\)}, {s, c}}]; 

    ProfileSnow\  = \ 
      
{{0, 0}, {1/3, 0}, {1/2, Sqrt[3]/6}, {2/3, 0}, {1, 0}}; \)

\(NextSnowFlake[\ \ SnowFlake[r0_, r1_]\ \ ] := 
	
      Module[{x, y, θ, NewProfileSnow}, 
{x, y} = r1 - r0; 
\ \ 
        r\  = 	Sqrt[x^2 + y^2]; 

        NewProfileSnow\  = \ \ 
          Map[\ r0 + \ r*Rot2D[x, y].\ #\ &\ , \ ProfileSnow] // N; 
		

        Map[\ SnowFlake@@#\ &\ , Partition[\ NewProfileSnow, 2, 1]]
				
        
		\ ]
\)\(NextSnowFlake[w_List] := \ Map[NextSnowFlake, w]; 


    Koch[n_, SF_]\  := \ 
      Nest[NextSnowFlake, SF, n] /. SnowFlake[x__] -> Line[{x}]\)

\(Show[Graphics[
Koch[1, SnowFlake[{0, 0}, {1, 0}]]
		], 
      AspectRatio -> Automatic]\)

\(Show[Graphics[
Koch[3, SnowFlake[{0, 0}, {1, 0}]]
		], 
      AspectRatio -> Automatic]\)

\(Show[Graphics[
Koch[5, SnowFlake[{0, 0}, {1, 0}]]
		], 
      AspectRatio -> Automatic]\)

Now a little bit different versions with the help of the function InitPolygon[ n ]  which generates the initial SnowFlake as a n-side regular polygon :

\(InitPolygon[n_] := 
      Module[{u, vert}, 
		u\  = \ {Cos[\(-t\)], Sin[\(-t\)]}; 
		
        vert = \ Table[u, {t, 0, 2  Pi, 2  Pi/n}] // N; 
\ \ \ \ 
        Map[	SnowFlake@@#&	, Partition[vert, 2, 1]]
		]\)

\(Show[Graphics[
Koch[5, InitPolygon[3]]
		], 
      AspectRatio -> Automatic]\)

\(Show[Graphics[
Koch[4, InitPolygon[5]]
		], 
      AspectRatio -> Automatic]\)

Mandelbrot Fractal

Here the Mandelbrot has only the boundaries as parameters.

Mandelbrot[{y0 , y1,  dy},{x0 ,x1 , dx}]

\(\(NextStep[a_, b_]\)[{x_, y_, n_}] = 
	
      If[\ x^2 + y^2\ \  > 4\  || \ n > 20\ 
		, 
          Throw[Sqrt[x^2 + y^2]], {x^2 - y^2 + a, 2*x*y + b, n + 1}] // N; 

    
Mandelbrot[{x0_, x1_, dx_}, {y0_, y1_, dy_}] := \ 
      Module[{Mat}, 

        Mat\  = Table[
\ Catch[FixedPoint[NextStep[a, b], \ {0, 0, 0}\ ]]

            \ \ \ \ \ \ \ \ \ \ \ , {a, x0, x1, dx}, {b, y0, y1, dy}]; 

        Map[\ If[# > 2, 1, 0]&, \ Mat\ , {2}\ ]		
	]\)

\(ListDensityPlot[
Mandelbrot[{\(-2\), 0.6, 0.01}, {\(-1\), 1, 0.01}]
, 
      Mesh -> False, AspectRatio -> Automatic]\)