Parametric Curves

Veikko Keränen 2006
Rovaniemi University of Applied Sciences
School of Technology
veikko.keranen@ramk.fi

Some examples left as exercises:

Task: Try to find some more beautiful curves than the one below. A logo perhaps.

This was created by Tuomas Valtanen, 2007:

Some simple parametric curves can be viewed from  here .

Clear[x,y];
r[t_]:= Abs[Cos[t]];
x[t_]:= r[t]*Cos[t];
y[t_]:= r[t]*Sin[t];

ParametricPlot[ {x[t],y[t]},
 {t,0,2Pi}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

Clear[x,y,r];
r[t_]:= Abs[Cos[t]]^4;
x[t_]:= r[t]*Cos[t];
y[t_]:= r[t]*Sin[t];

ParametricPlot[ {x[t],y[t]},
 {t,0,2Pi}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

Clear[x,y];
r[t_]:= Abs[Cos[t]]^4;
φ[t_]:= 2π*Sin[t]
x[t_]:= r[t]*Cos[φ[t]];
y[t_]:= r[t]*Sin[φ[t]];

ParametricPlot[ {x[t],y[t]},
 {t,0,2Pi}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

Some more experiments with an oscillating angle:

Clear[f];
f[t_]:=((-1)/(t-(π/2)-0.1))/; 0≤ t ≤ (π/2);
f[t_]:=(1/(t-(π/2)+0.1)) /; (π/2)≤ t ≤ π;

Plot[((-1)/(t-(π/2)-0.1)) ,{t,0,π}]

Plot[f[t],{t,0,π}]

Some smoother canditates for the angle variable:

Plot[t*E^(-5t),{t,0,2π}]

Solve[D[t*E^(-5t),t]==0,{t}]  (* find the x-value for the highest point *)

Plot[(E^(-(((t-(π/2)))^2))),{t,-2π,2π},PlotRange-> All]

Clear[x,y];
r[t_]:= Abs[Sin[t]]^4;
φ[t_]:= t;
x[t_]:= r[t]*Cos[φ[t]];
y[t_]:= r[t]*Sin[φ[t]];

ParametricPlot[ {x[t],y[t]},
 {t,0,π}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

Clear[x,y];
r[t_]:= Abs[Sin[t]]^4;
φ[t_]:= f[t]/4+t/3;
x[t_]:= r[t]*Cos[φ[t]];
y[t_]:= r[t]*Sin[φ[t]];

pic1=ParametricPlot[ {x[t],y[t]},
 {t,0,π}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

xy2RotMat[φ_] :=
 {{Cos[-φ],Sin[-φ]},
	 {-Sin[-φ],Cos[-φ]}};

pic2=ParametricPlot[ xy2RotMat[π].{x[t],y[t]},
 {t,0,π}, PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

Show[pic1,pic2]

As mentioned before, try to make the curve more beautiful. It may take some time, of course.

Let us now start a little bit different topic:

Clear[x,y];
x[t_]:= 2Cos[t];
y[t_]:= Sin[2t];

?ParametricPlot

ParametricPlot[ {x[t],y[t]},
 {t,0,2Pi},
 PlotRange->{{-2,2},{-1,1}},
 AspectRatio->1/2 ]

myCurve := Table[{x[t],y[t]}//N,
 {t,0,2Pi,Pi/16}]

myCurve

myGraphics = Graphics[
 {RGBColor[1,0,1],PointSize[0.05],
  Point /@ myCurve } ]

Here  Point /@ myCurve  is the same as  Map[Point,myCurve].
Map means: Multiply Apply

f /@ {a,b,c}

Map[f,{a,b,c}]

Point /@ myCurve

Show[ myGraphics,
 PlotRange->{{-3,3},{-1.5,1.5}},
 AspectRatio->1/2 ]

Let's make it more colorful

Length[myCurve]

Length[ {a,c,v,v,v,v} ]

myColors := Table[ 
 RGBColor[
  Random[],Random[],Random[] ],
   {Length[myCurve]} ];

myGraphics := Graphics[
 {PointSize[0.05], 
  Thread[ List[ myColors, 
   Point /@ myCurve ] ]
  } ]

Thread[ f[ {a,b,c},
           {x,y,z}
           ] ]

Thread[ f[ g[a,b,c], g[x,y,z]], g ]

Thread[ List[{a,b,c},{x,y,z}] ]

% // FullForm

Show[ myGraphics,
 PlotRange->{{-3,3},{-1.5,1.5}},
 AspectRatio->1/2]

Let's make it 3D

Clear[x,y,z];

x[t_]:=Cos[t];
y[t_]:=Sin[t];
z[t_]:=t/10;

myCurve=Table[{x[t],y[t],z[t]} //N, {t,0,6Pi,Pi/16}];

Length[myCurve]

myColors := Table[ RGBColor[Random[],Random[],Random[]], 
            {Length[myCurve]} ];

myGraphics := Graphics3D[ 
 { PointSize[0.05], 
   Thread[List[myColors, 
   Point /@ myCurve]] } ]

Show[myGraphics, 
     PlotRange->
     {{-1.5,1.5},{-1.5,1.5},{0,2}},
     AspectRatio->1,
     ViewPoint->{2.910, 4.054, 2.382}]

Abelian Square Free String over Four Letters

ga="abcacdcbcdcadcdbdabacabadbabcbdbcbacbcdcacbabdabacadcbcdcacdbcbacbcdcacdcbdcdadbdcbca";

gb="bcdbdadcdadbadacabcbdbcbacbcdcacdcbdcdadbdcbcabcbdbadcdadbdacdcbdcdadbdadcadabacadcdb";

gc="cdacabadabacbabdbcdcacdcbdcdadbdadcadabacadcdbcdcacbadabacabdadcadabacabadbabcbdbadac";

gd="dabdbcbabcbdcbcacdadbdadcadabacabadbabcbdbadacdadbdcbabcbdbcabadbabcbdbcbacbcdcacbabd";

Clear[myColors]
myColors := Characters[ga<>gb<>gc<>ga]/. 
 {"a"->RGBColor[1.000, 0.280, 0.710], 
  "b"->RGBColor[0.100, 0.860, 0.150],
  "c"->RGBColor[1,1,0],
  "d"->RGBColor[0.500, 0.500, 1.000]};

myCurve=Table[{x[t],y[t],z[t]} //N,
         {t,0,8Pi,8Pi/(Length[myColors]-1)}];

{Length[myColors],Length[myCurve]}

myGraphics := Graphics3D[ 
 { PointSize[0.03], 
 Thread[List[myColors, 
   Point /@ myCurve]] } ]

Show[myGraphics, 
     PlotRange->
     {{-1.5,1.5},{-1.5,1.5},{0,2.7}},
     AspectRatio->1,
     ViewPoint->{1.5, -3, 1.5}]

pic=Plot[Sin[1/(0.1-x)],{x,0.05,0.09} ,
	PlotPoints->100]

Length[ pic[[1,1,1,1]] ]

ga

StringLength[ga]

productions[x_]:= StringReplace[x, {"a"->"ab","b"->"ba"}]

NestList[productions,"a",5] //TableForm

gga = StringReplace[ga, {"a"->ga,"b"->gb,"c"->gc,"d"->gd}];

StringLength[gga]

?StringTake

myString:=StringTake[gga,Length[ pic[[1,1,1,1]] ]];

Clear[myColors]
myColors := Characters[myString] /. 
 {"a"->RGBColor[1.000, 0.280, 0.710],
  "b"->RGBColor[0.100, 0.860, 0.150],
  "c"->RGBColor[1,1,0],
  "d"->RGBColor[0.500, 0.500, 1.000]};

myGraphics := Graphics[ 
 { PointSize[0.02], 
   Thread[List[myColors, 
   Point /@  pic[[1,1,1,1]] ]] } ]

Show[pic,myGraphics]