Make a series of points curl
Rotation about the origin
MapIndexed[N@Nest[r, #1, First[#2-1]] &, points]
{{0., 0., 0.}, {0.984808, 0.173648, 0.}, {1.87939, 0.68404, 0.}, {2.59808, 1.5, 0.}, {3.06418, 2.57115, 0.}, {3.21394, 3.83022, 0.}}
ListPlot[%[[All, {1, 2}]]]
the norm of the vectors is conserved.
Rotation about the last point
Ok, with the new request, rotating with respect of the last point
Accumulate@Prepend[MapIndexed[N@Nest[r, #1, First[#2]] &, Differences@points],First[points]]
{{0, 0, 0}, {0.984808, 0.173648, 0.}, {1.9245, 0.515668, 0.}, {2.79053, 1.01567, 0.}, {3.55657, 1.65846, 0.}, {4.19936, 2.4245, 0.}}
ListPlot[Accumulate@
Prepend[MapIndexed[N@Nest[r, #1, First[#2]] &, Differences@points],
First[points]][[All, {1, 2}]], AspectRatio -> 1,
PlotRange -> {{0, 5}, {0, 5}}, Frame -> True]
the norm of the difference between consecutive vectors is conserved.
Some fun
points2 = Array[{#, 0} &, 100];
anim = Table[
ListLinePlot[
Accumulate@
Prepend[MapIndexed[
N@Nest[RotationTransform[x Degree], #1, First[#2]] &,
Differences@points2], First[points2]]
, AspectRatio -> 1
, PlotRange -> {{-50, 100}, {-50, 100}}
], {x, 0, 4, 0.1}];
Export["curl.GIF", anim]
The easiest way to think about it is to iteratively bend the "line" of points as the program "moves" down the list. "Moves" is accomplished with Rest
. The result regrettably has extra data that needs to be discarded, which is done with the ...[[All, 1]]
bit of code.
rot = N@NestList[
Rest@RotationTransform[10 Degree, {0, 0, 1}, #1[[1]]][#1] &,
points, Length[points] - 1][[All, 1]]
(* {{0., 0., 0.}, {0.984808, 0.173648, 0.}, {1.9245, 0.515668, 0.},
{2.79053, 1.01567, 0.}, {3.55657, 1.65846, 0.}, {4.19936, 2.4245, 0.}} *)
Check the output:
VectorAngle @@@ Partition[Differences[rot], 2, 1]
EuclideanDistance @@@ Partition[Differences[rot], 2, 1]
(* {0.174533, 0.174533, 0.174533, 0.174533}
{0.174311, 0.174311, 0.174311, 0.174311} *)
10. Degree
(* 0.174533 *)
Update: Same idea, but with TranslationTransform
serving to move the position down the line of points and no extra data:
N@FoldList[
Composition[
RotationTransform[10 Degree, {0, 0, 1}],
TranslationTransform[#2]][#1] &,
First[points],
Differences[points]]
Some days ago,I look at a python's module called turtle.And I think weather we can simulate the behavier of some functions in turtle.
First,I define some pre-function:
initial[position_, th_] :=
Module[{θ = th, pos = position},
left := Function[theta, θ = θ + theta];
right := Function[theta, θ = θ - theta];
forward :=
Function[r, pos = pos + r*{Cos[θ], Sin[θ]};
Sow[pos];]];
Or use the faster version for pre-function:
initial[position_, th_] :=
Module[{θ = th, pos = position},
left := θ += # &;
right := θ -= # &;
forward := (pos += #*{Cos[θ], Sin[θ]};
Sow[pos];) &];
And then,I use the following code:
points = {{0, 0}, {1, 0}, {2, 0}, {3, 0}, {4, 0}, {5, 0}};
(* calculate the distance between these points *)
pre = Norm /@ Differences[points];
pos = First@points; θ = 0; (* initial conditions *)
initial[pos, θ];(* use the initial function to set the conditions *)
point = Reap[Do[forward[pre[[i]]]; left[10 Degree], {i, 1, Length@pre}]][[2, 1]];
ListLinePlot[point /. {a__} -> {pos, a}, Mesh -> All]
Ok! Done...
Using this code to draw Koch curve maybe easy: (the mechanism can look at the site Recursion about Drawing Fractals)
Koch[order_, size_] :=
If[order == 0, forward[size], Koch[order - 1, size/3]; left[Pi/3];
Koch[order - 1, size/3]; right[2 Pi/3];
Koch[order - 1, size/3]; left[Pi/3]; Koch[order - 1, size/3];];
(*if order is 6,the graphics can be draw like this*)
initial[{0, 0}, 0]; (* initial conditions *)
point = Reap[Koch[6, 3]][[2, 1]];
Graphics[Line[point /. {a__} -> {{0, 0}, a}]]