Making Fractals in GeoGebra

Here you can find some hints for making fractals using GeoGebra software. This is how I made the images on my fractal art page.

Many fractals are formed by performing some simple action over and over again, in a sequence of recursive steps. At each step the input is some simple shape – a polygonal curve, say – and the output is some modification of that shape.

The Cantor Set

The most simple example is the Cantor set. Beginning with a line segment, we remove the middle third, resulting in two segments. We repeat this same action on each of these segments, resulting in four. At the next step we have eight, and then sixteen. This continues ad infinitum (or as long as the limitations of our computer will allow).

Click here for an animation.

Let's construct this on GeoGebra. Begin with an arbitrary line segment a. The Point function allows us to select any point along the length of a; Point[a,0] is the initial endpoint, and Point[a,1] is the terminal endpoint. To remove the middle third of a, we replace it with the two segments

Segment[Point[a,0],Point[a,1/3]]

Segment[Point[a,2/3],Point[a,1]]

Note that this amounts to two commands. Think about it. If we go about our process like this, at each step the number of commands will have to double, and the amount of work we're doing will increase at an exponential rate. That's not good! We need a way of performing each step with a single command. But that's easy: use a list. Our command will be

{Segment[Point[a,0],Point[a,1/3]],Segment[Point[a,2/3],Point[a,1]]}

which results in the pair of line segments: {*,*}. Now, at each stage we want the output to have the same form as the input, so we should begin, not with a single line segment, but with a list containing a single line segment: {*}. Then at each stage the input and the output will be lists of segments.

So let's start over: list1 will be the list {a}, and list2 will be

{
     Segment[
          Point[a,0],
          Point[a,1/3]
     ],
     Segment[
          Point[a,2/3],
          Point[a,1]
     ]
}

Then list3 will be created by performing the same action on each of these segments. They aren't named, but we can access them through the Element function. Element[list2,1] is the first segment, and Element[list2,2] is the second. So list3 is

{
     Segment[
          Point[Element[list2,1],0],
          Point[Element[list2,1],1/3]
     ],
     Segment[
          Point[Element[list2,1],2/3],
          Point[Element[list2,1],1]
     ],
     Segment[
          Point[Element[list2,2],0],
          Point[Element[list2,2],1/3]
     ],
     Segment[
          Point[Element[list2,2],2/3],
          Point[Element[list2,2],1]
     ]
}

This accomplishes what we desire, but is still unsatisfactory. The amount of typing is still going to double at each stage if we have to enter the segments by hand. We need a way of making the computer read through them on its own. This can be done with the Sequence command. The entry

Sequence[F(k),k,1,n]

returns the list

{F(1),F(2),…,F(n)}

where F is some function accepting an integer as an argument. In our case, the n should be the number of elements in list2, or Length[list2]. The function should return the pair of segments resulting from removing the middle third from Element[list2,k] for each k, or

{
     Segment[
          Point[Element[list2,k],0],
          Point[Element[list2,k],1/3]
     ],
     Segment[
          Point[Element[list2,k],2/3],
          Point[Element[list2,k],1]
     ]
}

If we use this as our F(k), the output will be of the form {{*,*},{*,*}}. However, we want a list of segments, not a list of pairs of segments. So after running through the sequence we'll apply the Join command, resulting in {*,*,*,*}. Thus:

Join[
     Sequence[
          {
               Segment[
                    Point[Element[list2,k],0],
                    Point[Element[list2,k],1/3]
               ],
               Segment[
                    Point[Element[list2,k],2/3],
                    Point[Element[list2,k],1]
               ]
          },
          k,
          1,
          Length[list2]
     ]
]

So our input should read

list3=Join[Sequence[{Segment[Point[Element[list2,k],0],
Point[Element[list2,k],1/3]],Segment[Point[Element[list2,k],2/3],
Point[Element[list2,k],1]]},k,1,Length[list2]]]

To be consistent, we could start by defining list2 this way:

list2=Join[Sequence[{Segment[Point[Element[list1,k],0],
Point[Element[list1,k],1/3]],Segment[Point[Element[list1,k],2/3],
Point[Element[list1,k],1]]},k,1,Length[list1]]]

Then list3 would be defined as above, and next we would have

list4=Join[Sequence[{Segment[Point[Element[list3,k],0],
Point[Element[list3,k],1/3]],Segment[Point[Element[list3,k],2/3],
Point[Element[list3,k],1]]},k,1,Length[list3]]]

