Make a series of points curl

Question

Say I have a series of points that make a straight line... (Fig 1)

points = {{0, 0, 0}, {1, 0, 0}, {2, 0, 0}, {3, 0, 0}, {4, 0, 0}, {5, 0, 0}}

I can rotate these points about the Z axis using a RotationTransform. (Fig 2)

r = RotationTransform[10 Degree, {0, 0, 1}]
r[points]

However, if I wanted to make the line curl, with each point rotating by a relative 10 Degrees to the point next to it, how would I map the RotationTransform across the list please? (Fig 3)

EDIT: An important thing to note is that the relative distance between each segments should remain constant at 1 unit after the rotations. I could have made this clearer above apologies.

Answer 1

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]

Answer 2

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

Answer 3

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

Answer 4

if you want to maintain the original distances between points I would also suggest the following:

points1 = 
  points = Most /@ {{0, 0, 0}, {1, 0, 0}, {2, 0, 0}, {3, 0, 0}, {4, 0,
       0}, {5, 0, 0}};
l = Length[points]; n = 1; While[n++; n <= l ,
 points[[n ;;]] = 
  RotationTransform[10 Degree, points[[n - 1]]][#] & /@ points[[n ;;]]];
ListPlot[{points1, points}]

Answer 5

Here is another approach (to simplify i give a 2D solution - your problem is in 2D - but it can be easily extended in 3D) :

(* the coordinates of the first point *)
ori = {0, 0};

(* the initial angles between the succesive points *)
angles = {0, 0, 0, 0}

(* the function to build the coordinates from the angles *)
mkpts[ang_] := FoldList[(#1 + {Cos@#2, Sin@#2}) &, ori, Rest@FoldList[Plus, 0, ang]];

Some examples:

1/The initial straight line :

ListPlot[mkpts[angles], AspectRatio -> Automatic]

2/ 10 degrees relative rotation

ListPlot[mkpts[angles + 10. Degree], AspectRatio -> Automatic]

3/ For anything else you just define the angles :

ListPlot[mkpts[angles + {45, -45, -90, 90} Degree], AspectRatio -> Automatic]

Answer 6

Since AnglePath[] is now built-in, here's a rather compact Manipulate[] for curling points:

Manipulate[Graphics[Line[AnglePath[N[ConstantArray[ϕ, n]]]], 
                    Frame -> True, PlotRange -> n],
           {{n, 2, "segments:"}, 2, 10, 1},
           {{ϕ, 0, "angle:"}, Experimental`AngularSlider[Dynamic[ϕ]] &}, 
           ControlPlacement -> Right]