Sierpinski Curves

Space-filling Curves

Schematic Description

Sn

An <down-right> Bn <down-left> Cn <up-left> Dn <up-right>

An

An-1 <down-right> Bn-1 <double-right> Dn-1 <up-right> An-1

Bn

Bn-1 <down-left> Cn-1 <double-down> An-1 <down-right> Bn-1

Cn

Cn-1 <up-left> Dn-1 <double-left> Bn-1 <down-left> Cn-1

Dn

Dn-1 <up-right> An-1 <double-up> Cn-1 <up-left> Dn-1

A0, B0, C0, and D0 are null figures/motions.

Global Variables

The current x and y coordinates

cx = 0;
cy = 0;

Mathematica symbols that need redefinition

Unprotect[C]; Clear[C];

Unprotect[D]; Clear[D];

Unprotect[Left]; Clear[Left];

Unprotect[Right]; Clear[Right];

Helper Functions

Down-Left

DownLeft[len_] := Module[{x2,y2,plt},
     x2 = N[cx - len*Sqrt[2]/2];
     y2 = N[cy - len*Sqrt[2]/2];
     plt = Graphics[Line[{{cx,cy},{x2,y2}}]];
     cx = x2;
     cy = y2;
     Return[plt]
 ]

Up-Left

UpLeft[len_] := Module[{x2,y2,plt},
     x2 = N[cx - len*Sqrt[2]/2];
     y2 = N[cy + len*Sqrt[2]/2];
     plt = Graphics[Line[{{cx,cy},{x2,y2}}]];
     cx = x2;
     cy = y2;
     Return[plt]
 ]

Down-Right

DownRight[len_] := Module[{x2,y2,plt},
     x2 = N[cx + len*Sqrt[2]/2];
     y2 = N[cy - len*Sqrt[2]/2];
     plt = Graphics[Line[{{cx,cy},{x2,y2}}]];
     cx = x2;
     cy = y2;
     Return[plt]
 ]

Up-Right

UpRight[len_] := Module[{x2,y2,plt},
     x2 = N[cx + len*Sqrt[2]/2];
     y2 = N[cy + len*Sqrt[2]/2];
     plt = Graphics[Line[{{cx,cy},{x2,y2}}]];
     cx = x2;
     cy = y2;
     Return[plt]
 ]

Left

Left[len_] := Module[{x2,plt},
     x2 = N[cx - len];
     plt = Graphics[Line[{{cx,cy},{x2,cy}}]];
     cx = x2;
     Return[plt]
 ]

Up

Up[len_] := Module[{y2,plt},
     y2 = N[cy + len];
     plt = Graphics[Line[{{cx,cy},{cx,y2}}]];
     cy = y2;
     Return[plt]
 ]

Down

Down[len_] := Module[{y2,plt},
     y2 = N[cy - len];
     plt = Graphics[Line[{{cx,cy},{cx,y2}}]];
     cy = y2;
     Return[plt]
 ]

Right

Right[len_] := Module[{x2,plt},
     x2 = N[cx + len];
     plt = Graphics[Line[{{cx,cy},{x2,cy}}]];
     cx = x2;
     Return[plt]
 ]

The Recursive Functions

An

An-1 <down-right> Bn-1 <double-right> Dn-1 <up-right> An-1

A[n_,len_] := Module[{plt={}},
   If[n==0,Return[plt]];
   AppendTo[plt,A[n-1,len]];
   AppendTo[plt,DownRight[len]];
   AppendTo[plt,B[n-1,len]];
   AppendTo[plt,Right[2*len]];
   AppendTo[plt,D[n-1,len]];
   AppendTo[plt,UpRight[len]];
   AppendTo[plt,A[n-1,len]];
   Return[plt]
]

Bn

Bn-1 <down-left> Cn-1 <double-down> An-1 <down-right> Bn-1

B[n_,len_] := Module[{plt={}},
   If[n==0,Return[plt]];
   AppendTo[plt,B[n-1,len]];
   AppendTo[plt,DownLeft[len]];
   AppendTo[plt,C[n-1,len]];
   AppendTo[plt,Down[2*len]];
   AppendTo[plt,A[n-1,len]];
   AppendTo[plt,DownRight[len]];
   AppendTo[plt,B[n-1,len]];
   Return[plt]
]

Cn

