27
$\begingroup$

enter image description here

I made it by another software, and met some problems to change it into MMA code.

f[x_] := Graphics[ Line[AnglePath[{90 °, -90 °}[[ 1 + Nest[Join[#, {0}, Reverse[1 - #]] &, {0}, x]]]]]]; f /@ Range[5]

The effect is weird.

It has two affine rules

$(x,y)\to(0.5x-0.5y,0.5x+0.5y)$ and $(x,y)\to(-0.5x-0.5y+1,0.5x-0.5y)$

for example: 

g[{x_, y_}] := Block[ {}, Return[{{0.5 x - 0.5 y, 0.5 x + 0.5 y}, {-0.5 x - 0.5 y + 1, 0.5 x - 0.5 y}}] ] h[x_] := Flatten[g /@ x] // Partition[#, 2] & NestList[h, {{0, 0}}, 13] // ListPlot

gives enter image description here

So,I know how to plot still picture, But I have no idea about let it animate.

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ Add a definition of the curve and your code attempts. $\endgroup$ Commented Feb 10, 2020 at 16:09
  • $\begingroup$ the origin link about this gif: netpad.net.cn/resource_web/course/#/36439 click the "animate" to see the animation. $\endgroup$ Commented Feb 16, 2020 at 13:48

3 Answers 3

Reset to default
36
$\begingroup$

I think OP may want animation with transition effects. Compare these two effects:

enter image description here

Then translation

enter image description here

Clear["`*"] cf = Compile[{{M, _Real, 2}, t}, With[{A = M[[1]], B = M[[2]]}, With[{P = (A + B + t Cross[B - A])/2}, {{A, P}, {B, P}}]], RuntimeAttributes -> Listable ]; f[n_] := Flatten[Nest[cf[#, 1] &, {{{0, 0}, {1, 0}}}, Floor@n], Floor@n]; g[n_] := Flatten[cf[f[n], FractionalPart[n]], 1]; Manipulate[Graphics[{Line[f[n]]}, PlotRange -> {{-0.4, 1.2}, {-0.4, 0.7}}], {n, 0, 12}] Manipulate[Graphics[{Line[g[n]]}, PlotRange -> {{-0.4, 1.2}, {-0.4, 0.7}}], {n, 0, 12}] Manipulate[ With[{i = Floor[n], TF = TranslationTransform}, Graphics[{ Table[Line[TF[{2 j, 0}]@f[j]], {j, 0, n}], Line@If[n - i < 0.5, TF[{4 n - 2 i, 0}]@f[n], TF[{2 i + 2, 0}]@g[2 n - i - 1]] }, ImageSize -> 670, PlotRange -> {{-0.2, 13.2}, {-0.5, 0.8}}]], {n, 0, 6}]
Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ The top right one is super cool looking. $\endgroup$ Commented Feb 14, 2020 at 18:51
  • 1
    $\begingroup$ @evanb Thank you. $\endgroup$ Commented Feb 15, 2020 at 7:09
  • 1
    $\begingroup$ @evanb actually I have made one before:) netpad.net.cn/resource_web/course/#/30921 $\endgroup$ Commented Feb 15, 2020 at 8:17
25
$\begingroup$

enter image description here

A simple way to make Dragon Curve is using AnglePath. Define a function that generates points for the Dragon curve:

dragonPTS[k_]:=AnglePath[{Pi/2,-Pi/2}[[1+Nest[Join[#,{0},Reverse[1-#]]&,{0},k]]]]

k is an integer number of iterations. Try it out:

Graphics[Line[dragonPTS[10]]]

enter image description here

Now generate a list of the transitions:

Table[Graphics[Line[dragonPTS[k]]], {k, 1, 10, 1}]

enter image description here

or animate:

Manipulate[Table[Graphics[Line[dragonPTS[k]]], {k, 1, n, 1}], {n, 1, 10}]

enter image description here

To make it a bit cleaner - as in the top animation image - you can try:

Manipulate[ Row[Table[Graphics[Line[dragonPTS[k]],ImageSize->100{1,1}],{k,1,n,1}]], {n,1,10,1},Paneled->False,AppearanceElements->None]

Also see numerous interactive apps at Demonstrations Project:

https://demonstrations.wolfram.com/search.html?query=Dragon

Improve this answer
$\endgroup$
2
$\begingroup$

I have a similar code made by Apple, just for reference.

Clear["Global`*"] rotate[p4_, p2_] := Evaluate[Simplify@RotationTransform[1. Pi/3, p2][p4]]; generate[p1_, p5_] := Module[{p2, p3, p4}, p2 = (p5 - p1)/3 + p1; p4 = 2 (p5 - p1)/3 + p1; p3 = rotate[p4, p2]; {p1, p2, p3, p4}]; data[0]=N@{{ 0, 0}, {1, 0}}; data[n_] := data[n] = Flatten[{generate @@@ Partition[data[n - 1], 2, 1], {{{ 1, 0}}}}, 2]; move[{p1_, p2_, p3_, p4_, p5_}, t_] := {{p1, p2, (1 - t) p4 + t p3}, {(1 - t) p2 + t p3, p4, p5}}; AllMove[data_, t_] := move[#, t] & /@ Partition[data, 5, 4]; newdata[t_] := Flatten[AllMove[data[Quotient[t + 1, 1]], Mod[t, 1]], 1]; Manipulate[ListLinePlot[newdata[t], PlotRange -> {{ 0, 1}, {-0.02, 0.3}}, AspectRatio -> 0.32, Axes -> False, PlotStyle -> RGBColor[0.353, 0.741, 0.913], ImageSize -> {500, 200}], {t, 0, 4, 0.03},SaveDefinitions -> True]
Improve this answer
$\endgroup$
1

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.