THE CYCLOIDAL PENDULUM
K.6.2.1:

Franz Michel, Bernhard Schnizer

Institut fuer Theoretische Physik
Technische Universitaet Graz
A-8010  Graz, Austria
Projekt Multimedial Lehre des
Zentralen Informatikdienstes der TU Graz

2002-01-31

Parameters

Internal Parameters

ncp  =  
          16;                                                   (*  number of pictures per period for the first animation  *) 
ncp2 = 30;                            
speed = 
          5 ;                                                 (*   number  of pictures per calculated second for third animation     *) 
gl  = 
          0.005;                        
lr  =  -1; 
      rr   =  
        2  π *n  +  1;                
eps  = 
          10^-2;                                            (* small number *) 
Null

Start Button for Animations

start = 
        ButtonBox[
          StyleBox["Run Animation", "Title", 
            FontFamily -> "Helvetica"], 
          ButtonFunction :> 
            FrontEndExecute[{SelectionMove[EvaluationNotebook[], Before, 
                    ButtonCell] SelectionMove[EvaluationNotebook[], 
                    Previous, CellGroup] SelectionAnimate[
                    SelectedNotebook[], AnimationDisplayTime -> zeit]}], 
          ButtonEvaluator -> Automatic, 
          Active -> True];

Construction of the Cycloid

Drawing the Cycloid

Needs["Graphics`Graphics`"]
Needs["Graphics`FilledPlot`"]
Needs["Graphics`Colors`"]

Parametric representation of the cycloid and its derivatives

Clear[r, α];
r[α_]  =  {α  - Sin[α], ( 
            1  +  Cos[α])};
dr[α_] = 
        D[r[α], α];
ddr[α_] = D[dr[α], α];

pc  =   ParametricPlot[
          Evaluate[r[α]], {α, 0, 2  π*n}, 
          PlotStyle  ->  {{Hue[ .79,  .5,  .9],  
                Thickness[ .006]}}, 
            Epilog  ->  
            Table[Line[{{2  π i + eps, 0}, {2  π i + eps, 2}}], {i, 
                1, n}], 
            AspectRatio  ->  Automatic, 
          Ticks  ->  {π Range[0, 2  n], 
              Range[0, 
                2]}, 
           ImageSize  ->  500];

Show[pc,  
        DisplayFunction  ->  $DisplayFunction];

Drawing the circles rolling to the right

