14
$\begingroup$

Can folks show me several methods I can use to draw the following fractal H-Tree?

enter image description here

I did use Free-Form input, as:

= h-fractal

And got this image, which is three iterations, but no idea how it was formed.

enter image description here

$\endgroup$
13
$\begingroup$

Iterative version

Each horisontal line generates two vertical lines of the same length, while each vertical line generates two horisontal lines, which are twice shorter:

SetAttributes[f, Listable];
f[Line[{a_,b_}]]:=With[{d=Reverse@Abs[a-b]/{2,4}},{Line@{a+d,a-d},Line@{b+d,b-d}}];
Graphics[NestList[f, Line[{{-1,0},{1,0}}], 10], AspectRatio->1]

H-Fractal

Simple version

Draw an H-shaped figure in every point of a rectangular grid. Repeat with finer grid spacing.

drawH[size_][{x_,y_}]:={
    Line[{{x,y}+{-size,0},{x,y}+{size,0}}],
    Line[{{x,y}+{-size,size},{x,y}+{-size,-size}}],
    Line[{{x,y}+{size,size},{x,y}+{size,-size}}]
    };

drawAllH[size_]:= Map[drawH[size], 
    CoordinateBoundsArray[{{-2,2},{-2,2}}, 4 size, Center], {2}];

Graphics[Map[drawAllH, 1/2^(Range[4]-1)]]

Larger H-Fractal

$\endgroup$
  • $\begingroup$ Your iterative example (first example) gave me this error: SetDelayed::write: Tag Plus in (5-3 x-2 x^2+x^3)[Line[{a_,b_}]] is Protected.. I am using Mathematica 11.1.1. $\endgroup$ – David May 25 '17 at 19:12
  • $\begingroup$ @David You have defined f somewhere earlier. Try ClearAll[f] $\endgroup$ – Shadowray May 25 '17 at 19:24
  • $\begingroup$ Perfect. You were right. Thanks. $\endgroup$ – David May 25 '17 at 19:54
12
$\begingroup$

Here's a simple-minded implementation based on repeated scaling:

With[{n = 6, s = 1./3}, 
     Graphics[Flatten[NestList[# /. Line[{p1_, p2_}] :> 
                               Map[Line,
                                   Outer[Plus, {p1, p2},
                                         Outer[Times, {-1, 1}, s Cross[p2 - p1]], 1]] &,
                               Line[{{-0.5, 0.}, {0.5, 0.}}], 2 n - 1]]]]

h-tree

$\endgroup$
8
$\begingroup$

define a function drawH

drawH[{x_, y_}, size_] := 
 Line[{{{x + size, y}, {x - size, y}}, {{x + size, 
     y + size}, {x + size, y - size}}, {{x - size, 
     y + size}, {x - size, y - size}}}]

Then use NestList to iteration

size = 1;
Graphics[NestList[(size = size*.5;Level[#[[All, 1, 2 ;;]], {-2}, 
     drawH[#, size] & /@ {##} &]) &, {drawH[{0, 0}, 1]}, 3]]

Mathematica graphics

$\endgroup$
2
$\begingroup$

Faster version

n = 3;
s = 1;
{a, b, c, d} = {{-1, -s}, {-1, s}, {1, -s}, {1, s}};
m = {{{1, 0}, {0, 1}}/2, #} & /@ {a, b, c, d};
L = Line[{{a, b}, {{-1, 0}, {1, 0}}, {c, d}}];
Graphics[NestList[GeometricTransformation[#, m] &, L, n]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.