I'm new to Mathematica and my goal is to write a simple program in order to demonstrate self-similarity of the Koch curve by zooming in. Here is a good example of what I mean (it's a Java applet). I was going to start learning the built-in powers of Mathematica for a long time and it seems to be a good opportunity. Given the simplicity of the program and popularity of fractals I was sure I'd find many working examples online, yet it turned out to be not the case.
In particular, how can one make this zoomable:
f[form_, {a_, b_}] :=
AffineTransform[{{b - a, ({{0, -1}, {1, 0}}).(b - a)}\[Transpose],
a}][1/Norm[
Last[form] - First[form]] TranslationTransform[-First[form]][
form]]
g[form_, points_] :=
Flatten[Map[f[form, #] &, Partition[points, 2, 1]], 1]
Manipulate[form = Append[Prepend[pts, {-Sqrt[3], 1}], {Sqrt[3], 1}];
base = Nest[g[form, #] &, form, refinements];
If[maketriangle,
triangle =
Join[base, RotationTransform[4 \[Pi]/3.][base],
RotationTransform[2 \[Pi]/3.][base]]];
plaatje =
Graphics[{If[
maketriangle, {ColorData[1][1], Polygon[triangle]}, {}],
AbsoluteThickness[1.3], Line[If[maketriangle, triangle, base]],
If[refinements == 0, {Thick, Line[form]}, {}]},
PlotRange -> {{-3.5, 3.5}, {-2.3, 2.3}},
AspectRatio ->
Automatic], {{pts, {{-Sqrt[3]/3, 1}, {0, 2}, {Sqrt[3]/3, 1}}},
Locator, LocatorAutoCreate -> True,
ContinuousAction ->
If[refinements > 2, False, True]}, {{refinements, 0,
"Refinements"}, 0, 6, 1,
SetterBar}, {{maketriangle, True, "Make triangle"}, {True, False}},
SynchronousUpdating -> False, SaveDefinitions -> True]
Source: Create Alternative Koch Snowflakes
Answer
I'm sure you can make it slicker, but one way to approach this is to change the plotrange dynamically. Here I've added four sliders to change the x and y scaling and the x and y offset. As in your original code, the amount of detail in the curve is given by the refinement variable.

f[form_, {a_, b_}] :=
AffineTransform[{{b - a, ({{0, -1}, {1, 0}}).(b - a)}\[Transpose],
a}][1/Norm[
Last[form] - First[form]] TranslationTransform[-First[form]][
form]]
g[form_, points_] :=
Flatten[Map[f[form, #] &, Partition[points, 2, 1]], 1]
Manipulate[form = Append[Prepend[pts, {-Sqrt[3], 1}], {Sqrt[3], 1}];
base = Nest[g[form, #] &, form, refinements];
If[maketriangle,
triangle =
Join[base, RotationTransform[4 \[Pi]/3.][base],
RotationTransform[2 \[Pi]/3.][base]]];
plaatje =
Graphics[{If[
maketriangle, {ColorData[1][1], Polygon[triangle]}, {}],
AbsoluteThickness[1.3], Line[If[maketriangle, triangle, base]],
If[refinements == 0, {Thick, Line[form]}, {}]},
PlotRange ->
Dynamic[{{-3.5, 3.5} xzoom + xoff, {-2.3, 2.3} yzoom + yoff}],
AspectRatio ->
Automatic], {{pts, {{-Sqrt[3]/3, 1}, {0, 2}, {Sqrt[3]/3, 1}}},
Locator, LocatorAutoCreate -> True,
ContinuousAction ->
If[refinements > 2, False, True]}, {{refinements, 0,
"Refinements"}, 0, 6, 1,
SetterBar}, {{maketriangle, True, "Make triangle"}, {True,
False}}, {xzoom, 1, 0}, {yzoom, 1, 0}, {xoff, -1, 1}, {yoff, -1, 1},
SynchronousUpdating -> False, SaveDefinitions -> True]
Comments
Post a Comment