Hilbert's Space-Filling Curve

    In the early 1890's, Peano and Hilbert surprised the mathematical community by producing continuous functions which map the unit interval onto the unit square.  This is surprising because it seems that the two dimensional unit square is so much larger than the one dimensional unit interval.  Hilbert's curve is a function of a single real variable whose domain is and whose range is [0,1]x[0,1].  We may write   It turns out that the coordinate functions, and , form a pair of digraph self-affine sets.  They may be generated as follows.

Needs["DigraphFractals`"]; 

A = {{1/4, 0}, {0, 1/2}}; 
B = {{1/4, 0}, {0, -1/2}}; 
f1 = {A, {0, 0}}; f2 = {A, {1/4, 0}}; 
f3 = {A, {1/2, 1/2}}; f4 = {B, {3/4, 1}}; 
g1 = {A, {0, 0}}; g2 = {A, {1/4, 1/2}}; 
g3 = {A, {1/2, 1/2}}; g4 = {B, {3/4, 1/2}}; 
hilbertCurves = {{{f2, f3}, {f1, f4}}, 
    {{g1, g4}, {g2, g3}}}; 
initiators = {{Line[{{0, 0}, {1, 1}}]}, 
    {Line[{{0, 0}, {1, 0}}]}}; 
Show[GraphicsArray[
    ShowDigraphFractals[hilbertCurves, 6, 
        Initiators -> initiators, Axes -> True,
        DisplayFunction -> Identity]]];

We can illustrate the action of the digraph IFS nicely using the following initiators.

initiators = 
    {{ 
    {GrayLevel[.7], 
        Polygon[{{0,0},{1,0}, {1,1}, {0,1}}]},
    Line[{{0,0},{1,0}, {1,1}, {0,1},{0,0}}],
    {Thickness[.008], 
        Line[{{1/3,1/4},{2/3,3/4}}], 
        Line[{{1/3,3/4},{2/3,1/4}}], 
        Line[{{1/4,1/4},{3/4,1/4}}]}}, 
    {{ 
    {GrayLevel[.7], 
        Polygon[{{0,0},{1,0}, {1,1}, {0,1}}]},
    {Thickness[.008], 
        Line[{{1/3,3/4},{1/2,1/2}, {2/3,3/4}}], 
        Line[{{1/2,1/2},{1/2,1/4}}], 
        Line[{{1/4,1/4},{3/4,1/4}}]},
        Line[{{0,0},{1,0}, {1,1}, {0,1},{0,0}}]}}};
Show[GraphicsArray[
    Graphics[#,AspectRatio -> Automatic,Axes -> True]& /@ 
    initiators]];

The action of the digraph IFS may now be easily discerned from the following image

Show[GraphicsArray[
    ShowDigraphFractals[hilbertCurves,1,
    Initiators -> initiators, Axes -> True,
    DisplayFunction -> Identity]]];

    For those familiar with Hilbert's curve, here a graphical argument to convince you that these are indeed the coordinate functios to his curve.  We first generate approximations to our curves using carefully chosen initiators.

twoPoints = {{Point[{1/2, 1/2}]}, {Point[{1/2, 1/2}]}};
approximations = ShowDigraphFractals[hilbertCurves, 4, 
    Initiators -> twoPoints, DisplayFunction -> Identity]; 

We can get the actual points as follows

graphPoints = (Cases[#1, _Point, Infinity] & ) /@ 
    approximations /. Point[x_] -> x; 

We then sort these points, collect a list of versus , and draw a polygonal line through the resulting list of points.  The result is a familiar approximation to Hilbert's curve.

sortedGraphPoints = (Sort[#1, First[#1] < First[#2] &]&) /@
    graphPoints; 
curvePoints = Transpose[sortedGraphPoints /. 
    {x_Real, y_Real} -> y];
Show[Graphics[Line[curvePoints]], 
    AspectRatio -> Automatic];