Lissajous Curve

Author

Eric W. Weisstein
March 16, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneCurves/LissajousCurve.nb.

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

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

Code

Lissajous[a_,w_,d_:0,opts___]:=ParametricPlot[{a Sin[w t+d],Sin[t]},{t,0,2Pi Denominator[w]},
opts,PlotStyle->Red,Ticks->None,AspectRatio->Automatic,
DisplayFunction->Identity]

Examples

Show[GraphicsArray[{{Lissajous[1,1/2],Lissajous[1,1/3],Lissajous[1,1/4]},{Lissajous[1,2/5],Lissajous[1,3/5],Lissajous[1,4/5]}}]]

MakeBoxes[label[2,1,0],TraditionalForm]:=RowBox[{RowBox[{"ω","==","1"}],",",RowBox[{"δ","==","0"}]}]
MakeBoxes[label[1,1,Times[Rational[1,2],Pi]],TraditionalForm]:=RowBox[{RowBox[{"a","==","b"}],","," ",RowBox[{"ω","==","1"}],",",RowBox[{"δ","==",RowBox[{"π","/","2"}]}]}]
MakeBoxes[label[1.5,1,Times[Rational[1,2],Pi]],TraditionalForm]:=RowBox[{RowBox[{"a","≠","b"}],","," ",RowBox[{"ω","==","1"}],",",RowBox[{"δ","==",RowBox[{"π","/","2"}]}]}]
MakeBoxes[label[1,2,Times[Rational[1,2],Pi]],TraditionalForm]:=RowBox[{RowBox[{"ω","==","2"}],",",RowBox[{"δ","==",RowBox[{"π","/","2"}]}]}]

Show[GraphicsArray[Partition[
Lissajous[Sequence@@#,PlotLabel->TraditionalForm[label@@#]]&/@{{2,1,0},{1,1,Pi/2},{1.5,1,Pi/2},{1,2,Pi/2}},2]],
GraphicsSpacing->{-.2,.1}
]

Line

Eliminate[{x==a TrigExpand[Sin[t+0]],y==b Sin[t],Sin[t]^2+Cos[t]^2==1},{Sin[t],Cos[t]}]

Circle

Eliminate[{x==a TrigExpand[Sin[t+π/2]],y==a Sin[t],Sin[t]^2+Cos[t]^2==1},{Sin[t],Cos[t]}]

Ellipse

Subtract@@Eliminate[{x==a TrigExpand[Sin[t+π/2]],y==b Sin[t],Sin[t]^2+Cos[t]^2==1},{Sin[t],Cos[t]}]/(a^2b^2)//Simplify

Parabola

With[{w=2,d=Pi/2},
{a Sin[w t+d],Sin[t]}
]

Simplify[{a(1-2Sin[t]^2),Sin[t]}]

Weaving

Ulises
March 7, 2011

Graphics`Mesh`MeshInit[]

p=ParametricPlot[{Cos[11x],Cos[13 x]},{x,0 ,Pi}]

lines=Cases[p,_Line,Infinity];

Graphics[slines=SimplifyPolyLine[lines[[1]],EdgesDistanceGoal->0.001,TestIntersections->False,SegmentLengthGoal->0.1,SegmentPartition->True]]

Graphics[{slines,Red,PointSize[0.04],Point@FindIntersections[slines]}]

components=FindIntersections[slines,Method->"SortBySegment"]/.{{c_,c_},{i_,j_}}->{i,j};

path=slines[[1]];

segments=Partition[path,2,1];

doverlap[{i_,j_}->pt_,r_]:= {Black,Line[segments[[i]]],White,Disk[pt,r],Black,Line[segments[[j]]]}

Graphics[{Thickness[0.005],slines,doverlap[#,0.03]& /@ components}]