Rotor

Author

Eric W. Weisstein
February 1, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/Rotor.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Rotor.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

Initilaization

Lens::usage="Lens[{v1,v2},n] gives a 60 Degree lens with endpoints v1 and v2 composed of n segments per curve.";
Rotor::usage="Rotor[ang,n] gives the triangular rotor for an angle -90 Degree < t < 90 Degree, together with the bounding equilateral triangle, where n is the number of segments per arc.";

Lens[{x_List,y_List},n_:20]:=Module[{l=Sqrt[(y[[2]]-x[[2]])^2+(y[[1]]-x[[1]])^2],m=(x+y)/2,ang=ArcTan[(y[[1]]-x[[1]]),(y[[2]]-x[[2]])]
(*ArcTan[(y[[2]]-x[[2]]),(y[[1]]-x[[1]])]*),u1,u2,t,dang,rim},dang=If[ang≤30.Degree,0,Pi];
u1=3/4/l{y[[2]]-x[[2]],-(y[[1]]-x[[1]])};
u2=-u1;
rim=Join[Table[m+u1+Sqrt[3]/2{Cos[ang+dang+t+Pi/2],Sin[ang+dang+t+Pi/2]},{t,-Pi/6,Pi/6,Pi/3/n}],Table[m+u2+Sqrt[3]/2{Cos[ang+dang+t+3Pi/2],Sin[ang+dang+t+3Pi/2]},{t,-Pi/6,Pi/6,Pi/3/n}]];
{{GrayLevel[.7],EdgeForm[],Polygon[rim]},Line[rim]}]

Rotor[t0_,n_:20]:=Module[{x1,y1,x2,y2,ends,t=Mod[t0,Pi]-Pi/2},Off[Solve::ifun];
ends=Which[t==-Pi/2,(*Print["region 0"];*){{{1/2,Sqrt[3]/2},{1/2,0}}},-30Degree≤t≤30Degree,(*Print["region 1"];*)Select[{{x1,y1},{x2,y2}}/.NSolve[{y1-Sqrt[3]/2==Sqrt[3](x1-1/2),y2-Sqrt[3]/2==-Sqrt[3](x2-1/2),(y1-y2)^2+(x1-x2)^2==3/4,(y2-y1)/(x2-x1)==Tan[t]},{x1,y1,x2,y2}],#[[1,1]]<#[[2,1]]&],-90Degree≤t<-30Degree,(*Print["region 2"];*)Select[{{x1,y1},{x2,y2}}/.NSolve[{y1-Sqrt[3]/2==Sqrt[3](x1-1/2),y2==0,(y1-y2)^2+(x1-x2)^2==3/4,(y2-y1)/(x2-x1)==Tan[t]},{x1,y1,x2,y2}],#[[1,1]]>0&],30Degree<t≤90Degree,(*Print["region 3"];*)Select[{{x1,y1},{x2,y2}}/.NSolve[{y1-Sqrt[3]/2==-Sqrt[3](x1-1/2),y2==0,(y1-y2)^2+(x1-x2)^2==3/4,(y2-y1)/(x2-x1)==Tan[t]},{x1,y1,x2,y2}],#[[1,2]]≥0&]][[1]];
On[Solve::ifun];
{Lens[ends,n],Line[{{0,0},{1/2,Sqrt[3]/2},{1,0},{0,0}}]}]

Lens in Triangle

V5

Show[GraphicsArray[
Table[Show[Graphics[Rotor[t,20]],
AspectRatio->Automatic,PlotRange->All,DisplayFunction->Identity],
{t,Pi/2,-Pi/2,-Pi/4.}]]]

movie=Table[Show[Graphics[Rotor[t,7]],
AspectRatio->Automatic,PlotRange->All],
{t,Pi/2,-Pi/2+Pi/20,-Pi/20}]

V6

Graphics[Rotor[.5,20]]

Block[{a=1},RegionPlot[(((-(a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2)&&(x^2)+(((-(a/(Sqrt[3]))+y))^2)≤(a^2)&&((((a/2)+x))^2)+((((a/(2 (Sqrt[3])))+y))^2)≤(a^2),{x,-1/2,1/2},{y,-.45,.6},AspectRatio->Automatic,PlotStyle->GrayLevel[.7],BoundaryStyle->Black,Frame->False,Epilog->Line[{{-1/2,-.42},{1/2,-.42},{1/2,.58},{-1/2,.58},{-1/2,-.42}}]]]

GraphicsRow[{,}]

"Rotor"->,

Export

<<Utilities`GIF`;

Export[gifs<>"rotor.gif",movie]

Deltoid in Astroid

movie=Table[ParametricPlot[{
{2Cos[t]+Cos[2t-2θ]+Cos[2 θ],2Sin[t]-Sin[2t-2θ]-Sin[2 θ]},
{3 Cos[t]+Cos[3 t],3 Sin[t]-Sin[3 t]}
},
{t,0,2Pi},
AspectRatio->Automatic,
Axes->False,
PlotStyle->{{},{Blue,Thickness[.015]}},
PlotRange->{{-1,1},{-1,1}}5
],{θ,0,π-2Pi/50,2π/50}]

Show[GraphicsArray[Partition[Take[movie,{1,25,2}],5]]]

Export

<<Utilities`GIF`;

Export[gifs<>"rotordel.gif",movie]//Timing