and so on, creating list5, list6, etc. Hide all but the last stage to see a good picture of the Cantor set. (There's not much to see. Although the Cantor set is uncountable, it has measure zero.)

As a fun variation, begin with two concentric circles c = Circle[A,B] and d = Circle[A,C]. Place a point D on c. Let E be the intersection betwee Ray[A,D] and d. Perform the Cantor set construction using a = Segment[D,E]. Hide all but the last list. Set the list to "Trace On," and set D to "Animation On." Does the shape that's traced remind you of anything? (It's been proposed that the Cantor set models the rings of Saturn.)

The Harter-Heighway Dragon Sweep

The dragon sweep is illustrated on my fractal art page; please click here for a description.

Beginning with an "elbow" (a pair of line segments of equal length, sharing a common endpoint, with an angle of 90° between them), we replace the first segment with an "elbow" of the opposite orientation, and the second with an "elbow" of the same orientation, resulting in four segments. Then we repeat the process for these four segments, alternating between the two types of elbows. And so on, ad infinitum. This results in the sweep.

Click here for an animation.

Let's construct the sweep on GeoGebra. We start out with three points A1, A2, and A3 which form a left-handed "elbow" as shown.

We connect them with a polygonal curve (a "polyline"):

step1 = PolyLine[A1,A2,A3]

At each step we begin with such a polyline. We go through the polyline one segment at a time and replace them all with elbows: first a right-handed elbow, then a left-handed elbow, alternating like this until we reach the last segment.

Consider step1. The first vertex of step2 should be A1; let's rename it B1.

B1 = A1

The next vertex is the corner of the right-handed elbow, i.e., the corner of the square with diagonal A1A2. The Pythagorean Theorem tells us that its distance from A1 is 1/sqrt(2) ⋅ A1A2. So to obtain it we rotate A2 clockwise about A2 through an angle of 45° and dilate by a factor of 1/sqrt(2). First we rotate, then we dilate. We'll call this point B2. So

B2 = Dilate[Rotate[A2,315°,A1],1/sqrt(2),A1]

(The Rotate function only accepts positive angle values, so here we rotated counter-clockwise through 315° rather than clockwise through 45°.) The third point is A2:

B3 = A2

The fourth point (the corner of the second elbow) we obtain by rating A3 counter-clockwise about A2 through an angle of 45° and dilating by a factor of 1/sqrt(2):

B4 = Dilate[Rotate[A3,45°,A2],1/sqrt(2),A2]

And the last point is A3:

B5 = A3

So our next iteration is:

step2 = PolyLine[B1,B2,B3,B4,B5]

Let's review:

B1 = A1
B2 = Dilate[Rotate[A2,315°,A1],1/sqrt(2),A1]
B3 = A2
B4 = Dilate[Rotate[A3,45°,A2],1/sqrt(2),A2]
B5 = A3
step2 = PolyLine[B1,B2,B3,B4,B5]

The third polyline is formed in much the same way. Replace B1B2 with a right elbow, B2B3 with a left elbow, B3B4 with a right elbow, B4B5 with a left elbow, as before. So:

C1 = B1
C2 = Dilate[Rotate[B2,315°,B1],1/sqrt(2),B1]
C3 = B2
C4 = Dilate[Rotate[B3,45°,B2],1/sqrt(2),B2]
C5 = B3
C6 = Dilate[Rotate[B4,315°,B3],1/sqrt(2),B3]
C7 = B4
C8 = Dilate[Rotate[B5,45°,B4],1/sqrt(2),B4]
C9 = B5
step3 = PolyLine[C1,C2,C3,C4,C5,C6,C7,C8,C9]

Hopefully now we can start to see a pattern emerging. The goal is to come up with a single command that will take step(n) as its input and yield step(n+1) as its output.

Observe that lines 1 through 4 in the formation of step2 are repeated in lines 1 through 4 and lines 5 through 8 of step3. We would imagine that the same sequence is repeated four times in the formation of step4 (since step3 has four elbows). The sequence looks like this:

D4k-3 = C2k-1
D4k-2 = Dilate[Rotate[C2k,315°,C2k-1],1/sqrt(2),C2k-1]
D4k-1 = C2k
D4k = Dilate[Rotate[C2k+1,45°,C2k],1/sqrt(2),C2k]

This gets repeated four times (for k = 1, 2, 3, 4). Then the last vertex is defined as D17 = C9. Now, we want our input to be step3, not C1 through C9. We can avoid referring to the points by name if we use the Vertex command. For instance, the command