\(\(csv\  = 
        Table[Table[
\ \ \ \ \ \ \ Graphics[{Hue[0], 
                Circle[{2  π\ k\ /ncp + \ 2\ π\ i, 1}, 
                  1], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ GrayLevel[0], 
                Point[r[
                    2  π\ k/ncp + 
                      2  π\ i\ ]], 
		\ \ \ \ \ \ \ \ Table[\ Line[{{2  π\ \((1 + j)\) + \ eps, 
                        0}, {2  π\ \((1 + j)\) + \ eps, 2}}], {j, 0, 
                    n - 1}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Line[{{0\  - eps\ \ \ , 
                      0}, {0\  - \ eps\ \ \ \ , 
                      2\ }}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[ .7], 
                Line[{{0, 2}, {2  π\ n, 
                      2}}], 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[ .4], Thickness[gl], 
                Line[{{2  π\ k/ncp + 2\ π\ i, 1}, 
                    r[2  π\ k/ncp + 
                        2\ π\ i]}]}], 
\ \ \ \ \ {k, 0, 
              ncp}], {i, 0, n - 1}];\)\)

Lecture notes, Fig.6.1

One picture  of the animation serves as Fig.6.1 in the lecture notes:

i  =  6;   nti  =  0.2; 
\(\(vrl\  = 
        Graphics[\ {Text["0", {\(- .35\),  .2}], Hue[ .9], Thickness[gl], 
            Line[{{2  π\ i/ncp, 1}, {2  π\ i/ncp, 
                  2}}], 
Line[{{0, 2}, {2  π\ i/ncp, 
                  2}}], 
Circle[{2  π\ i/ncp, 1}, 
              1, {π/2, 
                3.3  π\ i/
                    ncp}], \ 
Text["α", {2  π\ i/ncp\  - \  .6, 1.2}]}];\)\)
\(\(Show[csv[\([1, i + 1]\)], pc, vrl, Axes\  -> \ True, \ 
        AxesLabel\ \  -> \ {"x", "y"}, 
AspectRatio\  -> \ Automatic, 
        PlotRange\  -> \ {{lr, rr + \  .2}, {\(- .1\), 2.1}}, 
        ImageSize\  -> \ 
          650, 
TextStyle\  -> \ {FontSize\  -> \ 
              13}, Ticks\  -> \ {Prepend[π\ Range[0, 
                  2  n], {nti, "0"}], 
            Range[0, 
              2]}, 
\ \ \ \ \ \ \ \ \ \ \ Epilog\  -> \ {GrayLevel[1], 
            Line[{{nti, 0.015}, {nti,  .1}}]}];\)\)

Show[csv, pc, AspectRatio  ->  Automatic, 
        PlotRange  ->  {{lr, rr}, {- .1, 2.1}}];

Drawing the circles rolling to the left:

\(
\(\(csr\  = 
        Table[Table[
            Graphics[{Hue[0], 
                Circle[{2  π\ k/ncp + 2\ π\ i, 1}, 
                  1], \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ GrayLevel[0], 
                Point[r[
                    2  π\ k/ncp + 
                      2\ π\ i]], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Table[
			\ \ \ \ \ \ \ Line[{{2  π \((1 + j)\)\  + \ eps, 
                        0}, {2  π\ \((1 + j)\) + \ eps, 2}}], {j, 0, 
                    n - 1}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Line[{{0\  - eps\ \ \ , 
                      0}, {0\  - \ eps\ \ \ \ , 
                      2\ }}], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[ .7], 
                Line[{{0, 2}, {2  π\ n, 
                      2}}], 
			\ \ \ \ \ \ \ \ \ \ \ \ \ \ Hue[ .4], Thickness[gl], 
                Line[{{2  π\ k/ncp + 2\ π\ i, 1}, 
                    r[2  π\ k/ncp + 
                        2  π\ i]}]}], 
{k, ncp, 
              0, \(-1\)}], 
{i, \((n - 1)\), 
            0, \(-1\)}];\)\(
\)
    \)\)
Show[csr, pc, 
        AspectRatio  -> 
          Automatic,   PlotRange  ->  {{lr, rr}, {- .1, 
              2.1}}];

Concatenate  both series of pictures:

ct  =  Flatten[Join[csv, csr]];

Drawing the ground line:

bl  = 
        Graphics[ {AbsoluteThickness[2], 
            Line[{{0, 0}, {2  π n, 0}}]}];

Animation

Table[
        Show[ct[[k]], pc, bl, 
          AspectRatio  -> 
            Automatic,  
                   PlotRange  ->  {{lr, rr}, {- .1, 2.1}}, 
          Prolog  ->  PointSize[ .01], 
          ImageSize ->  700], 
{k, 
          Length[ct]}];
SelectionMove[EvaluationNotebook[], After, 
        EvaluationCell];
SelectionMove[EvaluationNotebook[], Next, CellGroup];
FrontEndTokenExecute["OpenCloseGroup"];
start /. zeit -> 0.1 // DisplayForm

The Evolute of a Cycloid is again a Cycloid

Drawing the original cycloid:

\(\(cyc = 
        ParametricPlot[Evaluate[r[α]], {α, 0, 2  π}, 
          PlotStyle -> {Thickness[0.005], 
              Hue[tt]}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ DisplayFunction -> \ Identity, 
				\ Epilog\  -> \ 
            Line[{{2  π\  + eps, 0}, {2  π\  + eps, 
                  2}}]];\)\)

The radius  R  of the curvature circle of a plane curve is given by:
						
				R  =  ((([(((x'))^2)+(((y'))^2)])^(3/2))/(x y'  -  y x')) .
				
The centres  ((Subscript[x, c]),(Subscript[y, c]))  of these circles are:
		((Subscript[x, c]),(Subscript[y, c]))    =   ( x  -  y'   (((((x'))^2)+(((y'))^2))/(x y'  -  y x')),     y  +  x'   (((((x'))^2)+(((y'))^2))/(x y'  -  y x'))) .
Above a prime (') denotes  a derivation w.r.t. the parameter  α.
Mathematica requires for a circle or a disc the following arguments:   [((Subscript[x, c]),(Subscript[y, c])) ,R].
Therefore the curvature circles and their centres are calculated and plotted in the following way:

d2[α_]  =  
        dr[α]  . dr[α]  // Simplify ;
c2[α_]  =  
        Det[{dr[α], ddr[α]}] // Simplify;
r2[α_]  =  {- dr[α][[2]]  ,  dr[α][[1]]} d2[α]/c2[α] // Simplify;
kruemmkreis[α_] =  {r[α]   +    r2[α], 
          d2[α]^(3/2)/c2[α] // Simplify};

Drawing the curvature circles:

\(\(kreise = 
        Table[{\ \ \ \ RGBColor[0.996109, 0.898451, 0.898451], 
            Apply[Disk, 
              kruemmkreis[α]], 
			GrayLevel[0], 
            Apply[Circle, 
              kruemmkreis[α]], 
		\ \ \ \ \ \ \ \ \ \ \ PointSize[0.02], Hue[0], 
            Point[\(kruemmkreis[α]\)[\([1]\)]], 
			Line[{\(kruemmkreis[α]\)[\([1]\)], {\(r[α]\)[\([1]\)], \(r[α]\)[\([2]\)]}}]}, {α, 0.1, 2\ π, 
            2\ π/ncp2}];\)\)

Drawing the evolute:

\(\(pcup1 = 
        Table[ParametricPlot[
            Evaluate[
              Thread[r[αα] + {\(-π\), 
                    2}]], {αα, π, α}, 
		\ \ PlotStyle -> {Thickness[0.006], Hue[tt]}, 
            DisplayFunction -> \ 
              Identity], 
		\ \ \ \ {α, π + 
              0.1, 2  π + \ π, 2\ π/ncp2}];\)\)

Show the animation:

pev  =  
        Table[Show[Graphics[kreise[[i]]], cyc /. tt ->  0, 
            pcup1[[i]] /. 
              tt ->  
                0.7, 
     AspectRatio  -> 
              Automatic,     Prolog  ->  
              PointSize[ .005],  
     PlotRange  ->  {{-eps - 3, 2 π  + eps + 3}, {-eps, 
                  4 + eps + 
                    0.5}}, 
    ImageSize ->  
              700, DisplayFunction ->  $DisplayFunction], 
                       {i, 1, 
            ncp2}];
SelectionMove[EvaluationNotebook[], After, 
        EvaluationCell];
SelectionMove[EvaluationNotebook[], Next, CellGroup];
FrontEndTokenExecute["OpenCloseGroup"];
start /. zeit -> 0.7 // DisplayForm

Graphics for the Lecture Notes

Show[pev[[3]], pev[[25]],  FullGraphics[pev[[1]]],  
        PlotRange  ->  All,  ImageSize  ->  500];

animation of the pendulum

drawing the animation

nc = 4 speed Round[Max[aw]/π];  (* number of pictures per period *)

Drawing the cycloid:

pc1 = 
        ParametricPlot[Evaluate[r[α]], {α, 0, 2  π}, 
          DisplayFunction -> 
            Identity,   
                                              Epilog  -> 
            Line[{{2  π  + eps, 0}, {2  π  + eps, 
                  2}}]];

Drawing the upper cycloid and fill it with gray color:

ZykloListe = 
      Table[Evaluate[
          Thread[r[α] + {-π, 2}]], {α, π, 
          3 π, π/10}]; 
    pc2 = FilledListPlot[
        ZykloListe, {{0, 4.5}, {2  π, 
            4.5}}, 
DisplayFunction -> 
          Identity,   
Fills -> 
          GrayLevel[0.9]];

Joinig the two pictures :

pc3 = 
        Show[pc1, pc2, 
AspectRatio  ->  Automatic, 
          Ticks  ->  {{0, π, 2 π}, 
              Range[0, 4]}, 
ImageSize  -> 
            500];

The angle of the oscillation depending on the time:

Clear[t, pendelnr];
winkel[t_, pendelnr_] := 
        2 ArcCos[Cos[(1/2) aw[[pendelnr]]] Sin[(t/2)]];

Drawing the free hanging pendulum string:

\(\(pendel1 = 
        Table[Table[
            Graphics[{\ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ GrayLevel[0], PointSize[0.02], 
                Point[r[
                    winkel[4\ π\ k/nc, 
                      i]]], 
	\ \ \ \ \ \ \ Hue[\((i - 
                        1)\)\ 0.3], 
                Thickness[
                  gl], \ 
	\ \ \ \ \ \ \ Line[{Thread[
                      r[winkel[4\ π\ k/nc, i] + π] + {\(-π\), 
                          2}], 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ r[
                      winkel[4\ π\ k/nc, 
                        i]]}]}], 
		{k, 0, nc}], \ {i, 1, 
            Length[aw]}];\)\)

Drawing the pendulum string which clings on the cycloid:

pendel2 = {};
\(\(Do[
        pendelvor2 = 
          Table[
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ParametricPlot[
              Evaluate[
                Thread[r[winkel[4\ π\ k/nc, i] + π] + {\(-π\), 
                      2}]], 
		{k, 0, 
                If[kk == 0, eps, 
                  kk]}, 
		PlotStyle -> {Thickness[
                    2\ gl], 
                  Hue[\((i - 1)\) 
                      0.3]}, 
		PlotRange\  -> \ {{0, 2\ π}, {0, 4}}, 
              Axes -> 
                False, 
		DisplayFunction -> 
                Identity], 
{kk, 0, 
              nc/4}]; \ 

pendelzurueck2 = Table[
	
            ParametricPlot[
              Evaluate[
                Thread[Evaluate[
                      r[winkel[4\ π\ k/nc, i] + π]] + {\(-π\), 
                      2}]], 
		{k, kk, 
                nc}, 
		PlotStyle -> {Thickness[
                    2\ gl], 
                  Hue[\((i - 
                          1)\)\ 0.3]}, 
		PlotRange\  -> \ {{0, 2\ π}, {0, 4}}, 
              Axes -> 
                False, 
		DisplayFunction -> 
                Identity], 
\ \ {kk, 3  nc/4, 
              nc - 1}]; 

pendel2 = 
          Append[pendel2, 
Join[pendelvor2, 
              Rest[Reverse[pendelvor2\ ]], 
              Reverse[pendelzurueck2], 
	
              Rest[pendelzurueck2], {pendelvor2[\([1]\)]}]], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ {i, 1, 
          Length[aw]}];\)\)

Animation

pendel = 
        Table[Show[
            Flatten[Thread[{Transpose[pendel1][[k]], Transpose[
                      pendel2][[k]]}]], 
pc3, 
            AspectRatio  -> Automatic, 
            PlotRange  ->  {{-10 eps, 
                  2 π  + 10 eps}, {-10 eps, 4 + eps}}, 
            Prolog  ->  PointSize[ .01], 
            ImageSize ->  600], 
{k, 1, 
            nc - 1}];
SelectionMove[EvaluationNotebook[], After, 
        EvaluationCell];
SelectionMove[EvaluationNotebook[], Next, CellGroup];
FrontEndTokenExecute["OpenCloseGroup"];
start /. zeit -> 0.14 // DisplayForm

Lecture Notes,Fig.6.3

k = 8;
Show[
        Flatten[Thread[{Transpose[pendel1][[k]], Transpose[
                  pendel2][[k]]}]], pc3, AspectRatio -> Automatic, 
        PlotRange -> {{-10 eps, 2 π + 10 eps}, {-10 eps, 
              4 + eps}}, Prolog -> PointSize[ .01], 
        ImageSize -> 600];