Message Boards Message Boards

GROUPS:

Fractal curves at rational points & similarly recursively-defined functions

Posted 2 years ago
2248 Views
|
0 Replies
|
7 Total Likes
|

Here is a function Julian Ziegler Hunts wrote to evaluate fractal curves at rational points and similarly recursively-defined functions. Usually dragon curves, Hilbert curves, etc. and their inverses.

ClearAll[piecewiserecursivefractal]; 
piecewiserecursivefractal[x_, f_, which_, iters_, fns_] := 
 piecewiserecursivefractal[x, g_, which, iters, 
   fns] = ((piecewiserecursivefractal[x, h_, which, iters, fns] := 
     Block[{y}, y /. Solve[f[y] == h[y], y]]); 
   Union @@ ((fns[[#]] /@ 
         piecewiserecursivefractal[iters[[#]][x], 
          Composition[f, fns[[#]]], which, iters, fns]) & /@ which[x]));

But most remarkable is piecewiserecursivefractal ability to invert fractals--e.g., tell you all the pre-images of a point near or on the "Dragon Curve". Imagine writing a function that can even tell whether some point is inside or outside that infinitely curly boundary. If we define trifil as the usual recursive quadrisection:

Clear@trifil; 
trifil[t_] := piecewiserecursivefractal[t, 
  Identity, {Min[4, 1 + Floor[4*#]]} &, {4*# &, 2 - 4*# &, 4*# - 2 &, 
   4 - 4*# &}, {#/2 &, (#/I^(2/3) + I^(2/3))/2 &, (# + I^(2/3))/2 &, 
   1 + #*I^(4/3)/2 &}]

we can get a weird (slightly spazzed) triangle fill, which is an unsuccessful attempt at a space-fill with a sextuple point. But I expect to find one.

Graphics[Riffle[Hue /@ Range[0, 15/7, 1/7], 
  Line /@ mapthread[Append[#1, #2[[1]]] &, {#, Append[Rest[#], Last[#]]}] &@
   Partition[ReIm@Flatten[trifil /@ Range[1/4096, 4095/4096, 1/2048]],128]]]

enter image description here

Using a 25-way conditional, Julian found a space-fill with sextuple points, as suggested by this schematic:

enter image description here

The confusing term "spacefilling curve" leads many to believe it means a diagram like this. This diagram is just a schematic for constructing a spacefilling function, a much more wonderful object that continuously maps closed intervals onto closed areas of the complex plane. A spacefilling function not only hits all the points in an area, it hits a dense subset of them at least three times. Julian's spacefill hits a dense set six times! And his piecewiserecursivefractal Mathematica function can find all six pre-images of each sextuple point:

untrifil25[1/2 + I Sqrt[3]/10]
Out[]= {8/75, 11/75, 14/75, 17/75, 4/15, 23/75}

where:

Clear@untrifil25;
untrifil25[t_] := 
 piecewiserecursivefractal[t, Identity, 
  If[0 <= Re[#1] <= 1 && 0 <= Im[#1] <= Sqrt[3]/2, {1, 2, 3, 4, 5, 6, 
     7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 
     24, 25}, {}] &, {5 #1 &, 
    1/4 (6 - 2 I Sqrt[3] - 10 #1 + 10 I Sqrt[3] #1) &, 
    1/4 (-4 I Sqrt[3] + 10 #1 + 10 I Sqrt[3] #1) &, -2 + 5 #1 &, 
    1/4 (-6 + 6 I Sqrt[3] + 10 #1 - 10 I Sqrt[3] #1) &, 
    1/4 (4 + 8 I Sqrt[3] - 10 #1 - 10 I Sqrt[3] #1) &, 
    3 + I Sqrt[3] - 5 #1 &, 
    1/4 (10 - 2 I Sqrt[3] - 10 #1 + 10 I Sqrt[3] #1) &, 
    1/2 (3 + I Sqrt[3] - 10 #1) &, 
    1/4 (8 - 10 #1 + 10 I Sqrt[3] #1) &, 
    2 + I Sqrt[3] - 5 #1 &, -2 - I Sqrt[3] + 5 #1 &, 
    1/4 (4 - 8 I Sqrt[3] + 10 #1 + 10 I Sqrt[3] #1) &, 
    1/4 (-10 + 2 I Sqrt[3] + 10 #1 - 10 I Sqrt[3] #1) &, 
    1/4 (-2 + 6 I Sqrt[3] - 10 #1 - 10 I Sqrt[3] #1) &, 
    1/4 (16 - 10 #1 + 10 I Sqrt[3] #1) &, -2 - 2 I Sqrt[3] + 5 #1 &, 
    1/4 (-14 + 2 I Sqrt[3] + 10 #1 - 10 I Sqrt[3] #1) &, 
    1/2 (-3 I Sqrt[3] + 5 (-1 + 2 #1)) &, 
    1/4 (16 - 4 I Sqrt[3] - 10 #1 + 10 I Sqrt[3] #1) &, 
    4 + I Sqrt[3] - 5 #1 &, 
    1/4 (6 + 10 I Sqrt[3] - 10 #1 - 10 I Sqrt[3] #1) &, 
    1/2 (9 + I Sqrt[3] - 10 #1) &, 
    1/4 (8 + 8 I Sqrt[3] - 10 #1 - 10 I Sqrt[3] #1) &, -4 + 
      5 #1 &} /. 
   f : Function@_ :> 
    MapAt[Simplify, f, 1], {#1/25 &, (2 - #1)/25 &, (2 + #1)/
     25 &, (3 + #1)/25 &, (4 + #1)/25 &, (5 + #1)/25 &, (6 + #1)/
     25 &, (7 + #1)/25 &, (8 + #1)/25 &, (10 - #1)/25 &, (11 - #1)/
     25 &, (11 + #1)/25 &, (13 - #1)/25 &, (14 - #1)/25 &, (14 + #1)/
     25 &, (16 - #1)/25 &, (16 + #1)/25 &, (18 - #1)/25 &, (18 + #1)/
     25 &, (19 + #1)/25 &, (21 - #1)/25 &, (22 - #1)/25 &, (22 + #1)/
     25 &, (24 - #1)/25 &, (24 + #1)/25 &}]

The image of [2/25,8/25] fills a hexagon:

Graphics[Polygon[ReIm[trifil25 /@ Range[2/25, 8/25 - 1/3125, 1/3125]]]]

enter image description here

where:

Clear@trifil25; 
trifil25[t_] := 
 piecewiserecursivefractal[t, Identity, 
   Piecewise[{{{1}, #1 == 0}, {{Ceiling[25*#1]}, 
       Inequality[0, Less, #1, LessEqual, 1]}}, {}] &, {25*#1 + 
      0 &, -25*#1 + 2 &, 25*#1 - 2 &, 25*#1 - 3 &, 25*#1 - 4 &, 
    25*#1 - 5 &, 25*#1 - 6 &, 25*#1 - 7 &, 
    25*#1 - 8 &, -25*#1 + 10 &, -25*#1 + 11 &, 
    25*#1 - 11 &, -25*#1 + 13 &, -25*#1 + 14 &, 
    25*#1 - 14 &, -25*#1 + 16 &, 25*#1 - 16 &, -25*#1 + 18 &, 
    25*#1 - 18 &, 25*#1 - 19 &, -25*#1 + 21 &, -25*#1 + 22 &, 
    25*#1 - 22 &, -25*#1 + 24 &, 
    25*#1 - 24 &}, {#1/
       5 &, (1/10)*(3 + I*Sqrt[3] + (-1 - I*Sqrt[3])*#1) &, (1/
         10)*(3 + I*Sqrt[3] + #1 - I*Sqrt[3]*#1) &, (2 + #1)/
       5 &, (1/10)*(6 + #1 + I*Sqrt[3]*#1) &, (1/10)*(7 + I*Sqrt[3] + 
         I*(I + Sqrt[3])*#1) &, (1/5)*(3 + I*Sqrt[3] - #1) &, (1/
         10)*(4 + 2*I*Sqrt[3] + (-1 - I*Sqrt[3])*#1) &, (1/10)*(3 + 
         I*Sqrt[3] - 2*#1) &, (-(1/10))*
       I*(-I + Sqrt[3])*(-2 + #1) &, (1/5)*(2 + I*Sqrt[3] - #1) &, (1/
         5)*(2 + I*Sqrt[3] + #1) &, (1/10)*(5 + 3*I*Sqrt[3] + #1 - 
         I*Sqrt[3]*#1) &, (1/10)*(4 + 2*I*Sqrt[3] + #1 + 
         I*Sqrt[3]*#1) &, (1/10)*(4 + 2*I*Sqrt[3] + 
         I*(I + Sqrt[3])*#1) &, (-(1/10))*
       I*(-I + Sqrt[3])*(-4 + #1) &, (1/5)*(2 + 
         2*I*Sqrt[3] + #1) &, (1/10)*(5 + 3*I*Sqrt[3] + #1 + 
         I*Sqrt[3]*#1) &, (1/10)*(5 + 3*I*Sqrt[3] + 2*#1) &, (1/
         10)*(7 + 3*I*Sqrt[3] + (-1 - I*Sqrt[3])*#1) &, (1/5)*(4 + 
         I*Sqrt[3] - #1) &, (1/10)*(9 + I*Sqrt[3] + 
         I*(I + Sqrt[3])*#1) &, (1/10)*(9 + I*Sqrt[3] - 2*#1) &, (1/
         10)*(8 + I*(I + Sqrt[3])*#1) &, (4 + #1)/5 &} /. 
    f : (_ &) :> MapAt[Simplify, f, 1]][[1]]

​Sextuple points:

In[35]:= trifil25[4/15]
Out[35]= 1/10 (5 + I Sqrt[3])

In[36]:= untrifil25[%/5]
Out[36]= {8/1875, 11/1875, 14/1875, 17/1875, 4/375, 23/1875}

Near 1/π:

In[37]:= trifil25[113/355]
Out[37]= (7 (291312775 + 106362056 I Sqrt[3]))/6105469375

In[38]:= untrifil25@%
Out[38]= {113/355}

Here's a sampling with small dinosaurs surrounding a ghostly hexagon at an odd angle:

enter image description here

Here are some beat frequency effects:

enter image description here

And a remarkably celebratory finale:

enter image description here

Attached is also an example where piecewiserecursivefractal defines the Hilbert space-fill, (t:[0,1]->[0,1]×[0,i] which encloses the upper left and ⅓ of the lower left quadrants as 1/6≤t≤1/2. The pictures are "connect-the-dots" of exact values along the space-fill, sampled at various fixed phases and frequencies.

enter image description here

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract