Euler spiral
Draw a straight line, and then continue it for the same length but deflected by an angle. If you continue doing this you will eventually return to roughly where you started, having drawn out an approximation to a circle. But what happens if you increase the angle of deflection by a fixed amount at each step? The curve will spiral in on itself as the deflection increases, and then spiral out when the deflection exceeds a half-turn.
Reference:
http://en.wikipedia.org/wiki/Euler_spiral
Gif via reddit
Liam Reynolds Jesse Reynolds
ReplyDeleteDeb Nam-Krane you're welcome!
ReplyDeleteI'm using the same technique with my son and he really loves math =)
That is ingenious....I'll have to sit back and spend some time quietly on this to understand how it works...in any case, just incredible! Thanks for sharing Corina. You always bring in something worth spending time upon!!!
ReplyDeletemuy bueno
ReplyDeleteCorina Marinescu "Return to roughly where you started" -- cool! But since it's not shown in the animation, how long does it take as a function of the angle you used?
ReplyDeleteSee the code below for further specifications Pavel Bělík
ReplyDelete1.
Lines[l_] := Module[{curr, \[Theta] = 0, out = {}},
2.
curr = {{0, 0}, {1, 0}};
3.
AppendTo[out, curr];
4.
Do[
5.
\[Theta] = N@l[[i]];
6.
curr = Map[# + (curr[[2]] - curr[[1]]) &, curr];
7.
curr[[2]] = RotationTransform[\[Theta], curr[[1]]][curr[[2]]];
8.
AppendTo[out, curr];
9.
, {i, Length[l]}
10.
];
11.
out
12.
];
13.
angles = Table[0.08 i, {i, 3635}];
14.
lines = Lines[angles];
15.
anglesaccum = Join[{0}, Accumulate[angles]];
16.
frame[n_] :=
17.
18.
Graphics[{{Opacity[0.8], ColorData["DarkRainbow"][0],
19.
Thickness[0.005], Line@lines[[;; n]]},
20.
If[n > 1, {
21.
Darker@Red, EdgeForm[], FaceForm[Opacity[0.4]], Thickness[0.01],
22.
Disk[lines[[n, 1]],
23.
0.5, {anglesaccum[[n]], Pi + anglesaccum[[n - 1]]}
24.
]
25.
}, {}],
26.
Darker@Blue,
27.
If[n < 200, Map[Disk[First[#], 0.05] &, lines[[;; n]]], {}]},
28.
PlotRange -> All, ImageSize -> {300, 300}, Background -> White];
29.
ts = Join[Range[35], 35 + Range[20]*2, 75 + Range[40]^2];
30.
Manipulate[frame[ts[[i]]], {i, 1, Length@ts, 1}]
Raw data:
Lines[l_] := Module[{curr, \[Theta] = 0, out = {}},
curr = {{0, 0}, {1, 0}};
AppendTo[out, curr];
Do[
\[Theta] = N@l[[i]];
curr = Map[# + (curr[[2]] - curr[[1]]) &, curr];
curr[[2]] = RotationTransform[\[Theta], curr[[1]]][curr[[2]]];
AppendTo[out, curr];
, {i, Length[l]}
];
out
];
angles = Table[0.08 i, {i, 3635}];
lines = Lines[angles];
anglesaccum = Join[{0}, Accumulate[angles]];
frame[n_] :=
Graphics[{{Opacity[0.8], ColorData["DarkRainbow"][0],
Thickness[0.005], Line@lines[[;; n]]},
If[n > 1, {
Darker@Red, EdgeForm[], FaceForm[Opacity[0.4]], Thickness[0.01],
Disk[lines[[n, 1]],
0.5, {anglesaccum[[n]], Pi + anglesaccum[[n - 1]]}
]
}, {}],
Darker@Blue,
If[n < 200, Map[Disk[First[#], 0.05] &, lines[[;; n]]], {}]},
PlotRange -> All, ImageSize -> {300, 300}, Background -> White];
ts = Join[Range[35], 35 + Range[20]*2, 75 + Range[40]^2];
Manipulate[frame[ts[[i]]], {i, 1, Length@ts, 1}]
This work belongs to Matt Henderson and like I mentioned it before you can find it on Reddit also.
Cheers,