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

Improve this question
$\endgroup$
2
  • $\begingroup$ Make an H. Then place the center of four 1/10 size Hs on the tips of each leg. Iterate. $\endgroup$
    – David G. Stork
    Commented May 25, 2017 at 1:35
  • 1
    $\begingroup$ See the demonstration "H-Fractal" and SubstitutionSystem. $\endgroup$
    – Anton Antonov
    Commented May 25, 2017 at 1:42

4 Answers 4

Reset to default
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

Improve this answer
$\endgroup$
3
  • $\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
    Commented May 25, 2017 at 19:12
  • $\begingroup$ @David You have defined f somewhere earlier. Try ClearAll[f] $\endgroup$
    – Ray Shadow
    Commented May 25, 2017 at 19:24
  • $\begingroup$ Perfect. You were right. Thanks. $\endgroup$
    – David
    Commented May 25, 2017 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

Improve this answer
$\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

Improve this answer
$\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

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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