Vertex[step3,n]

returns the nth vertex of the polyline step3, which happens to be Cn. So we can replace our sequence with

Vertex[step3,2k-1]
Dilate[
     Rotate[Vertex[step3,2k],315°,Vertex[step3,2k-1]],
     1/sqrt(2),
     Vertex[step3,2k-1]
]
Vertex[step3,2k]
Dilate[
     Rotate[Vertex[step3,2k+1],45°,Vertex[step3,2k]],
     1/sqrt(2),
     Vertex[step3,2k]
]

We want to repeat this for k = 1, 2, 3, 4. However, the output needs to be a single object, not four objects. So, instead of outputting four points, we output a single sequence of four points:

{
     Vertex[step3,2k-1],
     Dilate[
          Rotate[Vertex[step3,2k],315°,Vertex[step3,2k-1]],
          1/sqrt(2),
          Vertex[step3,2k-1]
     ],
     Vertex[step3,2k],
     Dilate[
          Rotate[Vertex[step3,2k+1],45°,Vertex[step3,2k]],
          1/sqrt(2),
          Vertex[step3,2k]
     ]
}

We do this for k = 1, 2, 3, 4, which is accomplished as follows:

Sequence[{*,*,*,*},k,1,4]

We want our script to work for any step, not just step3. In general, the number of vertices in the polyline step(n) is p = 2n + 1, while the number of times we repeat this sequence in step(n+1) is q = 2n – 1. So

q = (p – 1)/2

Now, m itself is the number of vertices in step(n), which we can get at by using the Vertex function. {Vertex[*]} returns the set of vertices as an ordered list, so

p = Length[{Vertex[step3]}]

q = (Length[{Vertex[step3]}]-1)/2

and our sequence looks like

Sequence[{*,*,*,*},k,1,(Length[{Vertex[step3]}]-1)/2]

This generates a sequence of sequences of points. In the case of step4, it looks like this:

{{D1,D2,D3,D4},{D5,D6,D7,D8},{D9,D10,D11,D12},{D13,D14,D15,D16}}

The function PolyLine takes a sequence of points as its argument, not a sequence of sequences. We could use the Join function to combine these into a single sequence:

Join[{{D1,D2,D3,D4},{D5,D6,D7,D8},{D9,D10,D11,D12},{D13,D14,D15,D16}}]

which would result in

{D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,D16}

But we still need to add D17. We can accomplish this by joining the list {D17}:

Join[{{D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,D16},{D17}}]

Now, D17 is simply the last vertex of step3, so it can be written as

Vertex[step3, Length[{Vertex[step3]}]]

We're ready to form our polyline. Thus:

PolyLine[
     Join[
          {
               Join[
                    Sequence[
                         {
                              Vertex[step3,2k-1],
                              Dilate[
                                   Rotate[Vertex[step3, 2k], 315°,Vertex[step3, 2k - 1]],
                                   1/sqrt(2),
                                   Vertex[step3,2k-1]
                              ],
                              Vertex[step3, 2k],
                              Dilate[
                                   Rotate[Vertex[step3, 2k+1],45°,Vertex[step3, 2k]],
                                   1/sqrt(2),
                                   Vertex[step3,2k]
                               ]
                          },
                         k,
                         1,
                         (Length[{Vertex[step3]}] - 1)/2
                    ]
               ],
               {
                    Vertex[step3, Length[{Vertex[step3]}]]
               }
          }
     ]
]

All together, our input is

step4=PolyLine[Join[{Join[Sequence[{Vertex[step3,2k-1],
Dilate[Rotate[Vertex[step3,2k],315°,Vertex[step3,2k-1]],
1/sqrt(2),Vertex[step3,2k-1]],Vertex[step3,2k],
Dilate[Rotate[Vertex[step3,2k+1], 45°,Vertex[step3,2k]],
1/sqrt(2),Vertex[step3,2k]]},k,1,(Length[{Vertex[step3]}]-1)/2]],
{Vertex[step3,Length[{Vertex[step3]}]]}}]]

To perform the next step, simply replace step3 with step4. And so on.

Michael Ortiz, Ph.D.
Associate Professor of Mathematics
Department of Natural and Behavioral Sciences

Sul Ross State University Rio Grande College

About | Courses | Resources | Philosophy | Art

Mathematical Miscellany

Copyright © 2017 Michael Luis Ortiz. All rights reserved.