# Using Mathematica to create an H-Tree

Can folks show me several methods I can use to draw the following fractal H-Tree? I did use Free-Form input, as:

= h-fractal


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

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] 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-1)]] • 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. – David May 25 '17 at 19:12
• @David You have defined f somewhere earlier. Try ClearAll[f] – Shadowray May 25 '17 at 19:24
• Perfect. You were right. Thanks. – David May 25 '17 at 19:54

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]]]] 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]] 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]] 