(* 2024-07-26 *)

(* :Context: TrochoidPlot` *)

(* :Title: TrochoidPlot *)

(* :Author: Xah Lee. *)

(* : Copyright 1994, 2024 by Xah Lee. *)

(* :Summary:

This package plot curves traced out by rolling a circle on another fixed circle.
Or generate a animation of rolling circles.

*)

(* :Keywords: animation, graphics, trochoid, cardoid, nephoid, deltoid, cycloid,
 astroid, roulette, curves, spiralgraph, spirograph *)

(* :Mathematica Version: 12. *)
(* :Package Version: 2.1.20241013101818 *)
(* :History:
Version 2.0, 2024-07-28. Updated to latest version of Wolfram language. merged in the package TrochoidShow. All function names changed.
Version 1.2.1, 1996-05.
Version 1.2, 1995-05. Miscellaneous changes.
Verison 1.1, 1994-09. Improved the speed about 200% to 300% on the average.
Verison 1.0, 1994-08. The first version.
*)

(* :Discussion:

What is Trochoid?

Trochoid are plane curves traced out by rolling a circle on another, or rolling on a line.
Also known as the SpiroGraph (TM) toy.

If the rolling circle is inside a fixed circle, the curve traced out are called hypotrochoid.
(special case: the rolling circle may be larger than the fixed circle, so technically it is not inside, but rather, roll internally to the fixed circle.)

If the rolling circle is outside a fixed circle, the curve traced out are called epitrochoid.

 Xah Lee
 http://xahlee.org/

*)

BeginPackage["TrochoidPlot`"]

TrochoidPlot::usage = "TrochoidPlot[b, h] plot trochoid with parameters b and h. If b is positive it plots hypotrochoid, if negative, it plots epitrochoid.

b is the rolling circle radius.
h is the distance of tracing point to center of rolling circle.
The fixed circle has radius of 1.

TrochoidPlot[{b1, b2, ...}, {h1, h2, ...}]
plot multiple trochoid and Epitrochoid, with parameters {b1,h1}, {h1,h2}, ..., {b2,h1,}, {b2,h2}, ..., etc.

TrochoidPlot[b, h, {from, to}]
 specifies the starting angle and ending angle of the rolling circle. By default, it's {0, 2 Pi}.

TrochoidPlot has the same options as ParametricPlot.

TrochoidPlot[{-2/3, 2/3}, {2/3}, {0, 4 Pi }] 
";

TrochoidAnimation::usage = "TrochoidAnimation[{bmin, bmax}, {hmin, hmax}]
generate a list of graphics showing hypotrochoid and epitrochoids with rolling-circle radius b going from bmin to bmax and h going from hmin to hmax.

TrochoidAnimation has the same options as TrochoidPlot, with the following additions.

NumberOfFrames -> n generates n graphics, for smoothness of animation.";

NumberOfFrames::usage = "NumberOfFrames is an option for TrochoidAnimation.
NumberOfFrames -> n means generate n graphic.
Default is 30.";

RollingCircleAnimation::usage = "RollingCircleAnimation[ r ]
generate an animation of hypotrochoid with rolling circle radius r.
The radius of the fixed circle is 1.

RollingCircleAnimation[ r, {h1,h2,...} ]
has radius of tracing point to center of rolling circle h1, h2, etc.

r is the radius of the rolling circle, r < 1.
The optional list {h1,h2,...} specifies how many curves to be traced out at once, each hi corresponds to the distance from the center of the rolling circle to the tracing locus.
The default is { 0.5 r, r, 1.5 r}.
Other options include, CirclesOn, NumberOfSpokes, DotStyle, SpokeStyle, DiskStyle.
Each is documented online.

Example:

RollingCircleAnimation[1/3,{1/3}]
";

RollingCircleOnLineAnimation::usage = "RollingCircleOnLineAnimation[1,{1,4}, {0,4 Pi, 4 Pi / 30}]";

(* 
Rotation Range.
 To complete a full cycle where the radius of the rolling circle is a/b and a and b have no common factors, use {0, a 2 Pi, increment}.
 If the radius is irrational, the trace never repeats.


 *)

CirclesOn::usage = "CirclesOn is an option for RollingCircleAnimation, RollingCircleOnLineAnimation and others.
 CirclesOn -> True, draw the fixed circle and the rolling disk to be included
 in the plot.";

NumberOfSpokes::usage = "NumberOfSpokes is an option for RollingCircleAnimation, RollingCircleOnLineAnimation and others.

NumberOfSpokes -> n, draw n spokes for the rolling circle.

Example:

RollingCircleAnimation[1/2,{1/2}, NumberOfSpokes -> 1]";

DotStyle::usage = "DotStyle is an option for RollingCircleAnimation, RollingCircleOnLineAnimation and others.

DotStyle -> {{style1},{style2},...}, assign styles to the dots.

Example:

 RollingCircleAnimation[3/7, {3/7,1,2,4}, {0, 3 2 Pi, 2 Pi /30 }, DotStyle -> { {Red,PointSize[.005]}, {Green,PointSize[.008]}, {Cyan,PointSize[.01]}, {Purple,PointSize[0.015]} } ]";

SpokeStyle::usage = "SpokeStyle is an option for RollingCircleAnimation, RollingCircleOnLineAnimation and others.

SpokeStyle -> {{style1},{style2},...}, assign styles to the spokes.";

DiskStyle::usage = "DiskStyle is an option for RollingCircleAnimation, RollingCircleOnLineAnimation and others.

DiskStyle -> {{style1},{style2},...}, assign styles to the rolling circles.";

Begin["`Private`"]

hypoF[{b_,h_}] := {(1-b) Cos[tt] + h Cos[-(1-b)/b tt], (1-b) Sin[tt] + h Sin[-(1-b)/b tt]}

epiF[{b_,h_}] := hypoF[{-b,h}] 

TrochoidPlot[ paramB_, paramH_, rotrange_List:{0, 2 Pi}, opts:OptionsPattern[]] :=
 Module[{xblist, xhlist, xformulas, paramlist, xstyle},

xblist = If[ ListQ@ paramB, paramB, {paramB}];
xhlist = If[ ListQ@ paramH, paramH, {paramH}];
  paramlist = Flatten[Outer[List, xblist, xhlist],1];

 xformulas = hypoF /@ paramlist ;

 xstyle = Map[ Hue , Range[0,.999, 1/(Length@xformulas)] ] ;

  ParametricPlot[ Evaluate@xformulas,
   {tt, First@ rotrange , Last@ rotrange},
   Evaluate@ FilterRules[ {opts}, Options[ ParametricPlot ] ] ,
   PlotStyle -> xstyle,
   AspectRatio -> Automatic,
   PlotRange -> All
  ]

 ]

Options[TrochoidAnimation] = Join[ { NumberOfFrames -> 30 }, Options[ParametricPlot] ];

TrochoidAnimation[ {bMin_, bMax_}, {hMin_, hMax_}, rotrange_List:{0, 2 Pi}, opts:OptionsPattern[]] :=
 Module[{ nFrames, ptrange},

  nFrames = OptionValue[ NumberOfFrames ];

 ptrange = 1 +2 bMax + Max[ hMax-bMax, 0]+.2;

MapThread[
Function[ {b , h},
(ParametricPlot[ Evaluate@ hypoF[{b,h}],
    {tt,First@ rotrange, Last@ rotrange},
    Evaluate@ FilterRules[ {opts}, Options[ ParametricPlot ] ],
    PlotRange -> {{- ptrange, ptrange},{- ptrange, ptrange }},
    AspectRatio -> Automatic,
    PlotStyle -> {Red,Blue},
    PlotLabel  ->
     StringForm["a = 1, b = ``, h = ``",
      PaddedForm[N@b,{5,4}],
      PaddedForm[N@h,{5,4}]
     ]
   ] )],
{Subdivide[bMin, bMax, nFrames -1],
Subdivide[hMin, hMax, nFrames -1] }
]
 ]

(*xPart and yPart are subcodes used in newPosition*)

newPosition::usage= "newPosition[{a_,b_}, t_, {c_, d_} ] returns {x,y}, where {x,y} is the point {a,b} rotated t radians around the Origin, and then translated c (x-axes) units and d (y-axes) units.";

xPart = Compile[{a,b,t,c}, a Cos[t] - b Sin[t] + c];
yPart = Compile[{a,b,t,d}, b Cos[t] + a Sin[t] + d];

newPosition[{a_,b_}, t_,{c_, d_}] := {xPart[a,b,t,c],yPart[a,b,t,d]}

spokesGP::usage = "spokesGP[{a,b},n,skokeLen,t,{style1,style2...}] generate a list of n graphic primitive of the form { { style1, Line[{{a,b},{x1,y1}}] }, { style2, Line[{{a,b},{x2,y2}}] },...} The list of lines radiates from the center {a,b} in a symmetric way, with lengeth skokeLen.
t (radians) rotates the whole thing around {a,b}.
They simulate the spokes of a wheel.";

spokesGP[n_,center_,skokeLen_,t_,style_List] :=
 Transpose[
  {style,
  Line[
   { center, newPosition[skokeLen {Cos[2 Pi/n (#-1)], Sin[2 Pi/n (#-1)]},t,center] }
  ]& /@ Range[n]
  }
 ]

dotsGP::usage = "dotsGP[ pointA, alpha,{h1,h2,...},{style1,style2,...}] returns a graphic primitive of the form { {style1, Points[{x1,y1}]}, {style2, Points[{x2,y2}]}, ... }. where the vector from pointA to {xi,yi} have distance hi, angle alpha. style and h list must have the same length.";

dotsGP[ center_, t_, h_List, style_List] :=
 Transpose[
  {style,
   Point[ newPosition[{#,0},t,center] ]& /@ h
  }
 ]

Options[RollingCircleAnimation] =
Options[RollingCircleOnLineAnimation] =
  Join[
   {
   CirclesOn -> True,
   NumberOfSpokes -> 3,
   DotStyle -> Automatic,
   SpokeStyle -> Automatic,
   DiskStyle -> {GrayLevel[.85]}
   },
    Options[Graphics]
  ];

RollingCircleAnimation[ r_, h_List:{Automatic}, rotrange_List:{0, 2 Pi, 2 Pi/30}, opts:OptionsPattern[]] :=
 Module[{ hList, 
   circlesGP,numSpokes, xdotstyle,spkStyle,dskStyle,
   skokeLen, rr, marg,plotRange,
   dotSetGP,center,t
   },
  circlesGP = OptionValue@ CirclesOn;
  numSpokes = OptionValue@ NumberOfSpokes;
  xdotstyle = OptionValue@ DotStyle;
  spkStyle = OptionValue@ SpokeStyle;
  dskStyle = OptionValue@ DiskStyle;

  If[ h==={Automatic}, hList = Abs[r] {.5,1.,1.5}, hList = h];
  If[circlesGP===True,
   circlesGP := {
       {Thickness[.006],Circle[{0,0},1]},
       {dskStyle,Disk[center,Abs[r]]},
       {Circle[center,Abs[r]]},
       spokesGP[ numSpokes, center, skokeLen, t(1-1/r), spkStyle]
      },
   circlesGP = {}
  ];
  If[ xdotstyle===Automatic ,
   xdotstyle = Map[{Hue[#],PointSize[.01]}&, Range[0,.999,1/Length[hList]] ],
   xdotstyle = Map[(RotateLeft[xdotstyle,#][[1]])&,Range[0,Length[hList]-1] ]
  ];
  If[ spkStyle===Automatic,
   spkStyle = Join[{Red}, Blue&/@Range[numSpokes-1] ],
   spkStyle = Map[(RotateLeft[spkStyle,#][[1]])&,Range[0,numSpokes-1] ]
  ];

  skokeLen = Max[hList];
  marg = 0.05;
  rr = Max[1,1-2 r, 1-r+skokeLen];
  plotRange = {{-rr-marg,rr+marg},{-rr-marg,rr+marg}};

  center := newPosition[{1-r,0}, t,{0,0}];
  dotSetGP = {};

  Table[ AppendTo[dotSetGP, dotsGP[center, t(1-1/r), hList, xdotstyle] ];
    Graphics[ Flatten[{circlesGP, dotSetGP}],
      FilterRules[ {opts}, Options[ Graphics ] ] ,
     AspectRatio -> Automatic, Axes -> True,
     PlotRange -> plotRange
    ]
   ,
   Evaluate[Flatten[{t, rotrange}]]
  ]

 ]

RollingCircleOnLineAnimation[ r_, h_List:{Automatic}, rotrange_List:{0, 2 Pi, 2 Pi/30}, opts:OptionsPattern[]] :=
 Module[{ hList, 
   circlesGP,numSpokes,xdotstyle,spkStyle,dskStyle,
   skokeLen, extrasl, marg,plotRange,
   dotSetGP,center,t
   },

  circlesGP = OptionValue@ CirclesOn;
  numSpokes = OptionValue@ NumberOfSpokes;
  xdotstyle = OptionValue@ DotStyle;
  spkStyle = OptionValue@ SpokeStyle;
  dskStyle = OptionValue@ DiskStyle;

  If[ h==={Automatic}, hList = r {.5,1.,1.5}, hList = h];
  If[circlesGP===True,
   circlesGP :=
    { {dskStyle,Disk[center,r]}, Circle[center,r],
     spokesGP[ numSpokes, center, skokeLen, -t, spkStyle]
    },
   circlesGP = {}
  ];
  If[ xdotstyle===Automatic ,
   xdotstyle = Map[{Hue[#],PointSize[.01]}&, Range[0,.999,1/Length[hList]] ],
   xdotstyle = Map[(RotateLeft[xdotstyle,#][[1]])&,Range[0,Length[hList]-1] ]
  ];
  If[ spkStyle===Automatic,
   spkStyle = Join[{Red}, Blue&/@Range[numSpokes-1] ],
   spkStyle = Map[(RotateLeft[spkStyle,#][[1]])&,Range[0,numSpokes-1] ]
  ];

  skokeLen = Max[hList];
  extrasl = If[Max[skokeLen>r],skokeLen-r,0];
  marg = 0.05;
  plotRange =
   { {-r-extrasl-marg, r rotrange[[2]]+r+extrasl+marg},
    {-extrasl-marg,2 r+extrasl+marg}
   };
  center := {r t, r};
  dotSetGP = {};

  Table[ AppendTo[dotSetGP, dotsGP[center, -t, hList, xdotstyle] ];
    Graphics[ Flatten[{circlesGP, dotSetGP}],
     FilterRules[ {opts}, Options[ Graphics ] ],
     AspectRatio -> Automatic, Axes -> True,
     PlotRange -> plotRange
    ] ,
   Evaluate[Flatten[{t,rotrange}]]
  ]

 ]

End[]

EndPackage[]