Cn-1 <up-left> Dn-1 <double-left> Bn-1 <down-left> Cn-1

C[n_,len_] := Module[{plt={}},
   If[n==0,Return[plt]];
   AppendTo[plt,C[n-1,len]];
   AppendTo[plt,UpLeft[len]];
   AppendTo[plt,D[n-1,len]];
   AppendTo[plt,Left[2*len]];
   AppendTo[plt,B[n-1,len]];
   AppendTo[plt,DownLeft[len]];
   AppendTo[plt,C[n-1,len]];
   Return[plt]
]

Dn

Dn-1 <up-right> An-1 <double-up> Cn-1 <up-left> Dn-1

D[n_,len_] := Module[{plt={}},
   If[n==0,Return[plt]];
   AppendTo[plt,D[n-1,len]];
   AppendTo[plt,UpRight[len]];
   AppendTo[plt,A[n-1,len]];
   AppendTo[plt,Up[2*len]];
   AppendTo[plt,C[n-1,len]];
   AppendTo[plt,UpLeft[len]];
   AppendTo[plt,D[n-1,len]];
   Return[plt]
]

Sn

An <down-right> Bn <down-left> Cn <up-left> Dn <up-right>

There are 2n+1 diagonal segments and 2n+1 - 2  horizontal/vertical segments per side of the unit square. Each
line segment has length 1/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2).

S[n_] := Module[{plt,len},
    (* initialize plt as a box around the curve *)
    plt={Graphics[{GrayLevel[.6666], 
         Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
        GrayLevel[0]}]};
   len = 1.0/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2);
   cx = len*Sqrt[2]/2;
   cy = 1;
   AppendTo[plt,A[n,len]];
   AppendTo[plt,DownRight[len]];
   AppendTo[plt,B[n,len]];
   AppendTo[plt,DownLeft[len]];
   AppendTo[plt,C[n,len]];
   AppendTo[plt,UpLeft[len]];
   AppendTo[plt,D[n,len]];
   AppendTo[plt,UpRight[len]];
   Show[plt,AspectRatio->1]
]

Showing the Component Curves

There are 2n+1 diagonal segments and 2n+1 - 2  horizontal/vertical segments per side of the unit square. Each
line segment has length 1/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2).

An

ShowAn[n_] := Module[{plt,len},
   If[n==0,Return[]];
   (* initialize plt as a box around the curve *)
    plt={Graphics[{GrayLevel[.6666], 
         Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
        GrayLevel[0]}]};
   len = 1.0/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2);
   cx = len*Sqrt[2]/2;
   cy = 1;
   Show[plt,A[n,len],AspectRatio->1,PlotRange->All]
]

Bn

ShowBn[n_] := Module[{plt,len},
   If[n==0,Return[]];
   (* initialize plt as a box around the curve *)
    plt={Graphics[{GrayLevel[.6666], 
         Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
        GrayLevel[0]}]};
   len = 1.0/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2);
   cx = 1;
   cy = 1 - len*Sqrt[2]/2;
   Show[plt,B[n,len],AspectRatio->1,PlotRange->All]
]

Cn

ShowCn[n_] := Module[{plt,len},
   If[n==0,Return[]];
   (* initialize plt as a box around the curve *)
    plt={Graphics[{GrayLevel[.6666], 
         Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
        GrayLevel[0]}]};
   len = 1.0/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2);
   cx = 1 - len*Sqrt[2]/2;
   cy = 0;
   Show[plt,C[n,len],AspectRatio->1,PlotRange->All]
]

Dn

ShowDn[n_] := Module[{plt,len},
   If[n==0,Return[]];
   (* initialize plt as a box around the curve *)
    plt={Graphics[{GrayLevel[.6666], 
         Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
        GrayLevel[0]}]};
   len = 1.0/(2^(n+1) Sqrt[2]/2 + 2^(n+1) - 2);
   cx = 0;
   cy = len*Sqrt[2]/2;
   Show[plt,D[n,len],AspectRatio->1,PlotRange->All]
]

The Curves

S[6] is an upper limit on the time and memory available

S0

S[0]

S1

S[1]

S2

S[2]

S3

S[3]

S4

S[4]

S5

S[5]

S6

S[6]

The Helper Curves

An

ShowAn[1]

ShowAn[2]

Bn

ShowBn[3]

Cn

ShowCn[2]

Dn

ShowDn[4]