Planar Curves

Exploring differential geometry of planar curves with Mathematica

Professor Mohammad Ghomi
Math 497C, PSU, Fall 2004

Introduction

This notebook  contains several miniprograms  for studying the differential geometry of curves in the Euclidean plane. It also loads up the programs written by Alfred Gray, including the definitions for dozens of curves. To study a specific curve, you may either define it directly, or find its parametrization from the list of preprogramed curves.

How to define a parametrized curve?

The general format is

c[t_] := { x[t]   ,   y[t] }

The Following cell for, instance,

c[t_] := { Cos[t]   ,   Sin[t] }

defines a circle of radius one.

How to find the parametrizations for famous curves?

If you do not know the coordinate functions for the curve which you wish to study, but  know the name of the curve, then the chances are that the formula for it is already included in the Gray's package CURVES which is loaded automatically. To check that this is the case, consult the section "Index of Curves" below or just type "?" followed by the name of the curve. For instance:

?circle

So the circle is already in the package. To see the formula for it, just type:

circle[r][t]

To see the complete list of preprogramed curves, you may simply type "curves" at any time.

curves

How to find the description of various commands?

At any place in this notebook you can find the description of any command by using  "?". This may also show the full name of the command including its variables. Then you may type the full name to find the defintion of each command. Here are some examples:

?kappa

kappa[a][t]

?cross

Initialization

Warnings Turned Off

Off[General::spell]

Off[General::spell1]

Off[ParametricPlot::ppcom]

Off[$MaxExtraPrecision::meprec]

Off[Graphics::gptn]

Off[N::meprec]

Off[NIntegrate::ploss]

Off[SetDelayed::write]

Off[Power::infy]

Off[∞::indet]

Standard Mathematica Packages

<< Graphics`Colors`

<< Graphics`Shapes`

<< Graphics`Arrow`

Gray's Packages

"PLTPROGS" (Plotting Enhancements for Mathematica)

(*:Sat May 23 21:47:33 MET DST 1998*)

(*:Title: PLTPROGS.m *)

(*:Author: Alfred Gray *)

(* Copyright 1994-1998 by Alfred Gray *)

(*:Package Version: 1.0 *)

(*:Mathematica Versions: 2.2, 3.0 *)

(*:Summary: 
This package consists of several plotting enhancements 
useful for plotting curves and surfaces.
*)

(*:Keywords:
borderedpolygon, centerlines, checkerboard, dip, elrot, 
filledcurve, graphics2dtosurfrev, lathe, linetolines, 
nomesh, orth4d, paramcurveplot1, paramcurveplot2, 
plotpatch2d, polygonholes, primitiveplot3d, selectcolgraphics3d,
 selectgraphics3d, ShowInNotebook, surfacecurveplot, stereo4d, 
 wireframe, WriteAcroLines, WriteAcroPoints, Write2COLMESH, 
 Write3DCMESH, Write3DCNMESH, Write3DMESH
*)

BeginPackage["PLTPROGS`"]

     pltprogs:=Print[Select[Names["PLTPROGS`*"],#!="pltprogs"&]]

(* Miscellaneous Plotting Programs *)

     barycenter::usage="barycenter[Polygon[{pt1,...,ptn}]] subdivides a polygon using its barycenter."

     borderedpolygon::usage="borderedpolygon[intsty,borsty,versty,pts] creates from the list pts a polygonal region whose vertices are the elements of pts. The directives constituting intsty are applied to the interior, the directives constituting borsty are applied to the boundary, and the directives constituting versty are applied to the vertices."

     centerlines::usage="centerlines[...] has the same syntax as ParametricPlot3D[...]. It plots a parametric patch in R^3, but adds lines connecting the center of each quadrilateral to its vertices. centerlines[graphic] adds lines connecting the center of each quadrilateral to its vertices."

     checkerboard::usage="checkerboard[...] has the same syntax as ParametricPlot3D[...]. It plots a parametric patch in R^3 in a checker board fashion.  checkerboard[graphic] gives a checkerboard pattern to a graphic."

    dip::usage="DisplayFunction->dip[ins] inserts a Graphics3D primitive at the beginning of a Graphics3D list when the list is displayed. For example, DisplayFunction->dip[EdgeForm[]] displays polygons with no edges."

    elrot::usage="elrot[p,q][theta][aa_List] is the elementary rotation by an angle theta of pth and qth elements of the list aa."

    filledcurve::usage="filledcurve parametrically plots a plane curve and fills it in. It has the same syntax as ParametricPlot.  filledcurve[graphic] fills in a graphic."

    graphics2dtosurfrev::usage="graphics2dtosurfrev[r,n][list] constructs a surface of revolution of radius r from a Graphics list of lines. Each circle of latitude is approximated by a regular polygon with n vertices."

    lathe::usage="lathe[dots] creates a surface of revolution with no edges from a list of points in the plane."

    linetolines::usage="linetolines[Line[{pt1,...,ptn}]] converts a broken line segment Line[{pt1,...,ptn}] into a list of line segments connecting consecutive pairs of the points pt1,...,ptn."

    nomesh::usage="nomesh[graphic] converts a graphic to a graphic with no edges."

    orth4d::usage="orth4d[surf,{u,umin,umax},{v,vmin,vmax},opts] uses GraphicsArray to plot a surface in R^4 via the four orthogonal projections from R^4 to R^3."

    paramcurveplot1::usage="paramcurveplot1 has the same syntax as ParametricPlot3D, except that a PlotPoints specification is obligatory. It plots the parameter lines u->x[u,v0] of a parametric patch surface:U->R^3."

    paramcurveplot2::usage="paramcurveplot2 has the same syntax as
ParametricPlot3D, except that a PlotPoints specification is obligatory. It plots the parameter lines v->x[u0,v] of a parametric patch surface:U->R^3."

    plotpatch2d::usage="plotpatch2d has the same syntax as ParametricPlot. It plots the images of horizontal and vertical lines under the function f:U->R^2. plotpatch2d has the same functionality as Maeder's CartesianMap and PolarMap, but draws curved instead of straight lines."

    polygonholes::usage="polygonholes[fac][...] has the same syntax as ParametricPlot3D[...]. It plots a parametric patch in R^3 with holes in each polygon, where fac is the ratio of the size of each hole to that of the original polygon containing it.  polygonholes[fac][graphic]  puts a hole in each polygon, where fac is the ratio of the size of each hole to that of the original polygon containing it."

    selectgraphics3d::usage="selectgraphics3d[graphics3dobj,bound,opts] selects from a list of polygons those whose vertices have their coordinates bounded by bound, and then displays the results."

    selectcolgraphics3d::usage="selectcolgraphics3d[graphics3dobj,bound,opts] selects from a list of colored polygons those whose vertices have their coordinates bounded by bound, and then displays the results."

    stereo4d::usage="stereo4d[{a,b,c,d},surf,{u,umin,umax},{v,vmin,vmax},opts] uses GraphicsArray to plot a surface in R^4 via the four stereographic projections from R^4 to R^3 with respect to the point {a,b,c,d} in R^4."

    ShowInNotebook::usage="ShowInNotebook[graphics,nbopts] displays a graphic in a separate notebook."

    surfacecurveplot::usage="surfacecurveplot[surface,{u,u0,u1},{v,v0,v1}, PlotLines->{ulines,vlines},PlotPoints->{upoints,vpoints},opts] plots both the u- and v-parameter curves of a patch x:U->R^3. The number of curves is specified with PlotLines, and the resolution of the lines is specified with PlotPoints."

    wireframe::usage="wireframe[...] has the same syntax as ParametricPlot3D[...]. It plots a wireframe of a parametric patch in R^3.  wirframe[graphic] converts a solid graphic into a wireframe graphic."

(* Mathematica to Acrospin Programs *)

primitiveplot3d::usage="primitiveplot3d[{fx,fy,fz},{t,tmin,tmax}]
produces a list of points of a space curve parametrized by a variable
t which runs from tmin to tmax. primitiveplot3d[{fx,fy,fz},{t,tmin,tmax},{u,umin,umax}] produces a list of points by polygons of a surface parametrized by
t and u."

WriteAcroLines::usage="WriteAcroLines[{color},file,{fx,fy,fz},
{t,tmin,tmax}] outputs to a file in acrospin line format the
parametric plot of a space curve. WriteAcroLines[{color1,color2},file,{fx,fy,fz},{t,tmin,tmax},{u,umin,umax}] outputs to a file in acrospin line format the parametric plot of a surface."

WriteAcroPoints::usage="WriteAcroPoints[{color},file,{fx,fy,fz},
{t,tmin,tmax}] outputs to a file in acrospin point format the
parametric plot of a space curve.
WriteAcroPoints[{color},file,{fx,fy,fz},{t,tmin,tmax},{u,umin,umax}]
outputs to a file in acrospin point format the parametric plot of a surface."

(* Mathematica to Geomview Programs *)

Write3DMESH::usage="Write3DMESH[file,expression,{u,umin,umax},{v,vmin,vmax},
PlotPoints->{udiv,vdiv},opts] outputs to a file in mesh format the
parametric plot of a surface."

Write3DCMESH::usage="Write3DCMESH[file,{expression,color},
{u,umin,umax},{v,vmin,vmax},PlotPoints->{udiv,vdiv},opts] outputs to a file
in mesh format the parametric plot of expression colored by color."

Write3DCNMESH::usage="Write3DCNMESH[file,{expression,unitn,color},
{u,umin,umax},{v,vmin,vmax},
PlotPoints->{udiv,vdiv},opts] outputs to a file in mesh format the
parametric plot of expression colored by color with normal information unitn."

Write2COLMESH::usage="Write2COLMESH[{color1,color2},file,expression,
{u,umin,umax},{v,vmin,vmax},
PlotPoints->{udiv,vdiv},opts] outputs to a file in mesh format the parametric plot of a surface with one side color1 and the other color2."

Begin["`Private`"]

(* Miscellaneous Plotting Programs *)

  barycenter[Polygon[pts_]]:=
        Module[{ptstmp},
        ptstm=Append[pts,First[pts]];
	Table[Polygon[{ptstm[[i]],ptstm[[i + 1]],
        Plus@@pts/Length[ptstm]}],{i,Length[ptstm] - 1}]]

  borderedpolygon[intsty_,borsty_,versty_,pts_]:=
        {Flatten[{intsty,Polygon[pts]}],
         Flatten[{borsty,Line[Append[pts,First[pts]]]}],
         Flatten[{versty,Point/@pts}]}

    centerlines[surface_,{u_,u0_,u1_},{v_,v0_,v1_},opts___]:=
        Module[{plottmp,grtmp},
                plottmp = ParametricPlot3D[
                surface//Evaluate,{u,u0,u1},{v,v0,v1},
                DisplayFunction->Identity,opts];
                grtmp = plottmp /.
     (Polygon[pts_]:>
     {Polygon[Append[pts[[{1,2}]],Plus@@pts/4]],
      Polygon[Append[pts[[{2,3}]],Plus@@pts/4]],
      Polygon[Append[pts[[{3,4}]],Plus@@pts/4]],
      Polygon[Append[pts[[{4,1}]],Plus@@pts/4]]});
        Show[grtmp,DisplayFunction->$DisplayFunction]]

    centerlines[graphic_]:=Show[graphic /. (Polygon[pts_]:>
     {Polygon[Append[pts[[{1,2}]],Plus@@pts/4]],
      Polygon[Append[pts[[{2,3}]],Plus@@pts/4]],
      Polygon[Append[pts[[{3,4}]],Plus@@pts/4]],
      Polygon[Append[pts[[{4,1}]],Plus@@pts/4]]})]

    checkerboard[surface_,{u_,u0_,u1_},{v_,v0_,v1_},opts___]:=
        Module[{plottmp,grtmp},
                plottmp = ParametricPlot3D[
                surface,{u,u0,u1},{v,v0,v1},
                DisplayFunction->Identity,opts];
                grtmp = plottmp /.(Polygon[pts_]:> 
                Polygon[(pts + RotateRight[pts])/2]);
        Show[grtmp,DisplayFunction->$DisplayFunction]]

    checkerboard[graphic_]:=Show[graphic /. (Polygon[pts_]:>
        Polygon[(pts + RotateRight[pts])/2])]

    dip[ins_][g_]:= $DisplayFunction[Insert[g,ins,{1,1}]]

    elrot[p_,q_][theta_][aa_List]:=ReplacePart[ReplacePart[
        aa,aa[[p]]*Cos[theta] + aa[[q]]*Sin[theta],p],
        -aa[[p]]*Sin[theta] + aa[[q]]*Cos[theta],q]

    filledcurve[curve_,{u_,u0_,u1_},opts___]:=
        Module[{plottmp,grtmp},
            plottmp = ParametricPlot[
            curve//Evaluate,{u,u0,u1},AspectRatio->Automatic,
            DisplayFunction->Identity,opts];
            grtmp = plottmp /. (Line[pts_]:> Polygon[pts]);
        Show[grtmp,DisplayFunction->$DisplayFunction]]
    
    filledcurve[graphic_]:=Show[graphic /. (Line[pts_]:> 
    Polygon[pts])]

    graphics2dtosurfrev[r_,n_][Line[{{a_,b_},{c_,d_}}]]:=
        Table[Polygon[{
        {r*a*Cos[2*Pi*(k - 1)/n],r*a*Sin[2*Pi*(k - 1)/n],b},
        {r*a*Cos[2*Pi*k/n],r*a*Sin[2*Pi*k/n],b},
        {r*c*Cos[2*Pi*k/n],r*c*Sin[2*Pi*k/n],d},
        {r*c*Cos[2*Pi*(k - 1)/n],
                r*c*Sin[2*Pi*(k - 1)/n],d}}],{k,n}]

   lathe[dots_]:=Show[Graphics3D[
      Map[graphics2dtosurfrev[0.5,60],
      linetolines[Line[dots]]]],Boxed->False,
      DisplayFunction->dip[EdgeForm[]]]

    linetolines[Line[pts_]]:= Table[Line[{pts[[i]],
             pts[[i + 1]]}],{i,Length[pts] - 1}]

   nomesh[graphics_]:=
      Show[graphics,DisplayFunction->dip[EdgeForm[]]]

    orth4d[surf_,{u_,umin_,umax_},{v_,vmin_,vmax_},opts___]:=
        Module[{g1,g2,g3,g4},
        g1=ParametricPlot3D[Evaluate[
                Drop[surf,{1}]],{u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g2=ParametricPlot3D[Evaluate[
                Drop[surf,{2}]],{u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g3=ParametricPlot3D[Evaluate[
                Drop[surf,{3}]],{u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g4=ParametricPlot3D[Evaluate[
                Drop[surf,{4}]],{u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        Show[GraphicsArray[{{g1,g2},{g3,g4}}],
                GraphicsSpacing->{0.2,0},
                DisplayFunction->$DisplayFunction]]

    paramcurveplot1[surface_,{u_,u0_,u1_},{v_,v0_,v1_},
        PlotPoints->{upoints_,vpoints_},opts___]:=
        ParametricPlot3D[Table[
        surface,{v,v0,v1,(v1-v0)/(vpoints - 1)}]//Evaluate,
        {u,u0,u1},PlotPoints->upoints,opts]

    paramcurveplot2[surface_,{u_,u0_,u1_},{v_,v0_,v1_},
        PlotPoints->{upoints_,vpoints_},opts___]:=
        ParametricPlot3D[Table[
        surface,{u,u0,u1,(u1-u0)/(upoints - 1)}]//Evaluate,
        {v,v0,v1},PlotPoints->vpoints,opts]

    plotpatch2d[expr_,{x_,xmin_,xmax_},{y_,ymin_,ymax_},
        PlotPoints->{xpoints_,ypoints_},opts___]:=
        Show[ParametricPlot[Evaluate[
        Table[ComplexExpand[
        {Re[expr],Im[expr]}],
        {y,ymin,ymax,(ymax - ymin)/(ypoints - 1)}]],
        {x,xmin,xmax},PlotPoints->xpoints,
        DisplayFunction->Identity],
        ParametricPlot[Evaluate[
        Table[ComplexExpand[
        {Re[expr],Im[expr]}],
        {x,xmin,xmax,(xmax - xmin)/(xpoints -1)}]],
        {y,ymin,ymax},PlotPoints->ypoints,
        DisplayFunction->Identity],
        AspectRatio->Automatic,
        DisplayFunction->$DisplayFunction,opts]

    polygonholes[fac_][surface_,{u_,u0_,u1_},{v_,v0_,v1_},opts___]:=
        Module[{plottmp,grtmp},
                plottmp = ParametricPlot3D[
                surface,{u,u0,u1},{v,v0,v1},
                DisplayFunction->Identity,opts];
                grtmp = plottmp /.(Polygon[pts_]:> 
                (cntr=(Plus@@pts)/Length[pts];
                sp=(fac*(# - cntr) + cntr)&/@pts;
                Polygon/@Transpose[{pts,RotateLeft[pts],
                RotateLeft[sp],sp}]));
        Show[grtmp,DisplayFunction->$DisplayFunction]]

    polygonholes[fac_][graphic_]:=Show[graphic /. (Polygon[pts_]:>
        (cntr=(Plus@@pts)/Length[pts];
                sp=(fac*(# - cntr) + cntr)&/@pts;
                Polygon/@Transpose[{pts,RotateLeft[pts],
                RotateLeft[sp],sp}]))]

    selectgraphics3d[graphics3dobj_,bound_,opts___]:=
        Show[Graphics3D[Select[graphics3dobj,
        (Abs[#[[1,1,1]]]<bound && Abs[#[[1,1,2]]]<bound &&
         Abs[#[[1,1,3]]]<bound && Abs[#[[1,2,1]]]<bound &&
         Abs[#[[1,2,2]]]<bound && Abs[#[[1,2,3]]]<bound &&
         Abs[#[[1,3,1]]]<bound && Abs[#[[1,3,2]]]<bound &&
         Abs[#[[1,3,3]]]<bound && Abs[#[[1,4,1]]]<bound &&
         Abs[#[[1,4,2]]]<bound && Abs[#[[1,4,2]]]<bound
         )&]],opts]

    selectcolgraphics3d[graphics3dobj_,bound_,opts___]:=
        Show[Graphics3D[Select[graphics3dobj,
        (Abs[#[[2,1,1,1]]]<bound && Abs[#[[2,1,1,2]]]<bound &&
        Abs[#[[2,1,1,3]]]<bound && Abs[#[[2,1,2,1]]]<bound &&
        Abs[#[[2,1,2,2]]]<bound && Abs[#[[2,1,2,3]]]<bound &&
        Abs[#[[2,1,3,1]]]<bound && Abs[#[[2,1,3,2]]]<bound &&
        Abs[#[[2,1,3,3]]]<bound && Abs[#[[2,1,4,1]]]<bound &&
        Abs[#[[2,1,4,2]]]<bound && Abs[#[[2,1,4,2]]]<bound
         )&]],opts]

    stereo4d[{a_,b_,c_,d_},surf_,
        {u_,umin_,umax_},{v_,vmin_,vmax_},opts___]:=
        Module[{g1,g2,g3,g4},
        g1=ParametricPlot3D[Evaluate[
                Drop[surf,{1}]/(a-surf[[1]])],
                {u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g2=ParametricPlot3D[Evaluate[
                Drop[surf,{2}]/(b-surf[[2]])],
                {u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g3=ParametricPlot3D[Evaluate[
                Drop[surf,{3}]/(c-surf[[3]])],
                {u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        g4=ParametricPlot3D[Evaluate[
                Drop[surf,{4}]/(d-surf[[4]])],
                {u,umin,umax},{v,vmin,vmax},
                DisplayFunction->Identity,opts];
        Show[GraphicsArray[{{g1,g2},{g3,g4}}],
                GraphicsSpacing->{0.2,0},
                DisplayFunction->$DisplayFunction]]

    ShowInNotebook[gr_,nbopts___]:=
    Module[{nb},
        nb = NotebookPut[Notebook[{
            Cell[GraphicsData["PostScript",
                              DisplayString[gr]],
                 "Graphics",
                 ImageSize->{350,350},
                 ImageMargins -> {{0,0},{0,0}},
                 CellMargins -> {{0,0},{0,0}}]},
            nbopts,WindowSize->Fit,Visible -> False,
            ShowCellBracket -> False,WindowElements->{},
            WindowFrameElements->"CloseBox"]];
        SetOptions[nb,WindowSize->Fit];
        SetOptions[nb,Visible->True];
        nb]

    surfacecurveplot[surface_,{u_,u0_,u1_},{v_,v0_,v1_},
        PlotLines->{ulines_,vlines_},
        PlotPoints->{upoints_,vpoints_},opts___]:=
            Show[paramcurveplot1[surface,{u,u0,u1},{v,v0,v1},
                PlotPoints->{upoints,ulines},
                DisplayFunction->Identity,opts],
                paramcurveplot2[surface,{u,u0,u1},{v,v0,v1},
                PlotPoints->{vlines,vpoints},
                DisplayFunction->Identity,opts],
                DisplayFunction->$DisplayFunction]

    wireframe[surface_,{u_,u0_,u1_},{v_,v0_,v1_},opts___]:=
        Module[{plottmp,grtmp},
                plottmp = ParametricPlot3D[
                surface,{u,u0,u1},{v,v0,v1},
                DisplayFunction->Identity,opts];
                grtmp = plottmp /.(Polygon[pts_]:> 
                Line[Append[pts,First[pts]]]);
        Show[grtmp,DisplayFunction->$DisplayFunction]]

    wireframe[graphic_]:=Show[graphic /. (Polygon[pts_]:> 
                Line[Append[pts,First[pts]]])]

(* Mathematica to Acrospin Programs *)

blue             = 1
green            = 2
cyan             = 3
red              = 4
magenta          = 5
brown            = 6
white            = 7
darkgray         = 8
lightblue        = 9
lightgreen       = 10
lightcyan        = 11
lightred         = 12
lightmagenta     = 13
yellow           = 14
intensifiedwhite = 15

primitiveplot3d[exp_,{t_,tmin_,tmax_},opts___]:=
First[ParametricPlot3D[exp,
{t,tmin,tmax},opts,
DisplayFunction->Identity]] /.
(Line[pts_] :> pts)

primitiveplot3d[exp_,{u_,umin_,umax_},{v_,vmin_,vmax_},opts___]:=
First[ParametricPlot3D[exp,
{u,umin,umax},{v,vmin,vmax},opts,
DisplayFunction->Identity]] /.
(Polygon[pts_] :> pts)

WriteAcroLines[{color_},file_String,curve_,
{t_,tmin_,tmax_},opts___]:=
Module[{tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8},
OpenWrite[file];
WriteString[file,"Set Color"];
WriteString[file,color];
WriteString[file,"\n"];
WriteString[file,"EndPointList name X Y Z\n"];
tmp1=primitiveplot3d[curve//Evaluate,
{t,tmin,tmax},opts];
tmp2=Flatten[tmp1,1];
tmp3=Chop[tmp2,10^-3];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
tmp5=Table[
{StringForm["VERTEX``",j],tmp4[[j]]},
{j,Length[tmp3]}];
tmp6=Map[Flatten[#,1]&,tmp5,{1}];
Scan[
(WriteString[file,First[#]];
Scan[WriteString[file,"   ",#]&,Rest[#]];
WriteString[file,"\n"])&,
tmp6];
WriteString[file,"\nLineList from to\n"];
tmp7=Table[
StringForm["VERTEX`` VERTEX``\n",j,j+1],
{j,Length[tmp3]-1}];
Scan[WriteString[file,#,"\n"]&,tmp7];
Close[file]]

WriteAcroLines[{color1_:12,color2_:14},
file_String,surface_,
{u_,umin_,umax_},{v_,vmin_,vmax_},opts___]:=
Module[{tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,
tmp7,tmp8,tmp9,tmp10,tmp11,tmp12},
OpenWrite[file];
WriteString[file,"EndPointList name X Y Z\n\n"];
tmp1=primitiveplot3d[surface//Evaluate,
{u,umin,umax},{v,vmin,vmax},opts];
tmp2=Chop[tmp1,10^-3];
tmp3=Map[PaddedForm[#,{4,4}]&,tmp2,{3}];
tmp4=Table[
{StringForm["POLY``VERTEX``",j,k],tmp3[[j,k]]},
{j,Length[tmp3]},{k,4}];
tmp5=Map[Flatten[#,1]&,tmp4,{2}];
tmp6=Flatten[tmp5,1];
Scan[WriteString[file,"   ",#]&,Rest[#]];
Scan[
(WriteString[file,First[#]];
Scan[WriteString[file,"   ",#]&,Rest[#]];
WriteString[file,"\n"])&,
tmp6];
WriteString[file,"\nLineList from to Color Layer\n\n"];
tmp7=Table[
StringForm["POLY``VERTEX`` POLY``VERTEX`` `` ``\n",
j,1,j,2,color1,1],{j,Length[tmp3]}];
tmp8=Table[
StringForm["POLY``VERTEX`` POLY``VERTEX`` `` ``\n",
j,4,j,3,color1,1],{j,Length[tmp3]}];
tmp9=Join[tmp7,tmp8];
Scan[WriteString[file,#,"\n"]&,tmp9];
tmp10=Table[
StringForm["POLY``VERTEX`` POLY``VERTEX`` `` ``\n",
j,1,j,4,color2,2],{j,Length[tmp3]}];
tmp11=Table[
StringForm["POLY``VERTEX`` POLY``VERTEX`` `` ``\n",
j,3,j,2,color2,2],{j,Length[tmp3]}];
tmp12=Join[tmp10,tmp11];
Scan[WriteString[file,#,"\n"]&,tmp12];
Close[file]]

WriteAcroPoints[{color_},file_String,curve_,
{t_,tmin_,tmax_},opts___]:=
Module[{tmp1,tmp2,tmp3,tmp4},
OpenWrite[file];
WriteString[file,"Set Color"];
WriteString[file,color];
WriteString[file,"\n"];
WriteString[file,"PointList X Y Z\n"];
tmp1=primitiveplot3d[curve//Evaluate,
{t,tmin,tmax},opts];
tmp2=Union[Flatten[tmp1,1]];
tmp3=Chop[tmp2,10^-3];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
Scan[
(WriteString[file,First[#]];
Scan[WriteString[file,"   ",#]&,Rest[#]];
WriteString[file,"\n"])&,
tmp4];
Close[file]]

WriteAcroPoints[{color_},file_String,surface_,
{u_,umin_,umax_},{v_,vmin_,vmax_},opts___]:=
Module[{tmp1,tmp2,tmp3,tmp4},
OpenWrite[file];
WriteString[file,"Set Color"];
WriteString[file,color];
WriteString[file,"\n"];
WriteString[file,"PointList X Y Z\n"];
tmp1=primitiveplot3d[surface//Evaluate,
{u,umin,umax},{v,vmin,vmax},opts];
tmp2=Union[Flatten[tmp1,1]];
tmp3=Chop[tmp2,10^-3];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
Scan[
(WriteString[file,First[#]];
Scan[WriteString[file,"   ",#]&,Rest[#]];
WriteString[file,"\n"])&,
tmp4];
Close[file]]

(* Mathematica to Geomview Programs *)

Write3DMESH[file_String,expression_,
{u_,umin_,umax_},{v_,vmin_,vmax_},
PlotPoints->{udiv_,vdiv_},otmp___]:=
Module[{tmp1,tmp2,tmp3,tmp4},
OpenWrite[file];
WriteString[file,"MESH\n"];
WriteString[file,ToString[vdiv+1]];
WriteString[file," "];
WriteString[file,ToString[udiv+1]];
WriteString[file,"\n"];
tmp1=N[Table[expression,
    {u,umin,umax,(umax-umin)/udiv},
    {v,vmin,vmax,(vmax-vmin)/vdiv}]];
tmp2=Flatten[tmp1,1];
tmp3=Chop[tmp2,10^-4];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
Scan[
   (WriteString[file,First[#]];
    Scan[WriteString[file,"   ",#]&,Rest[#]];
    WriteString[file,"\n"])&,tmp4];
Close[file]]

Write3DCMESH[file_String,{expression_,color_},
{u_,umin_,umax_},{v_,vmin_,vmax_},
PlotPoints->{udiv_,vdiv_},otmp___]:=
Module[{tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7},
OpenWrite[file];
WriteString[file,"CMESH\n"];
WriteString[file,ToString[vdiv+1]];
WriteString[file," "];
WriteString[file,ToString[udiv+1]];
WriteString[file,"\n"];
tmp1=N[Table[{expression,HSBColor[color,1,1]},
    {u,umin,umax,(umax-umin)/udiv},
    {v,vmin,vmax,(vmax-vmin)/vdiv}]];
tmp2=Apply[List,tmp1,{3}];
tmp3=Map[Flatten[#]&,tmp2,{2}];
tmp4=Flatten[tmp3,1];
tmp5=Map[Append[#,1]&,tmp4];
tmp6=Chop[tmp5,10^-4];
tmp7=Map[PaddedForm[#,{4,4}]&,tmp6,{2}];
Scan[
   (WriteString[file,First[#]];
    Scan[WriteString[file,"   ",#]&,Rest[#]];
    WriteString[file,"\n"])&,tmp7];
Close[file]]



Write3DCNMESH[file_String,{expression_,unitn_,color_},
{u_,umin_,umax_},{v_,vmin_,vmax_},
PlotPoints->{udiv_,vdiv_},otmp___]:=
Module[{tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7},
OpenWrite[file];
WriteString[file,"CNMESH\n"];
WriteString[file,ToString[vdiv+1]];
WriteString[file," "];
WriteString[file,ToString[udiv+1]];
WriteString[file,"\n"];
tmp1=N[Table[{expression,unitn,HSBColor[color,1,1]},
    {u,umin,umax,(umax-umin)/udiv},
    {v,vmin,vmax,(vmax-vmin)/vdiv}]];
tmp2=Apply[List,tmp1,{3}];
tmp3=Map[Flatten[#]&,tmp2,{2}];
tmp4=Flatten[tmp3,1];
tmp5=Map[Append[#,1]&,tmp4];
tmp6=Chop[tmp5,10^-4];
tmp7=Map[PaddedForm[#,{4,4}]&,tmp6,{2}];
Scan[
   (WriteString[file,First[#]];
    Scan[WriteString[file,"   ",#]&,Rest[#]];
    WriteString[file,"\n"])&,tmp7];
Close[file]]

Write2COLMESH[file_String,expression_,
{u_,umin_,umax_},{v_,vmin_,vmax_},
PlotPoints->{udiv_,vdiv_},otmp___]:=
Module[{tmp1,tmp2,tmp3,tmp4},
OpenWrite[file];
WriteString[file,"appearance {\n"];
WriteString[file,"material {\n"];
WriteString[file,"emission 1 1 0\n"];
WriteString[file,"diffuse  1 0 0}}\n"];
WriteString[file,"MESH\n"];
WriteString[file,ToString[vdiv+1]];
WriteString[file," "];
WriteString[file,ToString[udiv+1]];
WriteString[file,"\n"];
tmp1=N[Table[expression,
    {u,umin,umax,(umax-umin)/udiv},
    {v,vmin,vmax,(vmax-vmin)/vdiv}]];
tmp2=Flatten[tmp1,1];
tmp3=Chop[tmp2,10^-4];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
Scan[
   (WriteString[file,First[#]];
    Scan[WriteString[file,"   ",#]&,Rest[#]];
    WriteString[file,"\n"])&,tmp4];
Close[file]]

Write2COLMESH[{color1_,color2_},file_String,expression_,
{u_,umin_,umax_},{v_,vmin_,vmax_},
PlotPoints->{udiv_,vdiv_},otmp___]:=
Module[{cc1,cc2,cc3,dd1,dd2,dd3,df,em,tmp1,tmp2,tmp3,tmp4},
OpenWrite[file];
WriteString[file,"appearance {\n"];
WriteString[file,"material {\n"];
{cc1,cc2,cc3}=List@@color1;
em=StringForm["emission `` `` ``\n",cc1,cc2,cc3];
WriteString[file,em];
{dd1,dd2,dd3}=List@@color2;
df=StringForm["diffuse `` `` ``}}\n",dd1,dd2,dd3];
WriteString[file,df];
WriteString[file,"MESH\n"];
WriteString[file,ToString[vdiv+1]];
WriteString[file," "];
WriteString[file,ToString[udiv+1]];
WriteString[file,"\n"];
tmp1=N[Table[expression,
    {u,umin,umax,(umax-umin)/udiv},
    {v,vmin,vmax,(vmax-vmin)/vdiv}]];
tmp2=Flatten[tmp1,1];
tmp3=Chop[tmp2,10^-4];
tmp4=Map[PaddedForm[#,{4,4}]&,tmp3,{2}];
Scan[
   (WriteString[file,First[#]];
    Scan[WriteString[file,"   ",#]&,Rest[#]];
    WriteString[file,"\n"])&,tmp4];
Close[file]]

End[]

EndPackage[]

"CSPROGS" (Programs for Manipulating Curves and Surfaces)

(*:Title: CSPROGS *)

(*:Author: Alfred Gray *)

(* Copyright 1994  by Alfred Gray *)

(*:Package Version: 1.0 *)

(*:Mathematica Version: 2.2 *)

(*:Summary: 
	This package consists of miniprgrams to compute curvature, 
	torsion and related geometric quantities associated with 
	curves and surfaces.
*)

(*:Keywords:
analytictominimal, arclength, arclengthprime, asymeq1, 
asymeq2, binormal, binormalsurf, brioschicurvature, 
christoffel, circle3point, cone, Cross, ctor, curveonsurf, 
cylinder, darbouxvector, der, divergence, ee, eee, eeee, 
evolute, ff, fff, ffff, focalkmu, focalkpi, focalk1, focalk2, 
frenetframe, gaussiancurvature, gcurvature, genhel, gensurfrev, 
geo, geodesiccurvature, geodesictorsion, geomincurve, gg, ggg, 
gggg, gmap, grad, harmonictoanalytic, helical, infarea, inscurve, 
intrinsic, inversion, inversioncurve, inversionsurf, involute, 
involutends, J, jacobian2, kappa, kappan, kappa2, kappa2c, 
kappa2implicit, kappa2polar, kappa23d, kmu, kpi, k1, k2, 
laplace, length, lengthn, lengthnds, mcurvature, meancurvature, 
meancurvaturevf, monge, mongepolar, nateq, normal, 
normalcurvature, normalline, normalsurf, osculatingcircle, 
paramtoimp, parcurve, parsurf, pedal, pedsurf, perpsurf, 
plotintrinsic, plotintrinsic3d, plottl, plottp, polarize, 
rf, rollcurve, rt, rtoc, ruled, seashell, solvegeoeqs, stereoinj, 
stereoinjcomplex, stereoproj, stretch, surfacejacobian, 
surfacejacobianmatrix, surfacenormal, surfast, surfrev, tandev, 
tangent, tangentkmu, tangentkpi, tangentline, tangentplane, tau, 
tl, totalscalarcurvature, transsurf, tubecurve, turningangle, 
turningnumber, twist, umeqs, unitnormal, vartube, wei, 
weicurvature, weimetric, weingarten, weiprime, writhe
*)

Print["For a list of programs type csprogs."]

BeginPackage["CSPROGS`"]

    csprogs:=Print[Select[Names["CSPROGS`*"],#!="csprogs"&]]

(* Arc Length Functions *)

    arclengthprime::usage="t->arclengthprime[alpha][t] is the 
    derivative of the arc length function of the curve 
    alpha:(a,b)->R^n."

    arclength::usage="t->arclength[alpha][t] is the arc length function of
the curve alpha:(a,b)->R^n computed using Integrate."

    length::usage="length[a,b][alpha] is the length of the curve
alpha:(a,b)->R^n computed symbolically."

    lengthn::usage="lengthn[a,b][alpha] is the length of the curve
alpha:(a,b)->R^n computed using NIntegrate."

    lengthnds::usage="t->lengthnds[a,b][alpha][t] is the length of the curve
alpha:(a,b)->R^n over the interval [a,t] computed using NDSolve over
the interval [a,b]."

(* Brioschi Curvature *)

    brioschicurvature::usage="{u,v}->brioschicurvature[x][u,v] is the
Gaussian curvature of the patch x:U->R^n computed using
Brioschi's formula.  {u,v}->brioschicurvature[ee,ff,gg][u,v] is the
Gaussian curvature of the metric \n
ds^2 = ee*du^2 + 2*ff*du dv + gg*dv^2."

(* Christoffel Symbols *)

    christoffel::usage="{u,v}->christoffel[i,j,k][x][u,v] is a Christoffel
symbol of the metric tensor of the patch x:U->R^n.
{u,v}->christoffel[i,j,k][ee,ff,gg][u,v] is a Christoffel symbol
of the metric \n
ds^2 = ee*du^2 + 2*ff*du dv + gg*dv^2."

(* Complex to Real to Complex\label{ComplextoRealtoComplex *)

    ctor::usage="ctor[z] converts a complex number z to an ordered pair
of real numbers whose components are the real and imaginary parts of z;
also works for lists of complex numbers."

    rtoc::usage="rtoc[{x,y}] converts an ordered pair {x,y} of
real numbers to a complex number whose real part is x and
whose imaginary part is y; also works for lists of ordered pairs."

(* Complex Structure *)

    J::usage="J is the linear map J:R^2->R^2 defined by
that maps {p1,p2} onto {-p2,p1}."

(* Cross Product *)

    Cross::usage="Cross[v,w] is the cross product of the vectors
v={v1,v2,v3} and w={w1,w2,w3}."

(* Construction of Plane Curves from
Plane Curves  *)

    evolute::usage="t->evolute[alpha][t] is the
evolute of the plane curve alpha.  t->evolute[n,alpha][t] is the
nth evolute of the plane curve alpha."

     involute::usage="t->involute[alpha,c][t] is the involute of alpha
starting at alpha[c], that is, the curve traced by a point on a thread
attached to alpha at alpha[c] that is kept taut as it is unwound from
alpha. t->involute[alpha][t] is t->involute[alpha,0][t]."

     involutends::usage="t->involutends[a,b][alpha][t] is the involute
of alpha starting at alpha[a] computed over the interval [a,b] using NDSolve.
It is the curve traced by a point on a thread attached to alpha at
alpha[a] that is kept taut as it is unwound from alpha."

    normalline::usage="t->normalline[alpha][s,t] is the normal line of
length s emanating from a plane curve alpha at alpha[t]."

    osculatingcircle::usage="t->osculatingcircle[alpha][t] is the osculating
circle to the plane curve alpha at alpha[t]."

    tangentline::usage="t->tangentline[alpha][s,t] is the tangent line of
length s emanating from the plane curve alpha at alpha[t]."

    plottl::usage="plottl[alpha,t0,{tmin,tmax},opts] plots
the tangent line emanating from alpha at alpha[t0]."

    parcurve::usage="t->parcurve[alpha][s][t] is one component of the
curve parallel to a plane curve alpha at a distance Abs[s],
where Abs[s] is small. The other component is
t->parcurve[alpha][-s][t]."

    pedal::usage="t->pedal[{a,b},alpha][t] is the pedal curve of the
plane curve alpha with respect to the point {a,b}.  t->pedal[alpha][t]
is the pedal curve of the plane curve alpha with respect to the origin."

    rollcurve::usage="t->rollcurve[alpha,b,h,c][t] is the parametrized
curve traced out by a point P attached to a circle of radius b
rolling along a plane curve alpha.  The distance of P to the center of the
rolling circle is h, and alpha[c] is the point at which the circle starts
rolling."

(* Construction of Space Curves from
Plane Curves  *)

    curveonsurf::usage="t->curveonsurf[surf,alpha][t] is the composition
of the patch surf:U->R^3 with the curve alpha:(a,b)->U."

    helical::usage="t->helical[alpha,a][t] is the helical curve
in R^3 with slant a over the plane curve alpha.
helical[alpha][f][t] is the helical curve in R^3 with
slant function f over the plane curve alpha."

    inscurve::usage="t->inscurve[n,a,alpha][t] is the curve that results when
the value a is inserted as the nth coordinate into the parametrization of
the curve alpha."

    kappa23d::usage="t->kappa23d[alpha][t] is the space curve whose
first two components are those of the plane curve alpha, and whose
third component is the signed curvature of alpha.
t-> kappa23d[mag,alpha][t]  is the space curve whose
first two components are those of the plane curve alpha, and whose
third component is the signed curvature of alpha multiplied by mag."

    writhe::usage="t->writhe[alpha][t] is a curve in R^3 that is a
twisted generalization of the plane curve t->alpha[t]."

(* Construction of Surfaces from
Plane Curves  *)

    cone::usage="{u,v}->cone[{p1,p2,p3},gamma][u,v] is the cone
with vertex {p1,p2,p3} over the curve gamma:(a,b)->R^3."

    cylinder::usage="cylinder[{q1,q2,q3},gamma][u,v] is the cylinder
in the direction {q1,q2,q3} over the curve gamma:(a,b)->R^3."

    genhel::usage="{u,v}->genhel[alpha][sl][u,v] is the generalized helicoid
with slant  sl  generated by the plane curve alpha."

    gensurfrev::usage="{u,v}->gensurfrev[alpha,gamma][u,v] is the
generalized surface of revolution generated by the plane curves alpha
and gamma."

    ruled::usage="{u,v}->ruled[alpha,gamma][u,v] is the ruled patch 
generated by the curves alpha and gamma."

    surfast::usage="{u,v}->surfast[n,alpha][u,v] is the
astroidial patch of degree n generated by the plane curve alpha."

    surfrev::usage="{u,v}->surfrev[alpha][u,v] is the
surface of revolution generated by the plane curve alpha."

    twist::usage="{u,v}->twist[a,b,gamma][u,v] is the twisted patch 
generated by a curve gamma:(c,d)->R^2. The Moebius strip and Klein bottle
are special cases."

(* Construction of Surfaces from
Space Curves  *)

    binormalsurf::usage="{u,v}->binormalsurf[alpha][u,v] is the
surface generated by the curve alpha:(a,b)->R^3 and its
binormal vector field."

    normalsurf::usage="{u,v}->normalsurf[alpha][u,v] is the
surface generated from the curve alpha:(a,b)->R^3 and its
normal vector field."

   perpsurf::usage="{u,v}->perpsurf[phi,alpha][u,v] is a 1-parameter
family of surfaces generated by the curve alpha:(a,b)->R^3
and some normal vector field to alpha.  Special cases are
{u,v}->perpsurf[0,alpha][u,v], which is the normal surface of alpha, and
{u,v}->perpsurf[Pi/2,alpha][u,v], which is the binormal surface of alpha."

    seashell::usage="{t,theta}->seashell[gamma][r][t,theta] is the
tube of variable radius r t about the curve gamma:(a,b)->R^3."

    tandev::usage="{u,v}->tandev[alpha][u,v] is the developable surface
generated by the curve alpha:(a,b)->R^n and its tangent vector field."

    transsurf::usage="{u,v}->transsurf[alpha,gamma][u,v] is the
translation surface {u,v}->alpha[u,v] + gamma[u,v]
generated by the curve alpha,gamma:(a,b)->R^n."

    tubecurve::usage="{t,theta}->tubecurve[gamma][r][t,theta] is the
tube of radius r about the curve gamma:(a,b)->R^3."

    vartube::usage="{t,theta}->vartube[gamma][r][t,theta] is the
tube of variable radius r[t] about the curve gamma:(a,b)->R^3."

(* Construction of Surfaces from
Surfaces  *)

    parsurf::usage="{u,v}->parsurf[x][r][u,v] is the
parallel patch  at a distance r from a patch  x:U->R^3."

    pedsurf::usage="{u,v}->pedsurf[{a,b,c},x][u,v] is the pedal patch
of the patch x with respect to the point {a,b,c}.
{u,v}->pedsurf[x][u,v] is the pedal patch  of the
patch x with respect to the origin."

    stretch::usage="{u,v}->stretch[a,b,c,surf][u,v] is the
patch surf, but stretched by a,b,c."

    tangentplane::usage="{u,v}->tangentplane[x][u0,v0][u,v] is the
tangent plane to the patch  x at x[u0,v0]."

    plottp::usage="plottp[x,{u0,v0},{umin,umax},{vmin,vmax},opts]
plots a patch  x and its tangent plane at x[u0,v0]."

(* Curvature of Surfaces (Fast) *)

    gcurvature::usage="{u,v}->gcurvature[x][u,v] is the Gaussian curvature
of the patch x:U->R^3."

    mcurvature::usage="{u,v}->mcurvature[x][u,v] is the mean curvature of the
patch x:U->R^3."

(* Curvature of Surfaces (Slow) *)

    gaussiancurvature::usage="{u,v}->gaussiancurvature[x][u,v] is the
Gaussian curvature of the patch x:U->R^3."

    meancurvature::usage="{u,v}->meancurvature[x][u,v] is the
mean curvature of the patch x:U->R^3."

    meancurvaturevf::usage="{u,v}->meancurvaturevf[x][u,v] is the
mean curvature vector field of the patch x:U->R^n."

(* Curvature and Torsion of Curves *)

    geodesiccurvature::usage="geodesiccurvature[surf,alpha][t] 
calculates the geodesic curvature of the curve t->surf[alpha[t]] 
contained in the parametrized surface surf:U->R^3, where alpha
is a plane curve whose trace is contained in the subset U of R^2."

    geodesictorsion::usage="geodesictorsion[surf,alpha][t] 
calculates the geodesic torsion of the curve t->surf[alpha[t]] 
contained in the parametrized surface surf:U->R^3, where alpha
is a plane curve whose trace is contained in the subset U of R^2."

    kappa::usage="t->kappa[alpha][t] is the
unsigned curvature of the curve alpha:(a,b)->R^3."

    kappan::usage="t->kappan[alpha][t] is the
unsigned curvature of the curve alpha:(a,b)->R^n."

    kappa2::usage="t->kappa2[alpha][t] is the signed curvature of
the plane curve alpha."

    kappa2c::usage="t->kappa2c[alpha][t] is the signed curvature of the
complex plane curve alpha."

    kappa2implicit::usage="{x,y}->kappa2implicit[g][x,y] is the signed
curvature of the plane curve g[x,y]==0."

    kappa2polar::usage="t->kappa2polar[rho][t] is the signed
curvature of the plane curve whose radius function is rho."

    normalcurvature::usage="normalcurvature[surf,alpha][t] 
calculates the normal curvature of the curve t->surf[alpha[t]] 
contained in the parametrized surface surf:U->R^3, where alpha
is a plane curve whose image is contained in the subset U of R^2."

    tau::usage="t->tau[alpha][t] is the
torsion of the curve alpha:(a,b)->R^3."

    totalscalarcurvature::usage="totalscalarcurvature[a,b,alpha] is the
total curvature of the curve alpha:(a,b)->R^2."

    turningangle::usage="t->turningangle[alpha][t] is the
turning angle of the curve alpha:(a,b)->R^2."

    turningnumber::usage="turningnumber[alpha,{a,b},opts] is the
turning number of the closed curve alpha:(a,b)->R^2."

(* Euclidean Motions Acting on
Plane Curves *)

    tl::usage="t->tl[p,alpha][t] is the curve alpha:(a,b)->R^n
translated by p."

    rt::usage="t->rt[theta,alpha][t] is the curve alpha:(a,b)->R^2
rotated by theta."

    rf::usage="t->rf[p,alpha][t] is the reflection about the
horizontal axis of the curve alpha:(a,b)->R^2."

(* Focal Set Programs *)

    focalkmu::usage="{u,v}->focalkmu[x][u,v] is a parametrization of the
focal set of a principal patch x corresponding to the principal curvature kmu."

    focalkpi::usage="{u,v}->focalkpi[x][u,v] is a parametrization of the
focal set of a principal patch x corresponding to the principal curvature kpi."

    focalk1::usage="{u,v}->focalk1[x][u,v] is a parametrization of the
focal set of a patch x corresponding to the principal curvature k1."

    focalk2::usage="{u,v}->focalk2[x][u,v] is a parametrization of the
focal set of a patch x corresponding to the principal curvature k2."

    tangentkmu::usage="{u,v}->tangentkmu[x][u,v] is an eigenvector of
unit length of a principal patch x corresponding to the
principal curvature kmu."

    tangentkpi::usage="{u,v}->tangentkpi[x][u,v] is an eigenvector of
unit length of a principal patch x corresponding to the
principal curvature kpi."

(* Frenet Frame Programs *)

    binormal::usage="t->binormal[alpha][t] is the
binormal of the curve alpha:(a,b)->R^3."

    darbouxvector::usage="t->darbouxvector[gamma][t] is the Darboux vector
field of the curve gamma:(a,b)->R^3."

    frenetframe::usage="t->frenetframe[alpha][t] is the
Frenet frame of the curve alpha:(a,b)->R^3."

    normal::usage="t->normal[alpha][t] is the
normal of the curve alpha:(a,b)->R^3."

    tangent::usage="t->tangent[alpha][t] is the
tangent of the curve alpha:(a,b)->R^3."

(* Geodesics *)

     geo::usage="{u,v}->geo[x][p,q,u,v] gives the system of first order
differential equations for a patch x:U->R^n. geo[ee,ff,gg][p,q,u,v] gives
the system of first order differential equations for the geodesics of a
metric with coefficients ee,ff,gg."

    solvegeoeqs::usage="solvegeoeqs[x,a:0,{u,v},{u0:0,v0:0},tfin,div,optsnd___]
solves the geodesic equations of the patch x using NDSolve."

(* Intrinsic Curvature of Curves *)

   intrinsic::usage="intrinsic[fun,a,{c,d,theta0},optsnd,{smin,smax}] is a
curve alpha starting at {c,d} and initial turning angle theta0 such that
the  signed curvature of alpha is fun."

    plotintrinsic::usage="plotintrinsic[fun,a,{c,d,theta0},optsnd,
{smin,smax}, optspp] plots a curve alpha starting at {c,d} and initial
turning angle theta0 such that the  signed curvature of alpha is fun."

    plotintrinsic3d::usage="plotintrinsic3d[{kk,tt},{a,{p1,p2,p3},{q1,q2,q3},
{r1,r2,r3}},{smin,smax},opts] plots a unit-speed space curve alpha with
curvature kk and torsion tt such that alpha[a:0]={p1:0,p2:0,p3:0},
alpha'[a:0]={q1:1,q2:0,q3:0} and alpha''[a:0]=kk[0]*{r1:0,r2:1,r3:0}."

(* Inversion Programs *)

        inversion::usage="x->inversion[p,rho][x] is the inversion of a point
x with respect to a sphere in R^n of radius rho centered at p.
inversion[rho][x] is the inversion of a point x with respect to a
sphere in R^n of radius rho centered at the origin."

        inversioncurve::usage="t->inversioncurve[p,rho][alpha][t] is the
inversion of a curve alpha with respect to a sphere in R^n of radius rho
centered at p.  t->inversioncurve[rho][alpha][t] is the inversion of a
curve alpha with respect to a sphere in R^n of radius rho centered at
the origin."

        inversionsurf::usage="{u,v}->inversionsurf[p,rho][surf][u,v]
is the inversion of a patch  surf with respect to a sphere in R^n of
radius rho centered at p.  {u,v}->inversionsurf[rho][surf][u,v] is the
inversion of a patch surf with respect to a sphere in R^n of radius rho
centered at the origin."

(* Jacobians and Normals *)

    jacobian2::usage="{u,v}->jacobian2[x][u,v] is the square of the
determinant of the Jacobian matrix of the patch x:U->R^3."

    surfacejacobianmatrix::usage="{u,v}->surfacejacobianmatrix[x][u,v]
is the Jacobian matrix of the patch x:U->R^n."

    surfacejacobian::usage="{u,v}->surfacejacobian[x][u,v] is
the determinant of the product of the Jacobian matrix of the
patch x:U->R^n with its transpose."

    surfacenormal::usage="{u,v}->surfacenormal[x][u,v] is the
cross product of the tangent vectors xu and xv of the patch x:U->R^3."

    unitnormal::usage="{u,v}->unitnormal[x][u,v] is the
unit normal to the patch x:U->R^3. It is the Gauss map of x."

(* Metric (First Fundamental Form) *)

    ee::usage="{u,v}->ee[x][u,v] is the first coefficient of the metric
tensor (or first fundamental form) of the patch x:U->R^n.  The usual
mathematics symbol is E."

    ff::usage="{u,v}->ff[x][u,v] is the second coefficient of the metric
tensor of the patch x:U->R^n  The usual mathematics symbol is F."

    gg::usage="{u,v}->gg[x][u,v] is the third coefficient of the metric
tensor of the patch x:U->R^n.  The usual mathematics symbol is G."

    infarea::usage="{u,v}->infarea[x][u,v] is the infinitesimal area of
the metric tensor (or first fundamental form) of the patch x:U->R^n."

(* Minimal Surface Programs *)

    analytictominimal::usage="{u,v}->analytictominimal[Psi][t][u,v]
is the minimal patch  corresponding to the analytic n-tuple
z->E^(-I*t)*Psi[z]."

     geomincurve::usage="z->geomincurve[alpha][z] is the minimal curve
in C^3 that contains a plane curve alpha:(a,b)->R^3 as a geodesic."

    harmonictoanalytic::usage="z->harmonictoanalytic[x][z] is the
analytic function whose real part is the harmonic n-tuple {u,v}->x[u,v]
and whose imaginary part vanishes at {0,0}.
harmonictoanalytic[x][x0,y0][z] is the analytic function whose real part
is {u,v}->x[u,v] and whose imaginary part vanishes at {x0,y0}."

    wei::usage="z->wei[f,g][z] is the triple of meromorphic functions
constructed from meromorphic functions f and g via the Weierstrass
representation."

    weicurvature::usage="z->weicurvature[f,g][z] is the
Gaussian curvature of the Weierstrass patch determined by
meromorphic functions f and g."

    weimetric::usage="z->weimetric[f,g][z] is the scaling function of the
metric of the Weierstrass patch determined by meromorphic functions f and g."

    weiprime::usage="z->weiprime[f,g][z] is integrand of the Weierstrass
representation."

(* Principal Curvatures *)

    kmu::usage="{u,v}->kmu[x][u,v] is a principal curvature of a
patch x for which ff[x] = fff[x] = 0."

    kpi::usage="{u,v}->kpi[x][u,v] is a principal curvature of a
patch x for which ff[x] = fff[x] = 0."

    k1::usage="{u,v}->k1[x][u,v] is a principal curvature of a
patch x (k1 is greater than or equal to k2)."

    k2::usage="{u,v}->k2[x][u,v] is a principal curvature of a
patch x (k1 is greater than or equal to k2)."

(* Second Fundamental Form and
Gauss Map Programs *)

    eee::usage="{u,v}->eee[x][u,v] is the first coefficient of the
second fundamental form of the patch x:U->R^3. The usual
mathematics symbol is e."

    eeee::usage="{u,v}->eeee[x][u,v] is the first coefficient of the
second fundamental form of the patch x:U->R^3 multiplied by
the infinitesimal area.  The Gauss symbol is D."

    fff::usage="{u,v}->fff[x][u,v] is the second coefficient of the
second fundamental form of the patch x:U->R^3.  The usual
mathematics symbol is f."

    ffff::usage="{u,v}->ffff[x][u,v] is the second coefficient of the
second fundamental form of the patch x:U->R^3 multiplied by
the infinitesimal area.  The Gauss symbol is D'."

    ggg::usage="{u,v}->ggg[x][u,v] is the third coefficient of the
second fundamental form of the patch x:U->R^3.  The usual
mathematics symbol is g."

    gggg::usage="{u,v}->gggg[x][u,v] is the third coefficient of the
second fundamental form of the patch x:U->R^3 multiplied by
the infinitesimal area.  The Gauss symbol is D''."

    weingarten::usage="{u,v}->weingarten[x][u,v] is the matrix of the
shape operator of the patch x:U->R^3 with respect to xu and xv."

(* Vector Analysis Programs *)

    der::usage="der[v][ww][x,y] is the derivative of the vector field
ww on R^2 in the direction v.  der[v][ww][x,y,z] is the derivative
of the vector field ww on R^3 in the direction v."

    divergence::usage="divergence[ww][x,y] is the divergence of a
vector field ww on R^2.  divergence[ww][x,y,z] is the divergence
of the vector field ww on R^3."

    gmap::usage="gmap[g][x,y] is the Gauss map for a level curve of
a function g:R^2->R.  gmap[g][x,y,z] is the Gauss map for a level surface of
a function g:R^3->R."

    grad::usage="grad[g][x,y] is the gradient of a function g:R^2->R.
grad[g][x,y,z] is the gradient of a function g:R^3->R."

    laplace::usage="laplace[g][x,y] is the Laplacian of a function g:R^2->R.
laplace[g][x,y,z] is the Laplacian of a function g:R^3->R."

(* Miscellaneous Programs *)

    asymeq1::usage="asymeq1[x][u,v] is the differential equation
eee[x][u,v]u'[v]^2 + 2*fff[x][u,v]u'[v] + ggg[x][u,v]==0 of the
patch x:U->R^3."

    asymeq2::usage="asymeq2[x][u,v] is the differential equation
eee[x][u,v] + 2fff[x][u,v]v'[u] + ggg[x][u,v]v'[u]^2==0 of the
patch x:U->R^3."

    circle3point::usage="circle3point[{p1,q1},{p2,q2},{p3,q3}] is
the circle in the plane passing through the points
{p1,q1},{p2,q2},{p3,q3}."

    monge::usage="{u,v}->monge[h][u,v] is the parametrization
{u,v}->{u,v,h[u,v]} of the graph of h:U->R,
where U is an open subset of R^2."

    mongepolar::usage="{r,theta}->mongepolar[g][r,theta] is the parametrization
{r,theta}->{r*Cos[theta],r*Sin[theta],g[r,theta]} of the graph of g:U->R,
where U is an open subset of R^2."

    nateq::usage="nateq[alpha][k2,s] sometimes can be used to
find the natural equations of a plane curve alpha."

    paramtoimp::usage="paramtoimp[alpha,{x,y}] attempts to convert the
parametric form of a curve alpha to the implicit form.  The result is a
number of equations, one of which is the implicit form of the curve.  The
command will usually not succeed if the components of alpha are not rational
functions."

    polarize::usage="{r,theta}->polarize[func][r,theta] is the composition
of the maps {u,v}->func[u,v] and {r,theta}->{r*Cos[theta],r*Sin[theta]},
where {u,v}->func[u,v] is an n-tuple of functions."

    stereoinj::usage="p->stereoinj[a][p] is the stereographic
injection from R^n to a sphere of radius a centered at the origin
in R^(n+1)."

    stereoinjcomplex::usage="z->stereoinjcomplex[g][z] is the composition
stereographic of stereoinj:C->S^2(1) with a function g:C->C."

    stereoproj::usage="q->stereoproj[a][q] is the stereographic
projection from the sphere of radius a centered at the origin in
R^(n+1) to R^n."

    umeqs::usage="umeqs[k][x][u,v] attempts to find the umbilic points of
the patch x:U->R^3."

Begin["`Private`"]
(* Arc Length Functions *)

    arclengthprime[alpha_][t_]:=
        Sqrt[Simplify[D[alpha[tt],tt].
                D[alpha[tt],tt]]] /. tt->t

    arclength[alpha_][t_]:=
        Integrate[arclengthprime[alpha][tt],tt]  /. tt->t

    length[a_,b_][alpha_]:=
        Integrate[arclengthprime[alpha][u],{u,a,b}]

    lengthn[a_,b_][alpha_]:= NIntegrate[Evaluate[
          arclengthprime[alpha][u]],{u,a,b}]

    lengthnds[a_,b_][alpha_][t_]:=
        Module[{aaa,bbb,s,tt},
            aaa = NDSolve[{s'[tt]==
                arclengthprime[alpha][tt],
                s[a]==0},s,{tt,a,b}];
            bbb = s[tt] /. aaa;
            bbb /. tt->t][[1]]

(* Brioschi Curvature *)
             
    brioschicurvature[x_][u_,v_]:=
        (Det[{{-D[ee[x][uu,vv],{vv,2}]/2 + 
             D[ff[x][uu,vv],uu,vv] -
             D[gg[x][uu,vv],{uu,2}]/2,
             D[ee[x][uu,vv],uu]/2,
             D[ff[x][uu,vv],uu] -
             D[ee[x][uu,vv],vv]/2},
           {D[ff[x][uu,vv],vv] -
            D[gg[x][uu,vv],uu]/2,
            ee[x][uu,vv],ff[x][uu,vv]},
          {D[gg[x][uu,vv],vv]/2,
          ff[x][uu,vv],gg[x][uu,vv]}}]
       -Det[{{0,D[ee[x][uu,vv],vv]/2,
             D[gg[x][uu,vv],uu]/2},
          {D[ee[x][uu,vv],vv]/2,
             ee[x][uu,vv],ff[x][uu,vv]},
          {D[gg[x][uu,vv],uu]/2,
             ff[x][uu,vv],gg[x][uu,vv]}}])/
       (ee[x][uu,vv]*gg[x][uu,vv] - ff[x][uu,vv]^2)^2 /.
                  {uu->u,vv->v}

    brioschicurvature[ee_,ff_,gg_][u_,v_]:=
        (Det[{{-D[ee[uu,vv],{vv,2}]/2 + D[ff[uu,vv],uu,vv] -
             D[gg[uu,vv],{uu,2}]/2,
             D[ee[uu,vv],uu]/2,
             D[ff[uu,vv],uu] - D[ee[uu,vv],vv]/2},
        {D[ff[uu,vv],vv] - D[gg[uu,vv],uu]/2,ee[uu,vv],ff[uu,vv]},
        {D[gg[uu,vv],vv]/2,ff[uu,vv],gg[uu,vv]}}] -
         Det[{{0,D[ee[uu,vv],vv]/2,D[gg[uu,vv],uu]/2},
            {D[ee[uu,vv],vv]/2,ee[uu,vv],ff[uu,vv]},
            {D[gg[uu,vv],uu]/2,ff[uu,vv],gg[uu,vv]}}])/
        (ee[uu,vv]*gg[uu,vv] - ff[uu,vv]^2)^2   /. {uu->u,vv->v}

(* Christoffel Symbols *)

     christoffel[1,1,1][x_][u_,v_]:=
        Simplify[(D[ee[x][uu,vv],vv]*ff[x][uu,vv] -
        2*ff[x][uu,vv]*D[ff[x][uu,vv],uu] +
        D[ee[x][uu,vv],uu]*gg[x][uu,vv])/
       (2*(ee[x][uu,vv]*gg[x][uu,vv] -
        ff[x][uu,vv]^2))] /. {uu->u,vv->v}

     christoffel[2,1,1][x_][u_,v_]:=
        Simplify[-(D[ee[x][uu,vv],vv]*ee[x][uu,vv] -
        2*ee[x][uu,vv]*D[ff[x][uu,vv],uu] +
        D[ee[x][uu,vv],uu]*ff[x][uu,vv])/
       (2*(ee[x][uu,vv]*gg[x][uu,vv] -
        ff[x][uu,vv]^2))] /. {uu->u,vv->v}
                        
    christoffel[1,1,2][x_][u_,v_]:=
        Simplify[(D[ee[x][uu,vv],vv]*gg[x][uu,vv] -
        ff[x][uu,vv]*D[gg[x][uu,vv],uu])/
        (2*(ee[x][uu,vv]*gg[x][uu,vv] -
        ff[x][uu,vv]^2))] /. {uu->u,vv->v}

    christoffel[1,2,1][x_][u_,v_]:=
        christoffel[1,1,2][x][u,v]
                        
    christoffel[2,1,2][x_][u_,v_]:=
        Simplify[-(D[ee[x][uu,vv],vv]*ff[x][uu,vv] -
         ee[x][uu,vv]*D[gg[x][uu,vv],uu])/
        (2*(ee[x][uu,vv]*gg[x][uu,vv] -
        ff[x][uu,vv]^2))] /. {uu->u,vv->v}

    christoffel[2,2,1][x_][u_,v_]:=
         christoffel[2,1,2][x][u,v]
                        
    christoffel[1,2,2][x_][u_,v_]:=
        Simplify[(-D[gg[x][uu,vv],vv]*ff[x][uu,vv] +
        2*gg[x][uu,vv]*D[ff[x][uu,vv],vv] -
        D[gg[x][uu,vv],uu]*gg[x][uu,vv])/
        (2*(ee[x][uu,vv]*gg[x][uu,vv] -
        ff[x][uu,vv]^2))] /. {uu->u,vv->v}

    christoffel[2,2,2][x_][u_,v_]:=
        Simplify[(D[gg[x][uu,vv],vv]*ee[x][uu,vv] -
        2*ff[x][uu,vv]*D[ff[x][uu,vv],vv] +
        D[gg[x][uu,vv],uu]*ff[x][uu,vv])/
        (2*(ee[x][uu,vv]*gg[x][uu,vv] -
         ff[x][uu,vv]^2))] /. {uu->u,vv->v}

    christoffel[1,1,1][ee_,ff_,gg_][u_,v_]:=
         Simplify[(D[ee[u,v],v]*ff[u,v] -
         2*ff[u,v]*D[ff[u,v],u] +
         D[ee[u,v],u]*gg[u,v])/
        (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

    christoffel[2,1,1][ee_,ff_,gg_][u_,v_]:=
         Simplify[-(D[ee[u,v],v]*ee[u,v] -
         2ee[u,v]*D[ff[u,v],u] +
         D[ee[u,v],u]*ff[u,v])/
        (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

    christoffel[1,1,2][ee_,ff_,gg_][u_,v_]:=
         Simplify[(D[ee[u,v],v]*gg[u,v] -
         ff[u,v]*D[gg[u,v],u])/
         (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

    christoffel[1,2,1][ee_,ff_,gg_][u_,v_]:=
         christoffel[1,1,2][ee,ff,gg][u,v]

    christoffel[2,1,2][ee_,ff_,gg_][u_,v_]:=
         Simplify[-(D[ee[u,v],v]*ff[u,v] -
          ee[u,v]*D[gg[u,v],u])/
         (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

    christoffel[2,2,1][ee_,ff_,gg_][u_,v_]:=
          christoffel[2,1,2][ee,ff,gg][u,v]

    christoffel[1,2,2][ee_,ff_,gg_][u_,v_]:=
         Simplify[(-D[gg[u,v],v]*ff[u,v] +
         2*gg[u,v]*D[ff[u,v],v] -
         D[gg[u,v],u]*gg[u,v])/
         (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

     christoffel[2,2,2][ee_,ff_,gg_][u_,v_]:=
         Simplify[(D[gg[u,v],v]*ee[u,v] -
         2*ff[u,v]*D[ff[u,v],v] +
         D[gg[u,v],u]*ff[u,v])/
         (2*(ee[u,v]*gg[u,v] - ff[u,v]^2))]

(* Complex to Real to Complex\label{ComplextoRealtoComplex *)

    ctor[z_]:= ComplexExpand[{Re[z],Im[z]},{z}]

    rtoc[{x_,y_}]:= x + I*y

(* Complex Structure *)

    J[{p1_,p2_}]:= {-p2,p1}

(* Cross Product *)

    Cross[v_List,w_List]:=
        RotateLeft[v*RotateLeft[w] -
        RotateLeft[v]*w] /;
        Length[v] == Length[w] == 3

(* Construction of Plane Curves from
Plane Curves  *)
                
    evolute[alpha_][t_]:= alpha[tt] +
        D[alpha[tt],tt].D[alpha[tt],tt]/
       (D[alpha[tt],{tt,2}].
        J[D[alpha[tt],tt]])*J[D[alpha[tt],tt]] /. {tt->t}

    evolute[1,alpha_][t_]:= Simplify[alpha[tt] +
        D[alpha[tt],tt].D[alpha[tt],tt]/
        (D[alpha[tt],{tt,2}].J[D[alpha[tt],tt]])*
         J[D[alpha[tt],tt]] /. {tt->t}]

    evolute[n_,alpha_][t_]:= evolute[n,alpha][t] =
        evolute[1,evolute[n - 1,alpha]][t]//Simplify

    involute[alpha_,c_][t_]:=alpha[tt] +
        (arclength[alpha][c] -
         arclength[alpha][tt])*D[alpha[tt],tt]/
         Sqrt[Factor[D[alpha[tt],tt].
         D[alpha[tt],tt]]] /. tt->t         

    involute[alpha_][t_]:= involute[alpha,0][t]

    involutends[a_,b_][alpha_][t_]:=
        Module[{aaa,bbb,s,tt},
            aaa = NDSolve[{s'[tt]==
                arclengthprime[alpha][tt],
                s[a]==0},s,{tt,a,b}];
            bbb = alpha[tt] +
                (s[a] - s[tt])*D[alpha[tt],tt]/
                 Sqrt[D[alpha[tt],tt].
                 D[alpha[tt],tt]]  /.aaa;
            bbb /. tt->t]
                
    normalline[alpha_][s_,t_]:=
        Line[{alpha[tt],alpha[tt] + s*J[D[alpha[tt],tt]]/
        (D[alpha[tt],tt].D[alpha[tt],tt])^(1/2)}] /. tt->t
                
    osculatingcircle[alpha_][t_]:=
        Circle[alpha[tt] + D[alpha[tt],tt].D[alpha[tt],tt]/
        (D[alpha[tt],{tt,2}].
        J[D[alpha[tt],tt]])*J[D[alpha[tt],tt]],
        Abs[(D[alpha[tt],tt].D[alpha[tt],tt])^(3/2)/
        (D[alpha[tt],{tt,2}].J[D[alpha[tt],
                tt]])]] /. tt->t

    tangentline[alpha_][s_,t_]:= Line[{alpha[tt],alpha[tt] +
          s*D[alpha[tt],tt]/Sqrt[Factor[D[alpha[tt],tt].
                  D[alpha[tt],tt]]]}] /. tt->t

    plottl[curve_,t0_,{tmin_,tmax_},opts___]:=
          ParametricPlot[curve[t0 + t]//Evaluate,{t,tmin,tmax},
          Epilog->{tangentline[curve][t0][tmax]//Evaluate},
          AspectRatio->Automatic,opts];
                
    parcurve[alpha_][s_][t_]:= alpha[tt] +
          s*J[D[alpha[tt],tt]]/Sqrt[Simplify[
              D[alpha[tt],tt].D[alpha[tt],tt]]] /. tt->t
                
    pedal[{a_,b_},alpha_][t_]:= {a,b} +
        ((alpha[tt] - {a,b}).J[D[alpha[tt],tt]]/
        (D[alpha[tt],tt].D[alpha[tt],tt]))*J[
         D[alpha[tt],tt]] /. {tt->t}

    pedal[alpha_][t_]:= pedal[{0,0},alpha][t]

    rollcurve[alpha_,b_,h_,c_][t_]:= (alpha[tt] - 
        h*Sin[(arclength[alpha][tt]-arclength[alpha][c])/b]*
        D[alpha[tt],tt]/Sqrt[Factor[D[alpha[tt],tt].
        D[alpha[tt],tt]]] +
        (b - h*Cos[(arclength[alpha][tt]-arclength[alpha][c])/b])*
        J[D[alpha[tt],tt]]/Sqrt[Factor[D[alpha[tt],tt].
        D[alpha[tt],tt]]]) /. tt->t

(* Construction of Space Curves from
Plane Curves  *)

     curveonsurf[surf_,alpha_][t_]:=
             surf[alpha[t][[1]],alpha[t][[2]]]

     helical[alpha_,c_][t_]:=
        {alpha[t][[1]],alpha[t][[2]],c t}

     helical[alpha_][f_][t_]:=
              {alpha[t][[1]],alpha[t][[2]],f[t]}

     inscurve[n_,a_,alpha_][t_]:= Insert[alpha[t],a,n]
              
     kappa23d[alpha_][t_]:= Append[alpha[t],kappa2[alpha][t]]

     kappa23d[mag_,alpha_][t_]:=
           Append[alpha[t],mag*kappa2[alpha][t]]

     writhe[alpha_][t_]:= {alpha[t][[1]],
            Cos[t]*alpha[t][[2]],Sin[t]*alpha[t][[2]]}

(* Construction of Surfaces from
Plane Curves  *)

    cone[{p1_,p2_,p3_},gamma_][u_,v_]:=
        {p1,p2,p3} + v*gamma[u]

    cylinder[{q1_,q2_,q3_},gamma_][u_,v_]:=
        gamma[u] + {v*q1,v*q2,v*q3}

    genhel[alpha_][sl_][u_,v_]:= {Cos[u]*alpha[v][[1]],
                                  Sin[u]*alpha[v][[1]],
                                  sl*u + alpha[v][[2]]}
     
    gensurfrev[alpha_,gamma_][u_,v_]:= {alpha[u][[1]]*gamma[v][[1]],
                   alpha[u][[2]]*gamma[v][[1]],gamma[v][[2]]}

    ruled[alpha_,gamma_][u_,v_]:= alpha[u] + v*gamma[u]

    surfast[n_,alpha_][u_,v_]:= {Cos[u]^n*alpha[v][[1]],
                                 Sin[u]^n*alpha[v][[1]],
                                          alpha[v][[2]]}
 
    surfrev[alpha_][u_,v_]:= {Cos[u]*alpha[v][[1]],
                  Sin[u]*alpha[v][[1]],alpha[v][[2]]}
 
    twist[a_,b_,gamma_][u_,v_]:=
        (a + Cos[b*u]*gamma[v][[1]] - Sin[b*u]*gamma[v][[2]])*
        {Cos[u],Sin[u],0} +
        (Sin[b*u]*gamma[v][[1]] + Cos[b*u]*gamma[v][[2]])*
        {0,0,1}

(* Construction of Surfaces from
Space Curves  *)

    binormalsurf[alpha_][u_,v_]:=
        alpha[u] + v*binormal[alpha][u]
         
    normalsurf[alpha_][u_,v_]:=
        alpha[u] + v*normal[alpha][u]

    perpsurf[phi_,alpha_][u_, v_]:= 
        alpha[u] + v*(Cos[phi]*normal[alpha][u] +
                Sin[phi]*binormal[alpha][u])

    seashell[gamma_][r_][t_,theta_]:= gamma[t] + 
        r*t*(-Cos[theta]*normal[gamma][t] +
          Sin[theta]*binormal[gamma][t])

    tandev[alpha_][u_,v_]:= alpha[uu] + v*D[alpha[uu],uu]/
          Sqrt[D[alpha[uu],uu].D[alpha[uu],uu]] /. uu->u

    transsurf[alpha_,gamma_][u_,v_]:= alpha[u] + gamma[v]
               
    tubecurve[gamma_][r_][t_,theta_]:= Simplify[gamma[t] + 
        r*(-Cos[theta]*normal[gamma][t] +
          Sin[theta]*binormal[gamma][t])]

    vartube[gamma_][r_][t_,theta_]:= Simplify[gamma[t] + 
        r[t]*(-Cos[theta]*normal[gamma][t] +
             Sin[theta]*binormal[gamma][t])]

(* Construction of Surfaces from
Surfaces  *)
                
    parsurf[x_][r_][u_,v_]:= Module[{xu,xv,n1,n2,n3,n4},
        xu = D[x[uu,vv],uu];
        xv = D[x[uu,vv],vv];
        n1 = Cross[xu,xv]//Simplify;
        n2 = Simplify[Factor[n1.n1]];
        n3 = PowerExpand[n2^(1/2)]//Simplify;
        n4 = Simplify[n1/n3];
        Simplify[Together[x[uu,vv] +
                r*n4]]] /. {uu->u,vv->v}
                
    pedsurf[{a_,b_,c_},x_][u_,v_]:=
         Module[{xu,xv,n1,s2,s3,n4},
         xu = D[x[uu,vv],uu];
         xv = D[x[uu,vv],vv];
         n1 = Cross[xu, xv]//Simplify;
         s2 = Simplify[Factor[n1.n1]];
         s3 = PowerExpand[s2^(1/2)]//Simplify;
         n4 = Simplify[n1/s3];
         {a,b,c} + Simplify[Together[((x[uu,vv] -
         {a,b,c}).n4)*n4]]] /. {uu->u,vv->v}
           
     pedsurf[x_][u_,v_]:= Module[{xu,xv,n1,s2,s3,n4},
        xu = D[x[uu,vv],uu];
        xv = D[x[uu,vv],vv];
        n1 = Cross[xu, xv]//Simplify;
        s2 = Simplify[Factor[n1.n1]];
        s3 = PowerExpand[s2^(1/2)]//Simplify;
        n4 = Simplify[n1/s3];
        Simplify[Together[(x[uu,vv].n4)*n4]]]  /.
             {uu->u,vv->v}

    stretch[a_,b_,c_,surf_][u_,v_]:=
           {a*surf[u,v][[1]],b*surf[u,v][[2]],c*surf[u,v][[3]]}
    
    tangentplane[x_][u0_,v0_][u_,v_]:= x[u0,v0] +
          D[x[uu0,vv0],uu0]*u + D[x[uu0,vv0],vv0]*v /.
          {uu0->u0,vv0->v0}

    plottp[surf_,{u0_,v0_},{umin_,umax_},
          {vmin_,vmax_},opts___]:=
          ParametricPlot3D[{surf[u0 + u,v0 + v],
             tangentplane[surf][u0,v0][u,v]}//Evaluate,
             {u,umin,umax},{v,vmin,vmax},
             Boxed->False,Axes->None,opts];

 (* Curvature of Surfaces (Fast) *)

     gcurvature[x_][u_,v_]:= Simplify[
       (Det[{D[x[uu,vv],uu,uu],D[x[uu,vv],uu],
             D[x[uu,vv],vv]}]*
        Det[{D[x[uu,vv],vv,vv],D[x[uu,vv],uu],
             D[x[uu,vv],vv]}] -
        Det[{D[x[uu,vv],uu,vv],D[x[uu,vv],uu],
             D[x[uu,vv],vv]}]^2)/
       (D[x[uu,vv],uu].D[x[uu,vv],uu]*
             D[x[uu,vv],vv].D[x[uu,vv],vv] -
        D[x[uu,vv],uu].
             D[x[uu,vv],vv]^2)^2] /. {uu->u,vv->v}
 
     mcurvature[x_][u_,v_]:= Simplify[
       (Det[{D[x[uu,vv],uu,uu],D[x[uu,vv],uu],
            D[x[uu,vv],vv]}]*
            D[x[uu,vv],vv].D[x[uu,vv],vv] -
       2*Det[{D[x[uu,vv],uu,vv],D[x[uu,vv],uu],
            D[x[uu,vv],vv]}]*
            D[x[uu,vv],uu].D[x[uu,vv],vv] +
        Det[{D[x[uu,vv],vv,vv],D[x[uu,vv],uu],
            D[x[uu,vv],vv]}]*
            D[x[uu,vv],uu].D[x[uu,vv],uu])/
      (2*(D[x[uu,vv],uu].D[x[uu,vv],uu]*
            D[x[uu,vv],vv].D[x[uu,vv],vv] -
            D[x[uu,vv],uu].
            D[x[uu,vv],vv]^2)^(3/2))] /. {uu->u,vv->v}

(* Curvature of Surfaces (Slow) *)

     gaussiancurvature[x_][u_,v_]:= Simplify[
        (eee[x][uu,vv]*ggg[x][uu,vv] - fff[x][uu,vv]^2)/
        (ee[x][uu,vv]*gg[x][uu,vv] -
                ff[x][uu,vv]^2)] /. {uu->u,vv->v}

     meancurvature[x_][u_,v_]:= Simplify[
        (eee[x][uu,vv]*gg[x][uu,vv] -
                2*fff[x][uu,vv]*ff[x][uu,vv] +
         ggg[x][uu,vv]*ee[x][uu,vv])/
        (2*(ee[x][uu,vv]*gg[x][uu,vv] -
                ff[x][uu,vv]^2))] /. {uu->u,vv->v}

    meancurvaturevf[x_][u_,v_]:= 
        Module[{h,h1,h2,h3,h4},
        h=gg[x][uu,vv]*D[x[uu,vv],uu,uu] -
           ff[x][uu,vv]*D[x[uu,vv],uu,vv] +
           ee[x][uu,vv]*D[x[uu,vv],vv,vv];
        h1 = (h.D[x[uu,vv],uu])*D[x[uu,vv],uu];
        h2 = (h.D[x[uu,vv],vv])*D[x[uu,vv],vv];
        h3 = h - h1 - h2;
        h4 = 2*(ee[x][uu,vv]*gg[x][uu,vv] -
                ff[x][uu,vv]^2);
         Simplify[h3/h4] /. {uu->u,vv->v}]

(* Curvature and Torsion of Curves *)

    geodesiccurvature[surf_,alpha_][t_]:=
        Module[{unc,tmp,crv1,crv2},
        unc=unitnormal[surf][alpha[tt][[1]],alpha[tt][[2]]];
        tmp=surf[alpha[tt][[1]],alpha[tt][[2]]];
        crv1=D[tmp,tt];crv2=D[tmp,{tt,2}];
        Simplify[PowerExpand[Det[
        {crv2,unc,crv1}]/(crv1.crv1)^(3/2) /. tt->t]]]

    geodesictorsion[surf_,alpha_][t_]:=
        Module[{unc,tmp,crv1,unc1},
        unc=unitnormal[surf][alpha[tt][[1]],alpha[tt][[2]]];
        tmp=surf[alpha[tt][[1]],alpha[tt][[2]]];
        crv1=D[tmp,tt];unc1=D[unc,tt];
        Simplify[PowerExpand[Det[
        {unc,unc1,crv1}]/(crv1.crv1)^(3/2) /. tt->t]]]

    kappa[alpha_][t_]:=
        Simplify[Factor[Cross[D[alpha[tt],tt],
        D[alpha[tt],{tt,2}]].
        Cross[D[alpha[tt],tt],D[alpha[tt],{tt,2}]]]]^(1/2)/
        Simplify[Factor[D[alpha[tt],tt].
        D[alpha[tt],tt]]]^(3/2) /. tt->t

    kappan[alpha_][t_]:=
        Simplify[Sqrt[Factor[
        (Sqrt[Factor[D[alpha[tt],tt].
                     D[alpha[tt],tt]]]*D[alpha[tt],{tt,2}] -
        D[Sqrt[Factor[D[alpha[tt],tt].
                     D[alpha[tt],tt]]],tt]*D[alpha[tt],tt]).
        (Sqrt[Factor[D[alpha[tt],tt].
                     D[alpha[tt],tt]]]*D[alpha[tt],{tt,2}] -
        D[Sqrt[Factor[D[alpha[tt],tt].
                     D[alpha[tt],tt]]],tt]*
        D[alpha[tt],tt])]]]/
        Simplify[Factor[D[alpha[tt],tt].
                     D[alpha[tt],tt]]]^(3/2) /. tt->t
    kappa2[alpha_][t_]:=
        D[alpha[tt],{tt,2}].J[D[alpha[tt],tt]]/
         Simplify[D[alpha[tt],tt].
              D[alpha[tt],tt]]^(3/2) /. tt->t

    kappa2c[alpha_][t_]:= Simplify[
        ComplexExpand[Re[D[alpha[t],{t,2}]*
        Conjugate[I*D[alpha[t],t]]]]/
        ComplexExpand[Abs[D[alpha[t],t]],
        TargetFunctions->{Re,Im}]^3]

    kappa2implicit[g_][x_,y_]:=
        (D[g[xx,yy],{xx,2}]*D[g[xx,yy],yy]^2 -
         2D[g[xx,yy],xx,yy]*D[g[xx,yy],xx]*D[g[xx,yy],yy] +
         D[g[xx,yy],{yy,2}]*D[g[xx,yy],xx]^2)/
        (D[g[xx,yy],xx]^2 + D[g[xx,yy],yy]^2)^(3/2) /. 
                         {xx->x,yy->y}

    kappa2polar[rho_][t_]:= (-D[rho[tt],{tt,2}]*rho[tt]
          + 2*D[rho[tt],tt]^2 + rho[tt]^2)/
         (D[rho[tt],tt]^2 + rho[tt]^2)^(3/2) /. tt->t

    normalcurvature[surf_,alpha_][t_]:=
        Module[{unc,tmp,crv1,crv2},
        unc=unitnormal[surf][alpha[tt][[1]],alpha[tt][[2]]];
        tmp=surf[alpha[tt][[1]],alpha[tt][[2]]];
        crv1=D[tmp,tt];crv2=D[tmp,{tt,2}];
        Simplify[PowerExpand[(crv2.unc)/(crv1.crv1) /. tt->t]]]

    tau[alpha_][t_]:= Simplify[Det[
        {D[alpha[tt],tt],D[alpha[tt],{tt,2}],
        D[alpha[tt],{tt,3}]}]]/
        Simplify[Factor[Cross[D[alpha[tt],tt],
        D[alpha[tt],{tt,2}]].Cross[D[alpha[tt],tt],
        D[alpha[tt],{tt,2}]]]] /. tt->t
              
    totalscalarcurvature[a_,b_,alpha_]:=
        Integrate[(kappa2[alpha][t]*
        Sqrt[Simplify[D[alpha[t],u].
        D[alpha[t],u]]])//PowerExpand,{u,a,b}]

    turningangle[alpha_][t_]:= ArcTan[D[alpha[tt],tt][[1]],
               D[alpha[tt],tt][[2]]] /. tt->t
                
    turningnumber[alpha_,{a_,b_},opts___]:=
        Module[{tt,tmp1,tmp2},
            tmp1 = kappa2[alpha][tt]*Sqrt[alpha'[tt].
                alpha'[tt]];
            tmp2 = NIntegrate[Evaluate[tmp1],{tt,a,b},
                AccuracyGoal->2,opts];
            Round[tmp2/N[2Pi]]]

(* Euclidean Motions Acting on
Plane Curves *)

    tl[p_,alpha_][t_]:= p + alpha[t]

    rt[theta_,alpha_][t_]:=
       {Cos[theta]*alpha[t][[1]] - Sin[theta]*alpha[t][[2]],
        Sin[theta]*alpha[t][[1]] + Cos[theta]*alpha[t][[2]]}

    rf[alpha_][t_]:= {alpha[t][[1]],-alpha[t][[2]]}

(* Focal Set Programs *)

    focalkmu[surf_][u_,v_]:= (surf[uu,vv] +
        (1/kmu[surf][uu,vv])*
        unitnormal[surf][uu,vv] /. {uu->u,vv->v})

    focalkpi[surf_][u_,v_]:= (surf[uu,vv] +
        (1/kpi[surf][uu,vv])*
        unitnormal[surf][uu,vv] /. {uu->u,vv->v}) 

    focalk1[surf_][u_,v_]:= surf[uu,vv] +
        (1/k1[surf][uu,vv])*
        unitnormal[surf][uu,vv] /. {uu->u,vv->v}

    focalk2[surf_][u_,v_]:= surf[uu,vv] +
        (1/k2[surf][uu,vv])*
        unitnormal[surf][uu,vv] /. {uu->u,vv->v}

    tangentkmu[x_][u_,v_]:= (D[x[u,vv],vv]/
                Sqrt[gg[x][u,vv]] /. vv->v) /;
                   ff[x][u,v]==fff[x][u,v]==0

    tangentkpi[x_][u_,v_]:= (D[x[uu,v],uu]/
                Sqrt[gg[x][uu,v]] /. uu->u) /;
                   ff[x][u,v]==fff[x][u,v]==0
                
(* Frenet Frame Programs *)

    binormal[alpha_][t_]:= Simplify[Cross[
        D[alpha[tt],tt],D[alpha[tt],{tt,2}]]]/
        Simplify[Factor[Cross[D[alpha[tt],tt],
        D[alpha[tt],{tt,2}]].
        Cross[D[alpha[tt],tt],D[alpha[tt],
        {tt,2}]]]]^(1/2)  /. tt->t
 
    darbouxvector[alpha_][t_]:=
         Sqrt[D[alpha[tt],tt].D[alpha[tt],tt]]*(
                tau[alpha][tt]*tangent[alpha][tt] +
                kappa[alpha][tt]*binormal[alpha][tt]) /. tt->t

    frenetframe[alpha_][t_]:=
        {Line[{alpha[t],alpha[t] + tangent[alpha][t]}],
         Line[{alpha[t],alpha[t] + normal[alpha][t]}],
         Line[{alpha[t],alpha[t] + binormal[alpha][t]}]}

    normal[alpha_][t_]:= Cross[binormal[alpha][t],
                           tangent[alpha][t]]

    tangent[alpha_][t_]:= D[alpha[tt],tt]/
        Simplify[Factor[D[alpha[tt],tt].
          D[alpha[tt],tt]]]^(1/2)  /. tt->t

(* Geodesics *)

    geo[x_][p_,q_,u_,v_]:=
        {p,q,-christoffel[1,1,1][x][u,v]*p^2 -
        2*christoffel[1,1,2][x][u,v]*p*q -
         christoffel[1,2,2][x][u,v]*q^2,
        -christoffel[2,1,1][x][u,v]*p^2 -
        2*christoffel[2,1,2][x][u,v]*p*q -
         christoffel[2,2,2][x][u,v]*q^2}
   
     geo[ee_,ff_,gg_][p_,q_,u_,v_]:=
         {p,q,-christoffel[1,1,1][ee,ff,gg][u,v]*p^2 -
         2*christoffel[1,1,2][ee,ff,gg][u,v]*p*q -
          christoffel[1,2,2][ee,ff,gg][u,v]*q^2,
         -christoffel[2,1,1][ee,ff,gg][u,v]*p^2 -
         2*christoffel[2,1,2][ee,ff,gg][u,v]*p*q -
          christoffel[2,2,2][ee,ff,gg][u,v]*q^2}

    solvegeoeqs[x_,a_:0,{u_,v_},{u0_:0,v0_:0},tfin_,div_,optsnd___]:=
        Flatten[Map[NDSolve[#,{u,v},{ss,0,tfin}]&,
        Table[Join[MapThread[Equal,
        {{u''[ss],v''[ss]},
        Take[geo[x][u'[ss],v'[ss],u[ss],v[ss]],{3,4}]}],
        {u[a]==u0,v[a]==v0,
        u'[a]==Cos[theta],v'[a]==Sin[theta]}],
        {theta,2Pi/div,2Pi,2Pi/div}]],1]

(* Intrinsic Curvature of Curves *)

     intrinsic[fun_,a_:0,{c_:0,d_:0,theta0_:0},optsnd___,
        {smin_:-10,smax_:10}][t_]:=
        Flatten[Module[{x,y,theta},
        {x[t],y[t]} /.
        NDSolve[{x'[ss]==Cos[theta[ss]],
             y'[ss]==Sin[theta[ss]],
             theta'[ss]==fun[ss],
             x[a]==c,y[a]==d,theta[a]==theta0},
             {x,y,theta},{ss,smin,smax},optsnd]]]

     plotintrinsic[fun_,a_:0,{c_:0,d_:0,theta0_:0},optsnd___,
                  {smin_:-10,smax_:10},optspp___]:=
          ParametricPlot[Module[{x,y,theta},
          {x[t],y[t]} /.
          NDSolve[{x'[ss]==Cos[theta[ss]],
             y'[ss]==Sin[theta[ss]],
             theta'[ss]==fun[ss],
             x[a]==c,y[a]==d,theta[a]==theta0},
             {x,y,theta},{ss,smin,smax},optsnd]]//Evaluate,
          {t,smin,smax},AspectRatio->Automatic,optspp];

    plotintrinsic[fun_,optsnd___,
       {smin_:-10,smax_:10},optspp___]:=
       plotintrinsic[fun,0,{0,0,0},{smin,smax},optspp]

    plotintrinsic3d[{kk_,tt_},{a_:0,{p1_:0,p2_:0,p3_:0},
           {q1_:1,q2_:0,q3_:0},{r1_:0,r2_:1,r3_:0}},
                  {smin_:-10,smax_:10},opts___]:=
        ParametricPlot3D[Module[
           {x1,x2,x3,t1,t2,t3,n1,n2,n3,b1,b2,b3},
          {x1[s],x2[s],x3[s]} /.
          NDSolve[{x1'[ss]==t1[ss],
                 x2'[ss]==t2[ss],
                 x3'[ss]==t3[ss],
             t1'[ss]==kk[ss]*n1[ss],
             t2'[ss]==kk[ss]*n2[ss],
             t3'[ss]==kk[ss]*n3[ss],
                 n1'[ss]==-kk[ss]*t1[ss] + tt[ss]*b1[ss],
                 n2'[ss]==-kk[ss]*t2[ss] + tt[ss]*b2[ss],
                 n3'[ss]==-kk[ss]*t3[ss] + tt[ss]*b3[ss],
                     b1'[ss]==-tt[ss]*n1[ss],
                     b2'[ss]==-tt[ss]*n2[ss],
                     b3'[ss]==-tt[ss]*n3[ss],
             x1[a]==p1,x2[a]==p2,x3[a]==p3,
             t1[a]==q1,t2[a]==q2,t3[a]==q3,
             n1[a]==r1,n2[a]==r2,n3[a]==r3,
                 b1[a]==q2*r3 - q3*r2,
                 b2[a]==q3*r1 - q1*r3,
                 b3[a]==q1*r2 - q2*r1},
           {x1,x2,x3,t1,t2,t3,n1,n2,n3,b1,b2,b3},
             {ss,smin,smax}]]//Evaluate,
             {s,smin,smax},opts];

(* Inversion Programs *)
 
    inversion[p_,rho_][x_]:= p + (rho^2/((x - p).(x - p)))*(x - p)

    inversion[rho_][x_]:= (rho^2/x.x)*x

    inversioncurve[p_List,rho_][curve_][t_]:=
                               inversion[p,rho][curve[t]]

    inversioncurve[rho_][curve_][t_]:=
                        inversion[rho][curve[t]]

    inversionsurf[p_List,rho_][surf_][u_,v_]:=
                        inversion[p,rho][surf[u,v]]

    inversionsurf[rho_][surf_][u_,v_]:=
                        inversion[rho][surf[u,v]]

(* Jacobians and Normals*)

   jacobian2[x_][u_,v_]:= Module[{xu,xv,N1},
        xu = D[x[uu,vv],uu];
        xv = D[x[uu,vv],vv];
        N1 = Cross[xu,xv];
        Simplify[N1.N1]] /. {uu->u,vv->v}

    surfacejacobianmatrix[x_][u_,v_]:= {D[x[uu,vv],uu],
          D[x[uu,vv],vv]}  /. {uu->u,vv->v}

    surfacejacobian[x_][u_,v_]:= Det[
        surfacejacobianmatrix[x][u,v].
        Transpose[surfacejacobianmatrix[x][u,v]]]

   surfacenormal[x_][u_,v_]:= Module[{xu,xv},
        xu = D[x[uu,vv],uu];
        xv = D[x[uu,vv],vv];
        Simplify[Cross[xu,xv]] /. {uu->u,vv->v}]
          
    unitnormal[x_][u_,v_]:= Module[{xu,xv,N1},
        xu = D[x[uu,vv],uu];
        xv = D[x[uu,vv],vv];
        N1 = Cross[xu,xv];
        Simplify[N1.N1]^(-1/2)*N1] /. {uu->u,vv->v}

(* Metric (First Fundamental Form) *)

    ee[x_][u_,v_]:= Simplify[D[x[uu,vv],uu].
                        D[x[uu,vv],uu]] /. {uu->u,vv->v}

    ff[x_][u_,v_]:= Simplify[D[x[uu,vv],uu].
                        D[x[uu,vv],vv]] /. {uu->u,vv->v}

    gg[x_][u_,v_]:= Simplify[D[x[uu,vv],vv].
                        D[x[uu,vv],vv]] /. {uu->u,vv->v}

    infarea[x_][u_,v_]:= Sqrt[Simplify[ee[x][u,v]*gg[x][u,v] -
                        ff[x][u,v]^2]]

(* Minimal Surface Programs *)

   analytictominimal[Psi_][t_][u_,v_]:=
        ComplexExpand[Re[E^(-I*t)*Psi[zz]]
        /. zz->u + I*v]

     geomincurve[alpha_][z_]:= Append[alpha[z],
            I*Simplify[PowerExpand[arclength[alpha][z]]]]

     harmonictoanalytic[x_][z_]:=
        Simplify[2x[z/2,z/(2*I)] - x[0,0]]

     harmonictoanalytic[x_][x0_,y0_][z_]:=
        Simplify[2x[(z + x0 - I*y0)/2,
        (z - x0 + I*y0)/(2*I)] - x[x0,y0]]
        
    wei[f_,g_][z_]:= Module[{zz,tmp},
           tmp = Integrate[{(1 - g[zz]^2)*f[zz]/2,
              I*(1 + g[zz]^2)*f[zz]/2,f[zz]*g[zz]},zz];
           Simplify[tmp /. zz->z]]

    weicurvature[f_,g_][z_]:= -16*Abs[D[g[zz],zz]]^2/
            (Abs[f[zz]]^2*(1 + Abs[g[zz]]^2)^4) /. zz->z

    weimetric[f_,g_][z_]:=
       (1/4)*Abs[f[zz]]^2*(1 + Abs[g[zz]]^2)^2 /. zz->z

    weiprime[f_,g_][z_]:= {(1 - g[z]^2)*f[z]/2,
              I*(1 + g[z]^2)*f[z]/2,f[z]*g[z]}

(* Principal Curvatures *)

     kmu[x_][u_,v_]:= ggg[x][u,v]/gg[x][u,v] /;
                   ff[x][u,v]==fff[x][u,v]==0

     kpi[x_][u_,v_]:= eee[x][u,v]/ee[x][u,v] /;
                   ff[x][u,v]==fff[x][u,v]==0

     k1[x_][u_,v_]:= mcurvature[x][u,v] +
         Sqrt[Simplify[mcurvature[x][u,v]^2 -
          gcurvature[x][u,v]]]

     k2[x_][u_,v_]:= mcurvature[x][u,v] -
          Sqrt[Simplify[mcurvature[x][u,v]^2 -
           gcurvature[x][u,v]]]

(* Second Fundamental Form and
Gauss Map Programs *)

    eee[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],uu,uu],D[x[uu,vv],uu],D[x[uu,vv],vv]}]/
        Sqrt[Simplify[D[x[uu,vv],uu].D[x[uu,vv],uu]*
             D[x[uu,vv],vv].D[x[uu,vv],vv] -
             D[x[uu,vv],uu].
             D[x[uu,vv],vv]^2]]] /. {uu->u,vv->v}


    fff[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],uu,vv],D[x[uu,vv],uu],D[x[uu,vv],vv]}]/
        Sqrt[Simplify[D[x[uu,vv],uu].D[x[uu,vv],uu]*
             D[x[uu,vv],vv].D[x[uu,vv],vv] -
             D[x[uu,vv],uu].
             D[x[uu,vv],vv]^2]]] /. {uu->u,vv->v}

    ggg[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],vv,vv],D[x[uu,vv],uu],D[x[uu,vv],vv]}]/
        Sqrt[Simplify[D[x[uu,vv],uu].D[x[uu,vv],uu]*
             D[x[uu,vv],vv].D[x[uu,vv],vv] -
             D[x[uu,vv],uu].
             D[x[uu,vv],vv]^2]]] /. {uu->u,vv->v}


    eeee[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],uu,uu],
        D[x[uu,vv],uu],
        D[x[uu,vv],vv]}]] /. {uu->u,vv->v}

    ffff[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],uu,vv],
        D[x[uu,vv],uu],
        D[x[uu,vv],vv]}]] /. {uu->u,vv->v}

    gggg[x_][u_,v_]:= Simplify[Det[{
        D[x[uu,vv],vv,vv],
        D[x[uu,vv],uu],
        D[x[uu,vv],vv]}]] /. {uu->u,vv->v}

        weingarten[x_][u_,v_]:=
       {{eee[x][u,v]*gg[x][u,v] - fff[x][u,v]*ff[x][u,v],
         fff[x][u,v]*ee[x][u,v] - eee[x][u,v]*ff[x][u,v]},
        {fff[x][u,v]*gg[x][u,v] - ggg[x][u,v]*ff[x][u,v],
         ggg[x][u,v]*ee[x][u,v] - fff[x][u,v]*ff[x][u,v]}}/
        (ee[x][u,v]*gg[x][u,v] - ff[x][u,v]^2)

(* Vector Analysis Programs *)
 
    der[v_List][ww_][x_,y_]:= {v[[1]]*D[ww[xx,yy],xx],
              v[[2]]*D[ww[xx,yy],yy]} /. {xx->x,yy->y}

    der[v_List][ww_][x_,y_,z_]:= {v[[1]]*D[ww[xx,yy,zz],xx],
                                  v[[2]]*D[ww[xx,yy,zz],yy],
                  v[[3]]*D[ww[xx,yy,zz],zz]} /. {xx->x,yy->y,zz->z}

    grad[g_][x_,y_]:= {D[g[xx,yy],xx],
        D[g[xx,yy],yy]} /. {xx->x,yy->y}

    grad[g_][x_,y_,z_]:=
        {D[g[xx,yy,zz],xx],D[g[xx,yy,zz],yy],
         D[g[xx,yy,zz],zz]} /. {xx->x,yy->y,zz->z}

    gmap[g_][x_,y_]:= grad[g][x,y]/
        (grad[g][x,y].grad[g][x,y])^(1/2)

    gmap[g_][x_,y_,z_]:= grad[g][x,y,z]/
        (grad[g][x,y,z].grad[g][x,y,z])^(1/2)

    divergence[ww_][x_,y_]:= D[ww[xx,yy],xx][[1]] +
            D[ww[xx,yy],yy][[2]] /. {xx->x,yy->y}

    divergence[ww_][x_,y_,z_]:= D[ww[xx,yy,zz],xx][[1]] +
                                D[ww[xx,yy,zz],yy][[2]] +
            D[ww[xx,yy,zz],zz][[3]] /. {xx->x,yy->y,zz->z}

    laplace[g_][x_,y_]:= D[g[xx,yy],{xx,2}] +
        D[g[xx,yy],{yy,2}] /. {xx->x,yy->y}

    laplace[g_][x_,y_,z_]:= D[g[xx,yy,zz],{xx,2}] +
        D[g[xx,yy,zz],{yy,2}] + D[g[xx,yy,zz],{zz,2}] /.
        {xx->x,yy->y,zz->z}

(* Miscellaneous Programs *)
              
    asymeq1[x_][u_,v_]:=
        Module[{uuu,a,xxx,eqa1,eqa2},
        xxx = Solve[eeee[x][uuu,v]*a^2 +
        2*ffff[x][uuu,v]*a +
        gggg[x][uuu,v]==0,a];
        eqa1 = u'[v]== a /. xxx[[1]];
        eqa2 = u'[v]== a /. xxx[[2]];
        {eqa1,eqa2} /. {a->u'[v],uuu->u[v]}]

    asymeq2[x_][u_,v_]:=
        Module[{vvv,a,xxx,eqa1,eqa2},
        xxx = Solve[eeee[x][u,vvv] +
        2*ffff[x][u,vvv]*b +
        gggg[x][u,vvv]*b^2==0,b];
        eqa1 = v'[u]== b /. xxx[[1]];
        eqa2 = v'[u]== b /. xxx[[2]];
        {eqa1,eqa2} /. {b->v'[u],vvv->v[u]}]

    circle3point[{p1_,q1_},{p2_,q2_},{p3_,q3_}]:=
      Circle[{(p2^2*q1 - p3^2*q1 - p1^2*q2 + p3^2*q2 -
      q1^2*q2 + q1*q2^2 + p1^2*q3 - p2^2*q3 + q1^2*q3 -
      q2^2*q3 - q1*q3^2 + q2*q3^2)/
      (2*(p2*q1 - p3*q1 - p1*q2 + p3*q2 + p1*q3 - p2*q3)), 
      (p1^2*p2 - p1*p2^2 - p1^2*p3 + p2^2*p3 + p1*p3^2 - 
      p2*p3^2 + p2*q1^2 - p3*q1^2 - p1*q2^2 + p3*q2^2 + 
      p1*q3^2 - p2*q3^2)/
      (2*(p2*q1 - p3*q1 - p1*q2 + p3*q2 + p1*q3 - p2*q3))},
      Abs[((p1^2 - 2*p1*p2 + p2^2 + q1^2 -
      2*q1*q2 + q2^2)^(1/2)*(p1^2 - 2*p1*p3 + p3^2 +
      q1^2 - 2*q1*q3 + q3^2)^(1/2)*(p2^2 - 2*p2*p3 +
      p3^2 + q2^2 - 2*q2*q3 + q3^2)^(1/2))/(2*(-(p2*q1) +
      p3*q1 + p1*q2 - p3*q2 - p1*q3 + p2*q3))]]

     monge[h_][u_,v_]:= {u,v,h[u,v]}

     mongepolar[g_][r_,theta_]:=
        {r*Cos[theta],r*Sin[theta],g[r,theta]}
     
     nateq[alpha_][k2_,s_]:= ToRules[Eliminate[
        {s==arclength[alpha][t]//PowerExpand,
         k2==kappa2[alpha][t]//PowerExpand//Simplify},t]]

     paramtoimp[alpha_,{x_,y_}]:=
            Eliminate[{x,y}==alpha[t],t]
           
     polarize[func_][r_,theta_]:=
        func[r*Cos[theta],r*Sin[theta]]
     
     stereoinj[a_][p_]:=Append[2*a^2*p,
                          a*(p.p - a^2)]/(p.p + a^2)

     stereoproj[a_][q_]:=a*Drop[q,-1]/(a - Last[q])

     stereoinjcomplex[g_][z_]:=
            {(2*Re[g[z]])/(Im[g[z]]^2 + Re[g[z]]^2 + 1), 
             (2*Im[g[z]])/(Im[g[z]]^2 + Re[g[z]]^2 + 1), 
             (Im[g[z]]^2 + Re[g[z]]^2 - 1)/
             (Im[g[z]]^2 + Re[g[z]]^2 + 1)}

     umeqs[k_][x_][u_,v_]:=
       {ee[x][u,v],ff[x][u,v],gg[x][u,v]} -
       {k*eee[x][u,v],k*fff[x][u,v],k*ggg[x][u,v]}

End[]

EndPackage[]

"CURVES" (List of parametrized curves)

(*Date:Fri Jun 12 13:28:35 BST 1998
*)

(*:Title: CURVES.m *)

(*:Author: Alfred Gray *)

(* Copyright 1994-1998 by Alfred Gray *)

(*:Package Version: 1.0 *)

(*:Mathematica Versions: 2.2, 3.0 *)

(*:Summary: 
This package consists of definitions of parametrically defined
plane curves, implicitly defined plane curves, polar 
parametrizations and space curves.
*)

(*:Keywords:
agnesi, agnesiimplicit, airyspiral, alysoid, 
alysoidnds, alysoidprime, archimedesspiral, 
archimedesspiralpolar, astroid, astroidimplicit, ast3d, 
baseballseam, bellcurve, besselcurve, besseln, bernstein, 
beziercurve, bicorn, bicylinder, biquadratic, bow, bowpolar, 
bowtie, bulletnose, bulletnoseimplicit, cardioid, 
cardioidimplicit, cardioidpolar, cardioidunitspeed, 
cartesianimplicit, cartesianoval, cassini, cassiniimplicit, 
cassinipolar, catenary, catenaryunitspeed, cayleysextic, 
circle, circleimplicit, circleinvolute, circleinvoluteunitspeed, 
circleunitspeed, cissoid, cissoidimplicit, clelia, clothoid, 
clothoidnds, clothoidprime, cnccoprofile, cnchyprofile, 
cochleoid, cochleoidpolar, conchoid, conchoidimplicit, 
conicalhelix, coshspiral, cosn, cothspiral, cpcprofile, 
crosscurve, crosscurveimplicit, cubicalellipse, cubicparabola, 
cubicparabolaimplicit, curves3d, cycloid, cycloidunitspeed, 
delaunay, delaunaykappa2, delaunaynds, deltoid, deltoidbis, 
deltoidimplicit, deltoidinvolute, deltoidunitspeed, 
devilimplicit, diamond, eight, eightknot, elasticainflect, 
elasticanoninflect, ellipse, ellipsebis, ellipseimplicit, 
ellipseinc, epicycloid, epicycloidunitspeed, epispiral, 
epispiralpolar, epitrochoid, epitrochoid3d, fermatspiral, 
fermatspiralpolar, folium, foliumimplicit, foliumpolar, 
genparabola, genhelix, hankelspiral, helix, helixunitspeed, 
hippopede, hippopedeimplicit, horopter, hyperbola, hyperbolabis, 
hyperbolaimplicit, hyperbolicspiral, hyperbolicspiralpolar, 
hypocycloid, hypocycloidinvolute, hypocycloidunitspeed, 
hypotrochoid, kampyle, kampylepolar, kappacurve, 
kappacurveimplicit, keplerimplicit, keplerorbit, 
keplerorbitpolar, kochsnowflake, lehr, lehrkappa2, lehrnds, 
lemniscate, lemniscatebis, lemniscateimplicit, lemniscatepolar, 
lemniscateunitspeed, limacon, limaconimplicit, limaconpolar, 
line, line3d, lissajous, lissajous3d, lituus, lituuspolar, 
logistic, logspiral, logspiralpolar, logspiralunitspeed, 
nephroid, nephroidimplicit, nephroidpolar, nephroidunitspeed, 
newtonphillipsimplicit, ngon, nielsenspiral, 
oneparametersubgroup, pacman, parabola, parabolaimplicit, 
parabolicspiral, perseusimplicit, piriform, piriformimplicit, 
predatorpreyimplicit, pseudocatenary, pseudocatenaryprime, 
pseudospheregeodesic, pseudosphericalloxodrome, rectangle, 
regularpolygon, reuleauxpolygon, rose, rosepolar, sc, scarab, 
scimplicit, seiffertspiral, semicubic, semicubicimplicit, 
serpentine, serpentineimplicit, sinhspiral, sinn, sinoval, 
sphericalcardioid, sphericalellipse, sphericalhelix, 
sphericalloxodrome, sphericalloxodromeunitspeed, 
sphericalnephroid, sphericalspiral, spring, strophoid, 
strophoidimplicit, tanhspiral, teardrop, teeth, tennisballseam, 
tooth, torusknot, tractrix, tractrixminus, tractrixplus, 
tractrixunitspeed, triangle, trident, tridentimplicit, 
trisectrix, tschirnhausen, twicubic, twistedn, veryflat, 
viviani, watt, wattimplicit, wigglyellipse, zcprofile
*)

BeginPackage["CURVES`","CSPROGS`","PLTPROGS`","Graphics`Graphics`","Graphics`ImplicitPlot`"]

    curves:= Print[Select[Names["CURVES`*"],#!="curves"&]]

(* Parametrically Defined Plane Curves *)

    agnesi::usage="t->agnesi[a][t] is the parametrized curve whose implicit equation is x^2*y==4*a^2*(2*a - y).  To plot try agnesi[1][-1.1,1.1]."

    airyspiral::usage="t->airyspiral[a][t] is a parametrized curve formed using Airy functions.  To plot try airyspiral[1][-20,1]."

    alysoid::usage="s->alysoid[a,b,c][s] is a unit-speed curve which is a generalization of a catenary. Its curvature is -c/(a*b + s^2). s->alysoid[a,a,a][s] is the same as s->catenaryunitspeed[a][s].  See alysoidnds. To plot try alysoid[1,1,3][-1.1,1.1]."

    alysoidkappa2::usage="s->alysoidkappa2[a,b,c][s] is the signed curvature of an alysoid. It is used in the definition of s->alysoidnds[smin,smax][a,b,c][s]."

    alysoidnds::usage="s->alysoidnds[smin,smax][a,b,c][s] is an approximation over the interval smin<s<smax found by NDSolve to s->alysoid[a,b,c][s]." 

    alysoidprime::usage="t->alysoidprime[a,b,c][t] is the velocity of  t->alysoid[a,b,c][t]. It is used in the definitions of s->alysoid[a,b,c][s] and s->alysoidnds[smin,smax][a,b,c][s]."  

    archimedesspiral::usage="t->archimedesspiral[n,a][t] is the spiral of Archimedes of radius a and degree n.  To plot try archimedesspiral[3,1][0,4Pi]."

    astroid::usage="t->astroid[a][t] is the parametrized curve whose implicit equation is x^(2/3) + y^(2/3)==a^(2/3). t->astroid[a,b][t] is the parametrized curve whose implicit equation is (x/a)^(2/3) + (y/b)^(2/3)==1. t->astroid[n,a,b][t] is the parametrized curve whose implicit equation is (x/a)^n + (y/b)^n==1.  To plot try astroid[3,1,1][0,2Pi]."

    bellcurve::usage="t->bellcurve[mean,variance][t] is the bell curve of statistics.  To plot try bellcurve[0,1][-3,3]."

    bicorn::usage="t->bicorn[a][t] is a curve with two horns.  To plot try bicorn[1][-Pi,Pi]."

    bow::usage="t->bow[a][t] is a parametrized curve whose shape is a bow. The polar equation is r==a*(1 - Tan[theta]^2).  To plot try bow[1][-Pi,Pi]."

    bowtie::usage="t->bowtie[a,b][t] is a parametrized curve whose shape is a bowtie.  To plot try bowtie[1,0.04][0,2Pi]."

    bulletnose::usage="t->bulletnose[a,b][t] is the parametric form of the curve whose implicit equation is a^2/x^2 - b^2/y^2==1.  To plot try bulletnose[3,1][-2Pi,2Pi]."

    cardioid::usage="t->cardioid[a][t] is a cardioid or heart-shaped curve that is traced by a point on the circumference of a circle of radius 2*a rolling around a fixed circle of the same radius. It has the polar equation r==2*a*(1 + Cos[theta]). The implicit equation is (x^2 + y^2 - 2*a*x)^2 - 4*a^2*(x^2 + y^2)==0. A cardioid is a special case of an epicycloid.  To plot try cardioid[1][0,2Pi]."

    cardioidunitspeed::usage="s->cardioidunitspeed[a][s] is a unit-speed parametrization of t->cardioid[a][t]."

    cartesianoval::usage="u->cartesianoval[a,b][u,v] and v->cartesianoval[a,b][u,v] are orthogonal Cartesian ovals."

    cassini::usage="t->cassini[a,b,pm1,pm2][t] is a parametrization of an oval of Cassini. The parameters pm1 and pm2 are plus or minus 1. The implicit equation is (x^2 + y^2 + a^2)^2 - b^4 - 4*a^2*x^2==0.  To plot try cassini[1.99,2,1,1][-Pi,Pi]."

    catenary::usage="t->catenary[a][t] is the curve formed by a perfectly flexible inextensible chain of uniform density hanging from two supports. It is given by t->{a*Cosh[t/a],t}.  To plot try catenary[-1][-2,2]."

    catenaryunitspeed::usage="s->catenaryunitspeed[a][s] is a unit-speed parametrization of t->catenary[a][t]."

    cayleysextic::usage="t->cayleysextic[a][t] is Cayley's sextic curve.  To plot try   To plot try cayleysextic[1][0,2Pi]."

    circle::usage="t->circle[a][t] is a circle centered at the origin of radius a. The nonparametric form is x^2 + y^2==a^2.  To plot try circle[1][0,2Pi]."

    circleinvolute::usage="t->circleinvolute[n,a][t] is the nth involute starting at {a,0} of the circle t->{a*Cos[t],a*Sin[t]}. t->circleinvolute[a][t] is the same as t->circleinvolute[1,a][t].  To plot try circleinvolute[1,1][0,2Pi]."  

    circleinvoluteunitspeed::usage="s->circleinvoluteunitspeed[n,a][s] is a unit-speed parametrization of t->circleinvolute[n,a][t]. s->circleinvoluteunitspeed[a][s] is the same as s->circleinvoluteunitspeed[1,a][s]."  

    circleunitspeed::usage="s->circleunitspeed[a][s] is a unit-speed parametrization of t->circle[a][t]."

    cissoid::usage="t->cissoid[a][t] is an ivy-shaped curve whose implicit equation is x^3 + x*y^2 - 2*a*y^2==0.  To plot try cissoid[1][-2,2]."

    clothoid::usage="s->clothoid[n,a][s] is the nth clothoid. The curvature is proportional to the nth power of the arc length function. It is a unit-speed curve. s->clothoid[1,a][s] is the ordinary clothoid, also known as Euler's spiral. s->clothoid[a][s] is the same as s->clothoid[1,a][s].  See clothoidnds. To plot try clothoid[1,1][-5,5]."  

    clothoidnds::usage="s->clothoidnds[smin,smax][n,a][s] is an approximation over the interval smin<s<smax found by NDSolve to s->clothoid[n,a][s]."  

    clothoidprime::usage="t->clothoidprime[n,a][t] is the velocity of the nth clothoid. It is used in the definitions of s->clothoid[n,a][s] and s->clothoidnds[smin,smax][n,a][s]."

    cnccoprofile::usage="s->cnccoprofile[pm,a,b][s] is a profile curve for a surface of revolution of constant negative curvature -1/a^2 of conic type. It is a unit-speed curve. The parameter pm is plus or minus 1.  To plot try cnccoprofile[1,1,0.3][-1.87,1.87]."

    cnchyprofile::usage="s->cnchyprofile[pm,a,b][s] is a profile curve for a surface of revolution of constant negative curvature -1/a^2 of hyperboloid type. It is a unit-speed curve. The parameter pm is plus or minus 1.  To plot try cnchyprofile[1,1,0.7][-1.15,1.15]."

    cochleoid::usage="t->cochleoid[n,a][t] is the parametrized curve whose polar equation is r==a*(Sin[theta]/theta)^n.  To plot try cochleoid[1,1][-4Pi,4Pi]."

    conchoid::usage="t->conchoid[a,b][t] is the parametrized curve whose implicit equation is (x^2 + y^2)*(x - b)^2==a^2*x^2.  To plot try conchoid[4,-2][-Pi/2,Pi/2]."

    coshspiral::usage="t->coshspiral[n,a][t]  is a hyperbolic cosine spiral or Poinsot cosh spiral of radius a.  To plot try coshspiral[1,1][-Pi,Pi]."

    cothspiral::usage="t->cothspiral[a][t] is a hyperbolic cotangent spiral of radius a.  To plot try cothspiral[2][-Pi/2,Pi/2]."

    cpcprofile::usage="s->cpcprofile[pm,a,b][s] is a profile curve for a surface of revolution of constant positive curvature 1/a^2. It is a unit-speed curve. The parameter pm is plus or minus 1. There are 3 cases: football type (a>b), sphere (a=b), barrel type (a<b).  To plot try cpcprofile[1,1,0.5][-Pi/2,Pi/2]." 

    crosscurve::usage="t->crosscurve[a,b][t] is the parametric form of the curve whose implicit equation is a^2/x^2 + b^2/y^2==1.  To plot try crosscurve[1,2][-Pi,Pi]."

    cubicparabola::usage="t->cubicparabola[a,b,c,d][t] is the general cubic parabola whose implicit equation is y==a*x^3 + b*x^2 + c*x + d.  To plot try cubicparabola[1,0,-1,0][-2,2]."

    cycloid::usage="t->cycloid[a,b][t] is the locus of points traced out by a point on a circle of radius b when a concentric circle of radius a rolls without slipping along a straight line. The cycloid is called prolate if b > a and curtate if a > b. t->cycloid[a][t] is the same as t->cycloid[a,a][t].  To plot try cycloid[1,2][-4Pi,2Pi]."  

    cycloidunitspeed::usage="s->cycloidunitspeed[a,a][s] is a unit-speed parametrization of t->cycloid[a,a][t]."

    delaunay::usage="A Delaunay curve is the path of a focus of a conic with long axis a and eccentricity e as the conic rolls on a straight line. If 0<e<1, the conic is an ellipse; if e>1, the conic is a hyperbola.  Its numerical implementation is delaunaynds.  To plot try delaunay[1,2][-4Pi,4Pi]."

    delaunaykappa2::usage="s->delaunaykappa2[a,e][s] is the signed curvature of a Delaunay curve. It is used in the definition of s->delaunaynds[smin,smax][a,e][s]."

    delaunaynds::usage="s->delaunaynds[smin,smax][a,e][s] is an approximation over the interval smin<s<smax found by NDSolve to a unit-speed parametrization of a Delaunay curve. A Delaunay curve is the path of a focus of a conic with long axis a and eccentricity e as the conic rolls on a straight line. If 0<e<1, the conic is an ellipse; if e>1, the conic is a hyperbola."

    deltoid::usage="t->deltoid[a][t] is a parametrized curve which resembles a delta. A deltoid is a special case of an hypocycloid.  To plot try deltoid[1][0,2Pi]."

    deltoidbis::usage="t->deltoidbis[a][t] is a parametrized curve which resembles a delta. A deltoid is a special case of an hypocycloid.  To plot try deltoidbis[1][0,2Pi]."

    deltoidinvolute::usage="t->deltoidinvolute[a][t] is the involute of t->deltoid[a][t] starting at t=0.  To plot try deltoidinvolute[1][-2Pi,2Pi]."

    deltoidunitspeed::usage="s->deltoidunitspeed[a][s] is a unit-speed parametrization of t->deltoid[a][t]."

    diamond::usage="t->diamond[a][t] is a parametrized curve whose shape is a diamond. t->diamond[n,a,b][t] is a generalization of t->diamond[a][t] that is similar to t->astroid[n,a,b][t].  To plot try diamond[0.5,1,1.5][0.1,6.38]."

    eight::usage="t->eight[t] is a parametrized curve which resembles a figure eight.  To plot try eight[-Pi,Pi]."

    elasticainflect::usage="s->elasticainflect[a,k][s] is a unit-speed inflectional elastica starting at {0,0}.  To plot try elasticainflect[1,0.8][-8,8]."

    elasticanoninflect::usage="s->elasticanoninflect[a,k][s] is a unit-speed noninflectional elastica starting at {0,0}.  To plot try elasticanoninflect[1,0.8][-8,8]."

    ellipse::usage="t->ellipse[a,b][t] is the standard parametrization of an ellipse centered at the origin using Cos and Sin. The nonparametric form is x^2/a^2 + y^2/b^2==1.  To plot try ellipse[1,2][0,2Pi]."

    ellipsebis::usage="t->ellipsebis[a,b][t] is a parametrization of an ellipse centered at the origin using Sech and Tanh. The nonparametric form is x^2/a^2 + y^2/b^2==1.  To plot try ellipsebis[1,2][-2,2]."

    ellipseinc::usage="t->ellipseinc[a,b,c,psi][t] is the locus of points at a distance c along a line meeting an t->ellipse[a,b] at the point ellipse[a,b][t] with an angle psi.  To plot try ellipseinc[1,2,-1,Pi/4][0,3Pi]."

    epicycloid::usage="t->epicycloid[a,b][t] is a parametrized curve traced out by a point P on the circumference of a circle (of radius b) rolling outside another circle (of radius a). Special cases are: cardioid (b=a), nephroid (b=a/2).  To plot try epicycloid[5,2][0,4Pi]."

    epicycloidunitspeed::usage="s->epicycloidunitspeed[a,b][s] is a unit-speed parametrization of t->epicycloid[a,b][t]."

    epispiral::usage="t->epispiral[n,a][t] is an epispiral. The curve has n branches if n is odd and 2*n branches if n is even. Each branch has two asymptotes radiating out from the center. The polar equation is r==a/Sin[n*theta].  To plot try epispiral[5,1][0,2Pi]."

    epitrochoid::usage="t->epitrochoid[a,b,h][t] is a parametrized curve traced out by a point P attached to a circle (of radius b) rolling outside another circle (of radius a). Let h be the distance from P to the center of the moving circle. Special cases are: circle (a=0), limacon (a=b), epicycloid (h=b), cardioid (h=b=a), nephroid (h=b=a/2). There are a/b loops. For an epicycloid the loops degenerate to points.  To plot try epitrochoid[7,1,2][0,2Pi]."

    fermatspiral::usage="t->fermatspiral[a][t] is a spiral of Fermat of radius a, where t is positive. t->fermatspiral[n,a][t] is a spiral of Fermat of radius a and degree n, where t may be positive or negative. Special cases are: fermatspiral (n=1/4), lituus (n=3/4), archimedesspiral (n=(m - 1)/(2*m)).  To plot try fermatspiral[0.25,1][-4Pi,4Pi]."

    folium::usage="t->folium[t] is the folium of Descartes. The nonparametric form is x^3 + y^3 - 3*x*y==0. t->folium[n,a,b,c][t] is a generalized folium of Descartes. The nonparametric form is a*x^(2*n + 1) + b*y^(2*n + 1) - c*x^n*y^n==0. To plot try folium[-0.999,60]."

    genparabola::usage="t->genparabola[n][t] is the curve t->{t,t^n}.  To plot try genparabola[3][-1,1]."

    hankelspiral::usage="t->hankelspiral[n,a][t] is a Hankel spiral of order n.  To plot try hankelspiral[1,1][0.1,14]."

    hippopede::usage="t->hippopede[a,b][t] is the parametric form of a curve whose shape resembles a horse fetter.  To plot try hippopede[1.1,1][-Pi,Pi]."

    hyperbola::usage="t->hyperbola[a,b][t] is the standard parametrization of a hyperbola centered at the origin using Cosh and Sinh. The nonparametric form is x^2/a^2 - y^2/b^2==1.  To plot try hyperbola[1,2][-2,2]."

    hyperbolabis::usage="t->hyperbolabis[a,b][t] is a parametrization of a hyperbola centered at the origin using Sec and Tan. The nonparametric form is x^2/a^2 - y^2/b^2==1.  To plot try hyperbolabis[1,2][-1,1]."

    hyperbolicspiral::usage="t->hyperbolicspiral[a][t] is a hyperbolic spiral of radius a. It is a special case of a spiral of Archimedes.  To plot try hyperbolicspiral[1][0.03Pi,6Pi]."

    hypocycloid::usage="t->hypocycloid[a,b][t] is a parametrized curve traced out by a point P on the circumference of a circle (of radius b) rolling inside another circle (of radius a). Special cases are: deltoid (b=a/3), astroid (b=a/4).  To plot try hypocycloid[8,1][0,2Pi]."

    hypocycloidinvolute::usage="t->hypocycloidinvolute[a,b][t] is the involute of t->hypocycloid[a,b][t] starting at t=0.  To plot try hypocycloidinvolute[5,1][0,4Pi]."

    hypocycloidunitspeed::usage="s->hypocycloidunitspeed[a,b][s] is a unit-speed parametrization of t->hypocycloid[a,b][t]."

    hypotrochoid::usage="t->hypotrochoid[a,b,h][t] is a parametrized curve traced out by a point P on one circle (of radius b) rolling inside another circle (of radius a). Let h be the distance from P to the center of the moving circle. Special cases are: ellipse (a=2*b), hypocycloid  (h=b), deltoid (h=b=a/3), astroid (h=b=a/4). There are a/b loops when a/b is an integer larger than 2 and h>b. For a hypocycloid the loops degenerate to points.  To plot try hypotrochoid[5,1,2][0,2Pi]."

    kampyle::usage="t->kampyle[a][t] is the kampyle or crooked staff of Eudoxus. The polar equation is r==a*Sec[theta]^2.  To plot try kampyle[1][-Pi,Pi]."

    kappacurve::usage="t->kappacurve[a][t] is a kappa or Gutschoven curve. To plot try kappacurve[1][0,2Pi,PlotRange->{{-2,2},Automatic}]."

    keplerorbit::usage="t->keplerorbit[a,e][t] is a Kepler orbit, where e is the eccentricity. The orbit is part of an ellipse (0<=e<1), parabola (e=1) or hyperbola (e>1).  To plot try keplerorbit[2,0.7][0,2Pi]."
 
    lehr::usage="A Lehr curve is a plane curve whose signed curvature is a + b*Cos[c*s]. Its numerical implementation is lehrnds.  To plot try lehr[1,5,3][0,2Pi]."

    lehrkappa2::usage="s->lehrkappa2[a,b,c][s] is the signed curvature of a Lehr curve. It is used in the definition of s->lehrnds[smin,smax][a,b,c][s]."
    
    lehrnds::usage="s->lehrnds[smin,smax][a,b,c][s] is an approximation over the interval smin<s<smax found by NDSolve to a unit-speed parametrization of a Lehr curve. Its signed curvature is a + b*Cos[c*s]."

    lemniscate::usage="t->lemniscate[a][t] is the parametrized curve whose implicit equation is (x^2 + y^2)^2==a^2*(x^2 - y^2).  To plot try lemniscate[1][0,2Pi]."

    lemniscatebis::usage="t->lemniscatebis[a][theta] is a parametrization of
a lemniscate in which theta measures the angle subtended by a point on the curve.  To plot try lemniscatebis[1][-Pi/4,Pi/4]."

    lemniscateunitspeed::usage="s->lemniscateunitspeed[a][s] is a unit-speed parametrization of t->lemniscate[a][t]."

    limacon::usage="t->limacon[a,b][t] is the parametrized curve whose implicit equation is (x^2 + y^2 - 2*a*x)^2==b^2*(x^2 + y^2). t->limacon[a,2*a][t] coincides with t->cardioid[a][t].  To plot try limacon[-1,1][0,2Pi]."

    line::usage="t->line[a1,b1,a2,b2][t] is a parametrized line in R^2 with line[a1,b1,a2,b2][0]={a2,b2} and line[a1,b1,a2,b2]'[0]={a1,b1}."

    lissajous::usage="t->lissajous[n,d,a,b][t] is a Lissajous or Bowditch curve.  To plot try lissajous[3/4,0,9,8][0,8Pi]."

    lituus::usage="t->lituus[a][t] is the lituus spiral of radius a. It is a trumpet-shaped curve that is the locus of points P such that the square of distance of P from the origin is inversely proportional to the angle theta that p makes with the horizontal axis. The polar equation is r==a*(theta)^(-1/2).  To plot try lituus[1][0,12Pi]."

    logistic::usage="t->logistic[k,a,b][t] is the logistic curve used to model growth in biological populations for which saturation occurs.  To plot try logistic[3,2,-2][-3,3]."

    logspiral::usage="t->logspiral[a,b][t] is the log spiral of radius a and slant b. The polar equation is r==a*E^(b*theta).  To plot try logspiral[1,0.04][0,12Pi]."

    logspiralunitspeed::usage="s->logspiralunitspeed[a,b][s] is a unit-speed parametrization of t->logspiral[a,b][t]."

    nephroid::usage="t->nephroid[a][t] is a nephroid or kidney-shaped curve that is traced by a point on the circumference of a circle of radius a rolling around a fixed circle of radius 2*a. It has the polar equation r==2*a*(Sin[theta/2]^(2/3) + Cos[theta/2]^(2/3))^(3/2). The implicit equation is (x^2 + y^2 - 4*a^2)^3 - 108*a^4*y^2==0. A nephroid is a special case of an epicycloid.  To plot try nephroid[1][0,2Pi]."

    nephroidunitspeed::usage="s->nephroidunitspeed[a][s] is a unit-speed parametrization of t->nephroid[a][t]."

    ngon::usage="t->ngon[n,a][t] is a parametrization of a regular polygon with n sides, where a is the length of the apothem.  To plot try ngon[5,1][0,1]."

    nielsenspiral::usage="t->nielsenspiral[a][t] is Nielsen's spiral of radius a.  To plot try nielsenspiral[1][0.1,12Pi]."

    parabola::usage="t->parabola[a][t] is the vertical parabola with vertex at the origin, focus at {0,a} and directrix t->{t,-a}. The nonparametric form is x^2==4*a*y.  To plot try parabola[1][-1.5,1.5]."

    parabolicspiral::usage="t->parabolicspiral[n,a,b][t] is a parabolic spiral of radius a, offset b and degree n, where t may be positive or negative. Special cases are: fermatspiral (b=0), lituus (n=3/4,b=0), archimedesspiral (n=(m - 1)/(2*m),b=0).  To plot try parabolicspiral[0.25,1,1][-6Pi,2Pi]."

    piriform::usage="t->piriform[a,b][t] is a pear-shaped curve whose implicit equation is  a^4*y^2 - b^2*x^3*(2*a - x)==0.  To plot try piriform[1,1][0,2Pi]."

    pseudocatenary::usage="s->pseudocatenary[a,b][s] is a unit-speed curve which is a generalization of a catenary. Its curvature is -a/(a*b + s^2). s->pseudocatenary[a,a][s] is the same as s->catenaryunitspeed[a][s].  See pseudocatenarynds. To plot try pseudocatenary[1,0.3][-1,1]."

    pseudocatenarykappa2::usage="s->pseudocatenarykappa2[a,b][s] is the signed curvature of a pseudocatenary. It is used in the definition of s->pseudocatenarynds[smin,smax][a,b,c][s]."

    pseudocatenarynds::usage="s->pseudocatenarynds[a,b][s] is an approximation over the interval smin<s<smax found by NDSolve to s->pseudocatenary[a,b][s]."

    pseudocatenaryprime::usage="t->pseudocatenaryprime[a,b][t] is the velocity of t->pseudocatenary[a,b][t]."

    rectangle::usage="t->rectangle[n,a,b][t] is a generalized rectangle. t->rectangle[1,a,b][t] is an ellipse. t->rectangle[2,a,b][t] is a parametrization of an ordinary rectangle. t->rectangle[3,a,b][t] is an astroid rotated by -Pi/4.  To plot try rectangle[2,1,2][0.1,6.38]."

    reuleauxpolygon::usage="t->reuleauxpolygon[n,a][t] is a parametrization of a Reuleaux constant width curve with 2*n +1 sides, where a is the distance between any vertex and the center.  To plot try reuleauxpolygon[3,1][0,1]."

    rose::usage="t->rose[n,a][t] is a rose of radius a with n petals if n is odd and 2*n petals if n is even. The polar equation is r==a*Cos[n*theta].  To plot try rose[3,1][0,Pi]."

    sc::usage="t->sc[t] is the semicubical parabola t->{t^2,t^3}. The nonparametric form is y^2==x^3.  To plot try sc[-2,2]."

    scarab::usage="t->scarab[a,b][t] is a parametrization of a scarab.  To plot try scarab[1,1][0,2Pi]."

    scunitspeed::usage="s->scunitspeed[s] is a unit-speed parametrization of t->sc[t]."

    semicubic::usage="z->semicubic[a,b,c,d][z] is a parametrization of the semicubic y^2 = a*x^3 + b*x^2 + c*x + d using the Weierstrass P function and its derivative.  To plot try semicubic[4,0,-189.07,0][0.1,0.9]."

    serpentine::usage="t->serpentine[a,b][t] is a serpentine curve.  To plot try serpentine[2,2][-3,3]."

    sinhspiral::usage="t->sinhspiral[n,a][t] is a hyperbolic sine spiral or Poinsot sinh spiral of radius a.  To plot try sinhspiral[2,1][0.01,Pi-0.01]."

    sinoval::usage="t->sinoval[n,a][t] is the oval t->{a*Cos[t],a*Sin[Sin[...Sin[t]]]}.  To plot try sinoval[3,1][0,2Pi]."

    spring::usage="t->spring[a,b,v][t] is a plane curve which resembles a spring. It is the projection of t->helix[a,b][t] onto a plane whose normal makes an angle v with the z-axis.  To plot try spring[1,0.03,Pi/4][0,30Pi]."

    strophoid::usage="t->strophoid[a][t] is the parametrized curve whose implicit equation is y^2*(a - x)==x^3. t->strophoid[m,a][t] is the parametrized curve whose implicit equation is y^2*(a - x)==x^2*(a*m + x). The case m=0 is the cissoid t->cissoid[a/2][t] and the case m=1 is the strophoid t->strophoid[a][t].  To plot try strophoid[1,1][-5,5]."

    talbot::usage="t->talbot[a,b,f][t] is Talbot's curve.  To plot try talbot[1,1,0.9][-Pi,Pi]."

    tanhspiral::usage="t->tanhspiral[a][t] is the hyperbolic tangent spiral of radius a.  To plot try tanhspiral[1][-Pi/2,Pi/2]."

    teardrop::usage="t->teardrop[a,b,c,d,n][t] is a curve resembling a teardrop that has high order contact with the horizontal axis.  To plot try teardrop[8,1,2,1,2]."

    tractrix::usage="t->tractrix[a][t] is a tractrix. It represents the path of a particle P pulled by an inextensible string whose end moves along a line. The evolute of a catenary is a tractrix. A tractrix is the profile curve of a surface of revolution of constant Gaussian curvature -1/a^2. t->tractrix[a,b][t] is a generalization of a tractrix in the same way that an ellipse is a generalization of a circle. In the terminology of Bianchi, t->tractrix[a,b][t] is a shortened tractrix for b<a or extended tractrix for b>a.  To plot try tractrix[1][0.01,Pi-0.1]."

    tractrixminus::usage="s->tractrixminus[a][s] is a parametrization of the bottom half of t->tractrix[a][t].  To plot try tractrixminus[1][0.01,1]."

    tractrixplus::usage="s->tractrixplus[a][s] is a parametrization of the top half of t->tractrix[a][t].  To plot try tractrixplus[1][0.01,1]."

    tractrixunitspeed::usage="s->tractrixunitspeed[a][s] is a unit-speed parametrization of t->tractrix[a][t]."

    triangle::usage="t->triangle[t] is a parametrization of an equilateral
triangle.  To plot try triangle[0,3]."

    trident::usage="t->trident[a,b,c,d][t] is the parametric form of the curve whose implicit equation is x*y==a*x^3 + b*x^2 + c*x + d.  To plot try trident[1,0,0,1][-1,1]."

    trisectrix::usage="t->trisectrix[a][t] is the trisectrix of Maclaurin.  To plot try trisectrix[1][-0.49Pi,0.49Pi]."

    tschirnhausen::usage="t->tschirnhausen[n,a][t] is a parametrization of Tschirnhausen's cubic.  To plot try tschirnhausen[1,1][-1.4Pi,1.4Pi]."

    watt::usage="t->watt[a,b,c][t] is a parametrization of Watt's curve.  To plot try watt[1,2,1][-2Pi,2Pi]."

    zcprofile::usage="t->zcprofile[pm,a,c][t] is the profile curve of a generalized helicoid of zero Gaussian curvature. The parameter pm is +1 or -1.  To plot try zcprofile[1,1,1][1,3]."

(* Implicitly Defined Plane Curves *)

    agnesiimplicit::usage="agnesiimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{2*a*Tan[t],2*a*Cos[t]^2} To plot try agnesiimplicit[1][{-5,5}]."

     astroidimplicit::usage="astroidimplicit[n,a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Cos[t]^n,b*Sin[t]^n}."

    bulletnoseimplicit::usage="bulletnoseimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Cos[t],b*Cot[t]}. To plot try bulletnoseimplicit[1,1][{-1,1}]."

    cardioidimplicit::usage="cardioidimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{a*(1 + Cos[t])*Cos[t],a*(1 + Cos[t])*Sin[t]}.  To plot try cardioidimplicit[1][{-0.5,4.1}]."

    cartesianimplicit::usage="cartesianimplicit[a,c,m][x,y]==0 is an oval of Descartes: ((1 - m^2)*(x^2 + y^2) + 2*m^2*c*x + a^2 - m^2*c^2)^2 - 4*a^2*(x^2 + y^2)==0. To plot try cartesianimplicit[1,3,2][{-2,8}]."

    cassiniimplicit::usage="cassiniimplicit[a,b][x,y]==0 is an oval of Cassini: (x^2 + y^2 + a^2)^2 - b^4 - 4*a^2*x^2==0. To plot try cassiniimplicit[2.01,2][{-3,3}]."

    circleimplicit::usage="circleimplicit[a][x,y]==0 is the nonparametric form of the parametrized circle t->{a*Cos[t],a*Sin[t]}. To plot try circleimplicit[1][{-1,1}]."

    cissoidimplicit::usage="cissoidimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{2*a*t^2/(1 + t^2),2*a*t^3/(1 + t^2)}. To plot try cissoidimplicit[1][{0,1}]."

    conchoidimplicit::usage="conchoidimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{b + a*Cos[t],b*Tan[t] + a*Sin[t]}. To plot try conchoidimplicit[4,1][{-4,5}]."

    crosscurveimplicit::usage="crosscurveimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Sec[t],b*Csc[t]} To plot try crosscurveimplicit[1,1][{-4,4}]."

    cubicparabolaimplicit::usage="cubicparabolaimplicit[a,b,c,d][x,y]==0 is the nonparametric form of the parametrized curve t->{t,a*t^3 + b*t^2 + c*t + d}. To plot try cubicparabolaimplicit[1,-2,-1,0][{-2,3}]."

    deltoidimplicit::usage="deltoidimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{2*a*Cos[t]*(1 + Cos[t]) - a,2*a*Sin[t]*(1 - Cos[t])}. To plot try deltoidimplicit[1][{-1.5,3}]."

    devilimplicit::usage="devilimplicit[a,b][x,y]==0 is the devil's curve: y^2*(y^2 - b^2) - x^2*(x^2 - a^2)==0. To plot try devilimplicit[1.5,1][{-2,2}]."

    duererimplicit::usage="duererimplicit[a,b][x,y]==0 is Duerer's conchoid.
Let q + r = b. The locus of points {x,y} whose distance from {q,0} is a and
lie on the line through {q,0} and {r,0} constitute Duerer's conchoid. To plot try duererimplicit[1,1][{-10,10}]."

    ellipseimplicit::usage="ellipseimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Cos[t],b*Sin[t]}. To plot try ellipseimplicit[2,1][{-2,2}]."

    foliumimplicit::usage="foliumimplicit[x,y]==0 is the nonparametric form of the parametrized curve t->{3*t/(1 +t^3),3*t^2/(1 + t^3)}. foliumimplicit[n,a,b,c][x,y]==0 is the nonparametric form of the parametrized curve t->{c*t^n/(a + b*t^(2*n + 1)),c*t^(n + 1)/(a + b*t^(2*n + 1))}. To plot try foliumimplicit[5,2,-1,1][{-1,1}]."

     hippopedeimplicit::usage="hippopedeimplicit[a,b][x,y]==0 is the nonparametric form of a curve whose shape resembles a horse fetter. to plot try hippopedeimplicit[1.1,1][{-3,3}]."

    hyperbolaimplicit::usage="hyperbolaimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Cosh[t],b*Sinh[t]}. To plot try hyperbolaimplicit[1,2][{-2,2}]."

    kappacurveimplicit::usage="kappacurveimplicit[a][x,y]==0 is the nonparametric form of a kappa or Gutschoven curve. To plot try kappacurveimplicit[2][{-2,2}]."

    keplerimplicit::usage="keplerimplicit[a,b][x,y]==0 is a folium of Kepler: ((x - b)^2 + y^2)*(x*(x - b) + y^2) - 4*a*(x - b)*y^2==0. To plot try keplerimplicit[2,1][{-1,3}]."

    lemniscateimplicit::usage="lemniscateimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{a*Cos[t]/(1 + Sin[t]^2),a*Sin[t]*Cos[t]/(1 + Sin[t]^2)}. lemniscateimplicit[b*Sqrt[2]][x,y] coincides with cassiniimplicit[b,b][x,y]. To plot try lemniscateimplicit[1][{-1,1}]."

    limaconimplicit::usage="limaconimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{(2*a*Cos[t] + b)*Cos[t](2*a*Cos[t] + b)*,Sin[t]}. To plot try limaconimplicit[2,1][{-1,5}]."

    nephroidimplicit::usage="nephroidimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve
t->{a*(3*Cos[t] - Cos[3*t]),a*(3*Sin[t] - Sin[3*t])}. To plot try nephroidimplicit[1][{-3,3}]."

    newtonphillipsimplicit::usage="newtonphillipsimplicit[m,n,a,b][x,y]==0 is the nonparametric curve studied by Newton and Phillips."

    parabolaimplicit::usage="parabolaimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{2*a*t,a*t^2}. To plot try parabolaimplicit[1][{-3,3}]."

    perseusimplicit::usage="perseusimplicit[a,b,c][x,y]==0 is the nonparametric form of a spiric of Perseus. perseusimplicit[a,b^2/(2*a),b^2/(2*a)][x,y]==0 coincides with cassiniimplicit[a,b][x,y]==0. A section of a torus by a plane parallel to the axis of revolution is a spiric of Perseus. To plot try perseusimplicit[5,3,1.9][{-11,11}]."

    piriformimplicit::usage="piriformimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{(1 + Sin[t])*a,(1 + Sin[t])*b*Cos[t]}. To plot try piriformimplicit[1,1][{0,2}]."

    predatorpreyimplicit::usage="predatorpreyimplicit[a,b,p,q,c][x,y]==0 is the implicit solution of the predator-prey system x'==x*(a - b*y),y'==y*(-p + q*x) centered at {p/q,a/b} with pseudoradius c."

    scimplicit::usage="scimplicit[x,y]==0 is the nonparametric form of the semicubical parabola t->{t^2,t^3}. To plot try scimplicit[{-1,1}]."

    semicubicimplicit::usage="semicubicimplicit[a,b,c,d][x,y]==0 is the nonparametric form of the curve y^2 = a*x^3 + b*x^2 + c*x + d. To plot try semicubicimplicit[1,0,-1,0][{-2,2}]."

    serpentineimplicit::usage="serpentineimplicit[a,b][x,y]==0 is the nonparametric form of the parametrized curve t->{t,a*t/(1 + b*t^2)}. To plot try serpentineimplicit[3,3][{-2,2,PlotPoints->150}]."

    strophoidimplicit::usage="strophoidimplicit[a][x,y]==0 is the nonparametric form of the parametrized curve t->{a*(t^2 - 1)/(t^2 + 1),a*t*(t^2 - 1)/(t^2 + 1)}. strophoidimplicit[m,a][x,y]==0 is the nonparametric form of the parametrized curve t->{a*(t^2 - m)/(t^2 + 1),a*t*(t^2 - m)/(t^2 + 1)}. To plot try strophoidimplicit[1,1][{-2,2}]."

    tridentimplicit::usage="tridentimplicit[a,b,c,d][x,y]==0 is the nonparametric form of the curve x*y==a*x^3 + b*x^2 + c*x + d. To plot try tridentimplicit[1,1,1,1][{-2.001,2}]."

    wattimplicit::usage="wattimplicit[a,b,c][x,y]==0 is the nonparametric form of Watt's curve."

(* Polar Defined Plane Curvses *)

    archimedesspiralpolar::usage="theta->archimedesspiralpolar[n,a][theta] is the polar form of a spiral of Archimedes of radius a and degree n. To plot try archimedesspiralpolar[1,1][-3Pi,3Pi]."

    bowpolar::usage="theta->bowpolar[a][theta] is the polar form of a parametrized curve whose shape is a bow. To plot try bowpolar[1][-Pi,Pi]."

    cardioidpolar::usage="theta->cardioidpolar[a][theta] is the polar form of a heart-shaped curve that is traced by a point on the circumference of a circle of radius 2*a rolling around a fixed circle of the same radius. To plot try cardioidpolar[1][0,2Pi]."

    cassinipolar::usage="theta->cassinipolar[a,b,pm1,pm2][theta] is the polar form of an oval of Cassini. The parameters pm1 and pm2 are plus or minus 1. The implicit equation is (x^2 + y^2 + a^2)^2 - b^4 - 4*a^2*x^2==0. To plot try cassinipolar[1,2,1,1][-Pi,Pi]."

    cochleoidpolar::usage="theta->cochleoidpolar[n,a][theta] is the polar form of a cochleoid of degree n. To plot try cochleoidpolar[2,1][-4Pi,4Pi]s."

    epispiralpolar::usage="theta->epispiralpolar[n,a][theta] is the polar form of a curve that has n branches if n is odd and 2*n branches if n is even. Each branch has two asymptotes radiating out from the center. To plot try epispiralpolar[4,1][0,2Pi]."

    fermatspiralpolar::usage="theta->fermatspiralpolar[a][theta] is the polar form of the spiral of Fermat of radius a, which may be positive or negative. To plot try fermatspiral[1/3,1][-4Pi,4Pi]."

    foliumpolar::usage="theta->foliumpolar[theta] is the polar form of a folium of Descartes. The nonparametric form is x^3 + y^3 - 3*x*y==0. theta->->foliumpolar[n,a,b,c][theta->] is the polar form of a generalized folium of Descartes. The nonparametric form is a*x^(2*n + 1) + b*y^(2*n + 1) - c*x^n*y^n==0. To plot try foliumpolar[2,1,1,1][-Pi,Pi]."

    hyperbolicspiralpolar::usage="theta->hyperbolicspiralpolar[a][theta] is the polar form of the hyperbolic spiral of radius a. It is a special case of a spiral of Archimedes. To plot try hyperbolicspiralpolar[1][0.03Pi,9Pi]."

    kampylepolar::usage="theta->kampylepolar[a][theta] is the polar form of the kampyle or crooked staff of Eudoxus. To plot try kampylepolar[1][-Pi,Pi]."

    keplerorbitpolar::usage="theta->keplerorbitpolar[a,e][theta] is the polar form of a Kepler orbit, where e is the eccentricity. The orbit is part of an ellipse (0<=e<1), parabola (e=1) or hyperbola (e>1). To plot try keplerorbitpolar[1,1.2][0,2Pi]."

    lemniscatepolar::usage="theta->lemniscatepolar[a][theta] is the polar form of the curve whose implicit equation is (x^2 + y^2)^2==a^2*(x^2 - y^2). The parameter a is positive or negative. To plot try lemniscatepolar[1][0,2Pi]."

    limaconpolar::usage="theta->limaconpolar[a,b][theta] is the polar form of the curve whose implicit equation is (x^2 + y^2 - 2*a*x)^2==b^2*(x^2 + y^2). theta->limaconpolar[n,a,b][theta_] is a generalization. To plot try limaconpolar[2,-1,1][0,2Pi]."

    lituuspolar::usage="theta->lituuspolar[a][theta] is the polar form of the lituus spiral of radius a, which may be positive or negative. To plot try lituuspolar[-1][0,12Pi]."

    logspiralpolar::usage="theta->logspiralpolar[a,b][theta] is the polar form of the log spiral of radius a and slant b. To plot try logspiralpolar[1,-0.04][0,12Pi]."

    nephroidpolar::usage="theta->nephroidpolar[a][theta] is the polar form of a kidney-shaped curve that is traced by a point on the circumference of a circle of radius a rolling around a fixed circle of radius 2*a. To plot try nephroidpolar[-1][0,Pi]."

    pacman::usage="theta->pacman[n][theta] is the polar form of a pacman-shaped curve of degree n. To plot try pacman[555][0,2Pi]."

    rosepolar::usage="theta->rosepolar[n,a][theta] is the polar form of a rose of radius a with n petals if n is odd and 2*n petals if n is even. To plot try rosepolar[3,-1][0,Pi]."

(* Parametrically Defined Space Curves *)

    ast3d::usage="t->ast3d[n,a,b][t] is a space curve analog of the plane curve astroid.  To plot try ast3d[3,1,1][0,2Pi]."

    baseballseam::usage="t->baseballseam[a,c][t] is an approximation to the seam on a baseball of radius a.  To plot try baseballseam[1,0.4][0,4Pi]."

    besselcurve::usage="t->besselcurve[a,b,c][t] is a space curve whose components are Bessel functions.  To plot try besselcurve[-1/2,1/2,3/2][1,30]."

    bicylinder::usage="t->bicylinder[a,b,pm][t] is a parametrization of the intersection of the circular cylinders x^2 + y^2 = a^2 and y^2 + z^2 = b^2. One component is obtained by taking pm = +1, the other by taking pm = -1.  To plot try bicylinder[1,1.01,1][0,2Pi]."

    biquadratic::usage="t->biquadratic[a,k][t] is a parametrization of the
intersection of the circular cylinder x^2 + y^2 = a^2 and the elliptic cylinder
x^2 + k^2*z^2 = a^2.  To plot try biquadratic[1,0.9][0,12]."

    clelia::usage="t->clelia[a][m,n][t] is a clelia of type (m,n) on a sphere of radius a. The number of petals is n.  To plot try clelia[1][7/8,5][0,Pi]."

    conicalhelix::usage="t->conicalhelix[a,b,c,d][t] is a parametrization of a helix on a cone over t->ellipse[a,b][t]. The slant of the cone is determined by c and the amount of twisting is determined by d.  To plot try conicalhelix[1,1,2,20][-2Pi,2Pi]."

    cubicalellipse::usage="t->cubicalellipse[a,b,c,d,e,f,pm][t] is a cubical ellipse for pm = 1 and a cubical hyperbola for pm = -1.  To plot try cubicalellipse[1,1,3,1,0,1/4,1][-2Pi,2Pi]."

    eightknot::usage="t->eightknot[t] is a parametrization of an eight knot.  To plot try eightknot[0,2Pi]."

    epitrochoid3d::usage="t->epitrochoid3d[a,b,h,omega][t] is the parametrized curve traced out by a point P attached to a circle of radius b rolling along a fixed circle of radius a. The rolling circle lies in a plane whose inclination with the plane of the fixed circle is omega, and h is the distance of P to the center of the rolling circle. The curve t->epitrochoid3d[a,b,h,0][t] is a (planar) epitrochoid and the curve epitrochoid3d[a,b,h,Pi][t] is a (planar) hypotrochoid.  To plot try epitrochoid3d[8,1,4,0.4Pi][0,2Pi]."

    genhelix::usage="t->genhelix[a,b][f][t] is a generalized elliptical helix with slant function f. To plot try genhelix[1,1][3#^0.3&][0,9Pi]."

    helix::usage="t->helix[a,b][t] is a circular helix of radius a and slant b. t->helix[a,b,c][t] is an elliptical helix of slant c.  To plot try helix[1,3,0.5][0,4Pi]."

    helixunitspeed::usage="s->helixunitspeed[a,b][s] is a unit-speed parametrization of a circular helix of radius a and slant b."

    horopter::usage="t->horopter[a,b][t] is a horopter. It is the intersection of the hyperbolic paraboloid y==b*x*z and the cylinder over the curve y^2==x*(2*a - x).  To plot try horopter[1,1][-2,2]."

    line3d::usage="t->line3d[a1,b1,c1,a2,b2,c2][t] is a parametrized line in R^3 with line3d[a1,b1,c1,a2,b2,c2][0]={a2,b2,c2} and line3d[a1,b1,c1,a2,b2,c2]'[0]={a1,b1,c1}."

    lissajous3d::usage="t->lissajous3d[n,d,a,b,c][t] is a space curve analog of Lissajous curve.  To plot try lissajous3d[3/4,0,9,8,4][0,8Pi]."

    oneparametersubgroup::usage="t->oneparametersubgroup[mat,vec][t] is the
curve in R^n formed by the one parameter subgroup t->exp(t*mat) acting on a vector v in R^n, where mat is an n by n matrix To plot try oneparametersubgroup[{{0,1,0},{-1,0,0},{1,0,1}},{1,-1,-1/10}][-3Pi,5Pi/4]."

    pseudospheregeodesic::usage="t->pseudospheregeodesic[a,c,u0,pm][t] is a geodesic of slant c on a pseudosphere of constant negative curvature -1/a^2. The parameter pm is plus or minus 1.  To plot try pseudospheregeodesic[1,0.25,Pi,1][0.5Pi,0.919569Pi]."

    pseudosphericalloxodrome::usage="t->pseudosphericalloxodrome[a,b][t] is a loxodrome on a pseudosphere of constant negative curvature -1/a^2.  To plot try pseudosphericalloxodrome[1,4][-2.8,2.8]."

    seiffertspiral::usage="t->seiffertspiral[a,k][t] is Seiffert's spiral of slant k on an sphere of radius a.  To plot try seiffertspiral[1.0,0.9][-3Pi,5Pi/4]."

    sphericalcardioid::usage="t->sphericalcardioid[a][t] is a spherical curve on a sphere of radius 3|a|. It is a curve of constant slope that projects to t->cardioid[-a][t + Pi].  To plot try sphericalcardioid[1/3][0,4Pi]."

    sphericalellipse::usage="t->sphericalellipse[a,b,c,pm][t]
is a parametrization of the intersection of the sphere x^2 + y^2 + z^2= a^2 and the elliptical cylinder x^2/b^2 + y^2/c^2 = 1. One component is obtained by taking pm = +1, the other by taking pm = -1.  To plot try sphericalellipse[1,0.8,0.1,1][-3,3]."

    sphericalhelix::usage="t->sphericalhelix[a,b][t] is a spherical helix on a sphere of radius |a + 2*b|. It is a curve of constant slope that projects to t->epicycloid[a,b][t].  To plot try sphericalhelix[3/5,1/5][0,6Pi]."

    sphericalloxodrome::usage="t->sphericalloxodrome[a,b,c][t] is a loxodrome on a sphere of radius a. It is the image under the stereographic injection {u,v}->stereographicsphere[a][u,v] of the logarithmic spiral t->logspiral[b,c][t]. A sphericalloxodrome meets each meridian of the sphere at the same angle.  To plot try sphericalloxodrome[1,1,0.2][-20,20]."

   sphericalloxodromeunitspeed::usage="s->sphericalloxodromeunitspeed[a,b,c][s] is a unit-speed parametrization of a loxodrome on a sphere of radius a."

    sphericalnephroid::usage="t->sphericalnephroid[a][t] is a spherical helix on a sphere of radius 4|a|. It is a curve of constant slope that projects to t->nephroid[a][t].  To plot try sphericalnephroid[1][0,2Pi]."

    sphericalspiral::usage="t->sphericalspiral[a][m,n][t] is a spherical spiral of type (m,n) on a sphere of radius a.  To plot try sphericalspiral[1][24,1][-Pi/2,Pi/2,PlotPoints->800]."

    tennisballseam::usage="t->tennisballseam[n,a,b,c][t] is a curve on the unit sphere in R^3.  It is the normal to t->wigglyellipse[n,a,b,c][t]. For those values of n, a, b and c for which the curve has no self-intersections, the curve (parametrized on 0<=t<=2*Pi) is the boundary of subsets of the unit sphere of equal area.  To plot try tennisballseam[3,1,1,0.1][0,2Pi]."

    torusknot::usage="t->torusknot[a,b,c][p,q][t] is a torus knot of type (p,q) on an elliptical torus of type (a,b,c).  To plot try torusknot[8,3,5][2,5][0,3Pi]."

    twicubic::usage="t->twicubic[t] is the twisted cubic t->{t,t^2,t^3}.  To plot try twicubic[0,1]."

    veryflat::usage="t->veryflat[1][t] is the curve t->{t,0,5*E^(-1/t^2)}.
t->veryflat[2][t] is the curve t->If[t<0,{t,5*E^(-1/t^2),0},
If[t==0,{0,0,0},{t,0,5*E^(-1/t^2)}]]. These curves both have curvature and torsion zero, but are not congruent by a Euclidean motion.  To plot try veryflat[1][-1,1]."

    viviani::usage="t->viviani[a][t] is a Viviani curve on a sphere of radius 2*a. It is the intersection of the cylinder (x - a)^2 + y^2==a^2 and the sphere x^2 + y^2 + z^2==4*a^2.  To plot try viviani[1][-2Pi,2Pi]."

    wigglyellipse::usage="t->wigglyellipse[n,a,b,c][t] is an ellipse perturbed vertically by a sin curve. The normal to t->wigglyellipse[n,a,b,c][t] divides the unit sphere into two regions of equal area.  To plot try wigglyellipse[3,1,1,0.1][0,2Pi]."


(* Parametrically Defined Curves in R^n*)

    besseln::usage="t->besseln[n,a][t] is the curve t->a*{BesselJ[0,t],...,BesselJ[n - 1,t]}."

    bernstein::usage="t->bernstein[p,q[t]] is the (p,q)-th Bernstein polynomial."

    beziercurve::usage="t->beziercurve[pts][t] is the Bezier curve in R^n determined by pts, where pts is a list of points in R^n."

    cosn::usage="t->cosn[n,a][t] is the curve t->a*{Cos[t],Cos[2*t],...,Cos[n*t]}."

    beziercurve::usage="t->beziercurve[pts][t] is the Bezier curve in R^n determined by pts, where pts is a list of points in R^n."

    lagrangecurve::usage="t->hermitecurve[p0,m0,m1,p1][t] is the Hermite curve in R^n determined by p0 and p1 with directions m0 and m1."

    sinn::usage="t->sinn[n,a][t] is the curve t->a*{Sin[t],Sin[2*t],...,Sin[n*t]}."

    twistedn::usage="t->twistedn[n,a][t] is the curve t->a*{t,t^2,...,t^n}."

(* Approximations *)

   regularpolygon::usage="regularpolygon[n,a] is a regular polygon with n vertices circumscribed by a circle of radius a."

   teeth::usage="teeth[m,t][shortlines] is the mth iterate of tooth of height t."

   tooth::usage="tooth[t][Line[{{a,b},{c,d}}]] constructs from the line Line[{{a,b},{c,d}}] a broken line with a tooth of height t in the middle."

   kochsnowflake::usage="kochsnowflake[m] is a Koch snow flake constructed as the mth iterate of an equilateral triangle using a tooth of height (3 + Sqrt[3])/6."

Begin["`Private`"]

(* Parametrically Defined Plane Curves *)

    agnesi[a_][t_]:= {2*a*Tan[t],2*a*Cos[t]^2}

    agnesi[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[agnesi[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    airyspiral[a_][t_]:={a*AiryAi[t],a*AiryBi[t]}

    airyspiral[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[airyspiral[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    alysoid[a_,b_,c_][s_]:=
        Integrate[alysoidprime[a,b,c][ss],{ss,0,s}] + {a,0}

    alysoid/: Derivative[m_?IntegerQ][alysoid[a_,b_,c_]] = 
        Derivative[m - 1][alysoidprime[a,b,c]]

    alysoid[a_,b_,c_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[alysoidnds[smin,smax][a,b,c][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]

    alysoidkappa2[a_,b_,c_][s_]:= -c/(a*b + s^2)

(*
    alysoidnds[smin_,smax_][a_,b_,c_][s_]:=
         Module[{x,y,tmp,ss},
             tmp=NDSolve[{x'[ss]==alysoidprime[a,b,c][ss][[1]],
               y'[ss]==alysoidprime[a,b,c][ss][[2]],
               x[0]==a,y[0]==0},{x,y},{ss,smin,smax},
               MaxSteps->2000];
               First[{x[s],y[s]} /. tmp]]
*)

    alysoidnds[smin_,smax_][a_,b_,c_][s_]:=
      intrinsic[alysoidkappa2[a,b,c],0,{a,0,Pi/2},
      MaxSteps->2000,{smin,smax}][s]

    alysoidprime[a_,b_,c_][t_]:=
        {Sin[(c/Sqrt[a*b])*ArcTan[t/Sqrt[a*b]]],
         Cos[(c/Sqrt[a*b])*ArcTan[t/Sqrt[a*b]]]}

    archimedesspiral[n_,a_][t_]:=
        {a*t^(1/n)*Cos[t],a*t^(1/n)*Sin[t]}

    archimedesspiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[archimedesspiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    astroid[a_][t_]:= {a*Cos[t]^3,a*Sin[t]^3}              

    astroid[a_,b_][t_]:= {a*Cos[t]^3,b*Sin[t]^3}

    astroid[n_,a_,b_][t_]:= {a*Cos[t]^n,b*Sin[t]^n}

    astroid[n_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[astroid[n,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    bellcurve[mean_,variance_][t_]:= {t,
        (1/Sqrt[2*Pi*variance^2])*E^(-(t - mean)^2/(2*variance^2))}

    bellcurve[mean_,variance_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[bellcurve[mean,variance][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->GoldenRatio]

    bicorn[a_][t_]:= {a*Sin[t],a*Cos[t]^2(2 + Cos[t])/(3 + Sin[t]^2)}

    bicorn[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[bicorn[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    bow[a_][t_]:= {a*(1 - Tan[t]^2)Cos[t],a*(1 - Tan[t]^2)Sin[t]}

    bow[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[bow[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    bowtie[a_,b_][t_]:= {a*(1 + Cos[t]^2)*Sin[t],
                          (b + Sin[t]^2)*Cos[t]}
  
    bowtie[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[bowtie[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    bulletnose[a_,b_][t_]:= {a*Cos[t],b*Cot[t]}
    
    bulletnose[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[bulletnose[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->{Automatic,{-5,5}}]

    cardioid[a_][t_]:= {2*a*Cos[t]*(1 + Cos[t]),
                        2*a*Sin[t]*(1 + Cos[t])} 
    
    cardioid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cardioid[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cardioidunitspeed[a_][s_]:=
        {2*a*Cos[2*ArcSin[s/(8*a)]]*(1 + Cos[2*ArcSin[s/(8*a)]]),
         2*a*(1 + Cos[2*ArcSin[s/(8*a)]])*Sin[2*ArcSin[s/(8*a)]]}

   cartesianoval[a_,b_][u_,v_]:=
      {a*Re[WeierstrassP[u + I*v,b,0]],
       a*Im[WeierstrassP[u + I*v,b,0]]}

    cassini[a_,b_,pm1_,pm2_][t_]:= 
      {pm1*Sqrt[a^2*Cos[2*t] +
           pm2*Sqrt[b^4 - a^4*Sin[2*t]^2]]*Cos[t],
       pm1*Sqrt[a^2*Cos[2*t] +
           pm2*Sqrt[b^4 - a^4*Sin[2*t]^2]]*Sin[t]}

    cassini[a_,b_,pm1_,pm2_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cassini[a,b,pm1,pm2][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    catenary[a_][t_]:= {a*Cosh[t/a],t} 

    catenary[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[catenary[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    catenaryunitspeed[a_][s_]:=
        {a*Sqrt[1 + s^2/a^2],a*ArcSinh[s/a]}

    cayleysextic[a_][t_]:=
          {4*a*Cos[t/2]^4*(-1 + 2*Cos[t]),
           4*a*Cos[t/2]^3*Sin[3*t/2]}

    cayleysextic[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cayleysextic[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    circle[a_][t_]:= {a*Cos[t],a*Sin[t]}

    circle[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[circle[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    circleunitspeed[a_][s_]:= {a*Cos[s/a],a*Sin[s/a]}

    circleinvolute[n_,a_][t_]:= Module[{tmp1,tmp2},
         tmp1=E^(I*tt)Normal[Series[E^(-I*tt),{tt,0,n}]];
         tmp2=a*ComplexExpand[{Re[tmp1],Im[tmp1]}];
         tmp2 /. tt->t]

    circleinvolute[a_][t_]:= circleinvolute[1,a][t]

    circleinvolute[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[circleinvolute[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    circleinvoluteunitspeed[n_,a_][s_]:=
         circleinvolute[n,a][((n + 1)!*s/a)^(1/(n +1))]

    circleinvoluteunitspeed[a_][s_]:=
         circleinvoluteunitspeed[1,a][s]

    cissoid[a_][t_]:= {2*a*t^2/(1 + t^2),2*a*t^3/(1 + t^2)}

    cissoid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cissoid[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->{{-0.2,1},Automatic}]

    clothoid[n_,a_][s_]:=
         Integrate[clothoidprime[n,a][ss],{ss,0,s}]

    clothoid/: Derivative[m_?IntegerQ][clothoid[n_,a_]] = 
        Derivative[m - 1][clothoidprime[n,a]]

    clothoid[a_][s_]:=
         {a*Sqrt[Pi]*FresnelS[s/Sqrt[Pi]],
          a*Sqrt[Pi]*FresnelC[s/Sqrt[Pi]]}

    clothoid[n_,a_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[clothoidnds[smin,smax][n,a][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]


    clothoidnds[smin_,smax_][n_,a_][s_]:=
         Module[{x,y,tmp,ss},
             tmp=NDSolve[{x'[ss]==clothoidprime[n,a][ss][[1]],
               y'[ss]==clothoidprime[n,a][ss][[2]],
               x[0]==0,y[0]==0},{x,y},{ss,smin,smax},
               MaxSteps->2000];
               First[{x[s],y[s]} /. tmp]]

    clothoidprime[n_,a_][t_]:=
         {a*Sin[t^(n + 1)/(n + 1)],a*Cos[t^(n + 1)/(n + 1)]}
       
    cnccoprofile[pm_,a_,b_][s_]:=
        {pm*b*Sinh[s/a],-I*Sqrt[a^2 - b^2]*EllipticE[I*s/a,
                       -b^2/(a^2 - b^2)]}

    cnccoprofile[pm_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cnccoprofile[pm,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cnchyprofile[pm_,a_,b_][s_]:=
        {pm*b*Cosh[s/a],-I*a*EllipticE[I*s/a,-b^2/a^2]}

    cnchyprofile[pm_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cnchyprofile[pm,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cochleoid[n_,a_][t_]:=
       {a*(Sin[t]/t)^n*Cos[t],a*(Sin[t]/t)^n*Sin[t]}

    cochleoid[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cochleoid[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->All]

    conchoid[a_,b_][t_]:= {b + a*Cos[t],b*Tan[t] + a*Sin[t]}

    conchoid[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[conchoid[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    coshspiral[n_,a_][t_]:=
            {a*Cos[t]/Cosh[n*t],a*Sin[t]/Cosh[n*t]}

    coshspiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[coshspiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cothspiral[a_][t_]:= {-Sinh[2*t]/(Cos[2*a*t] - Cosh[2*t]),
                            Sin[2*a*t]/(Cos[2*a*t] - Cosh[2*t])}

    cothspiral[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cothspiral[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->{Automatic,{-4,4}}]

    cpcprofile[pm_,a_,b_][s_]:=
       {pm*b*Cos[s/a],a*EllipticE[s/a,b^2/a^2]}

    cpcprofile[pm_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cpcprofile[pm,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    crosscurve[a_,b_][t_]:= {a*Sec[t],b*Csc[t]}
    
    crosscurve[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[crosscurve[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cubicparabola[a_,b_,c_,d_][t_]:= {t,a*t^3 + b*t^2 + c*t + d}

    cubicparabola[a_,b_,c_,d_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cubicparabola[a,b,c,d][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cycloid[a_,b_][t_]:= {a*t - b*Sin[t],a - b*Cos[t]}

    cycloid[a_][t_]:= {a*t - a*Sin[t],a - a*Cos[t]}

    cycloid[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[cycloid[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    cycloidunitspeed[a_,a_][s_]:=
         {4*a*ArcSin[Sqrt[s/(8*a)]] - (4*a - s)*Sqrt[(s/a)*(8 - s/a)]/8,
          s - s^2/(8*a)}

    delaunay[a_,e_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[delaunaynds[smin,smax][a,e][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]

    delaunaykappa2[a_,e_][s_]:=
         e*(e - Cos[s/a])/(a*(1 - 2*e*Cos[s/a] + e^2))

    delaunaynds[smin_,smax_][a_,e_][s_]:=
      intrinsic[delaunaykappa2[a,e],0,{0,0,0},
      MaxSteps->2000,{smin,smax}][s]

    deltoid[a_][t_]:= {2*a*Cos[t]*(1 + Cos[t]) - a,
                       2*a*Sin[t]*(1 - Cos[t])}

    deltoid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[deltoid[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    deltoidbis[a_][t_]:=
        {a*(2*Cos[t] - Sin[2*t]),a*(2*Sin[t] - Cos[2*t])}

    deltoidbis[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[deltoidbis[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    deltoidinvolute[a_][t_]:=
        {(a/3)*(8*Cos[t/2] + 2*Cos[t] - Cos[2*t]),
         (a/3)*(-8*Sin[t/2] + 2*Sin[t] + Sin[2*t])}

    deltoidinvolute[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[deltoidinvolute[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    deltoidunitspeed[a_][s_]:=
        {a*(2*Cos[2*ArcCot[3*s/Sqrt[64*a^2 - 9*s^2]]/3] + 
         Cos[4*ArcCot[3*s/Sqrt[64*a^2 - 9*s^2]]/3]),
         -8*a*Cos[ArcCot[3*s/Sqrt[64*a^2 - 9*s^2]]/3]*
         Sin[ArcCot[3*s/Sqrt[64*a^2 - 9*s^2]]/3]^3}

    diamond[a_][t_]:=
        {a*Cos[t]*Sqrt[Cos[t]^2],a*Sin[t]*Sqrt[Sin[t]^2]}

    diamond[n_,a_,b_][t_]:=
        {a*Sqrt[Cos[t]^2]^(n - 1)*Cos[t],
         b*Sqrt[Sin[t]^2]^(n - 1)*Sin[t]}

    diamond[n_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[diamond[n,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    eight[t_]:= {Sin[t],Sin[t]*Cos[t]}

    eight[tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[eight[t]],{t,tmin,tmax},opt,
            Axes->None,PlotPoints->150]

    elasticainflect[a_,k_][s_]:= 
       {(2/a)*EllipticE[JacobiAmplitude[a*s,k^2],k^2] - s,
          -(2*k/a)*(JacobiCN[a*s,k^2] - 1)}

    elasticainflect/: Derivative[m_?IntegerQ][elasticainflect[a_,k_]] = 
        Derivative[m - 1][{-1 + 2*JacobiDN[a*#,k^2]^2, 
                  2*k*JacobiDN[a*#,k^2]*JacobiSN[a*#,k^2]}&]

    elasticainflectnds[smin_,smax_][a_,k_][s_]:=
         intrinsic[2*a*k*JacobiCN[a*#,k^2]&,0,{0,0,0},
         MaxSteps->2000,{smin,smax}][s]

    elasticainflect[a_,k_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[elasticainflectnds[smin,smax][a,k][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]

    elasticanoninflect[a_,k_][s_]:= 
        {(2/(k*a))*EllipticE[JacobiAmplitude[a*s/k,k^2],k^2] +
              (1 - 2/k^2)*s,
          -(2/(k*a))*(JacobiDN[a*s/k,k^2] - 1)}

    elasticanoninflect/: Derivative[m_?IntegerQ][elasticanoninflect[a_,k_]] = 
        Derivative[m - 1][{1 - 2*JacobiSN[a*#/k,k^2]^2, 
              2*JacobiCN[a*#/k,k^2]*JacobiSN[a*#/k,k^2]}&]

    elasticanoninflectnds[smin_,smax_][a_,k_][s_]:=
         intrinsic[(2*a*JacobiDN[a*#/k, k^2])/k&,0,{0,0,0},
         MaxSteps->2000,{smin,smax}][s]

    elasticanoninflect[a_,k_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[elasticanoninflectnds[smin,smax][a,k][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]

    ellipse[a_,b_][t_]:= {a*Cos[t],b*Sin[t]}

    ellipse[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[ellipse[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    ellipsebis[a_,b_][t_]:= {a*Sech[t],b*Tanh[t]}

    ellipsebis[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[ellipsebis[a,b][t]],
        {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    ellipseinc[a_,b_,c_,psi_][t_]:=
        Module[{k},k=1 - b^2/a^2;
           {a*JacobiSN[t,k] + (c/a)(a*Cos[psi]*JacobiCN[t,k] +
                     b*Sin[psi]*JacobiSN[t,k])/JacobiDN[t,k],
            b*JacobiCN[t,k] + (c/a)(a*Sin[psi]*JacobiCN[t,k] -
                   b*Cos[psi]*JacobiSN[t,k])/JacobiDN[t,k]}]

    ellipseinc[a_,b_,c_,psi_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[ellipseinc[a,b,c,psi][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    epicycloid[a_,b_][t_]:=
            {(a + b)*Cos[t] - b*Cos[((a + b)/b)*t],
             (a + b)*Sin[t] - b*Sin[((a + b)/b)*t]}

    epicycloid[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[epicycloid[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    epicycloidunitspeed[a_,b_][s_]:=
    {(a + b)*Cos[4*b*ArcSin[Sqrt[a*s/(b*(8*a + 8*b))]]/a] - 
      b*Cos[4*(a + b)*ArcSin[Sqrt[a*s/(b*(8*a + 8*b))]]/a],
     (a + b)*Sin[4*b*ArcSin[Sqrt[a*s/(b*(8*a + 8*b))]]/a] -
      b*Sin[4*(a + b)*ArcSin[Sqrt[a*s/(b*(8*a + 8*b))]]/a]}

    epispiral[n_,a_][t_]:= {a*Cos[t]/Sin[n*t],a*Sin[t]/Sin[n*t]}

    epispiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[epispiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    epitrochoid[a_,b_,h_][t_]:=
            {(a + b)*Cos[t] - h*Cos[((a + b)/b)*t],
             (a + b)*Sin[t] - h*Sin[((a + b)/b)*t]}

    epitrochoid[a_,b_,h_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[epitrochoid[a,b,h][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    fermatspiral[a_][t_]:= {a*Sqrt[t]*Cos[t],a*Sqrt[t]*Sin[t]}

    fermatspiral[n_,a_][t_]:= {a*t/(t^2)^n*Cos[Sqrt[t^2]],
                               a*t/(t^2)^n*Sin[Sqrt[t^2]]}

    fermatspiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[fermatspiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    folium[t_]:= {3*t/(1 + t^3),3*t^2/(1 + t^3)}

    folium[n_,a_,b_,c_][t_]:= {c*t^n/(a + b*t^(2*n + 1)),
                           c*t^(n + 1)/(a + b*t^(2*n + 1))}
(*
    folium[tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[folium[t]],{t,tmin,tmax},opt,
            Axes->None,AspectRatio->Automatic]
*)
    genparabola[n_][t_]:= {t,t^n}

    genparabola[n_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[genparabola[n][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->1]

    hankelspiral[n_,a_][t_]:= {a*BesselJ[n,t],a*BesselY[n,t]}

    hankelspiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hankelspiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hippopede[a_,b_][t_]:=
              {2*Cos[t]*Sqrt[a*b - b^2*Sin[t]^2],
               2*Sin[t]*Sqrt[a*b - b^2*Sin[t]^2]}

    hippopede[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hippopede[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hyperbola[a_,b_][t_]:= {a*Cosh[t],b*Sinh[t]}

    hyperbola[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hyperbola[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hyperbolabis[a_,b_][t_]:= {a*Sec[t],b*Tan[t]}

    hyperbolabis[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hyperbolabis[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hyperbolicspiral[a_][t_]:= {a*Cos[t]/t,a*Sin[t]/t}

    hyperbolicspiral[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hyperbolicspiral[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hypocycloid[a_,b_][t_]:=
            {(a - b)*Cos[t] + b*Cos[((a - b)/b)*t],
             (a - b)*Sin[t] - b*Sin[((a - b)/b)*t]}
    
    hypocycloid[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hypocycloid[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hypocycloidinvolute[a_,b_][t_]:=
        {(a^2*Cos[t] - 3*a*b*Cos[t] + 2*b^2*Cos[t] - 
          a*b*Cos[t - a*t/b] + 2*b^2*Cos[t - a*t/b] + 
          4*a*b*Cos[t - a*t/(2*b)] - 
          4*b^2*Cos[t - a*t/(2*b)])/a,
         (a^2*Sin[t] - 3*a*b*Sin[t] + 2*b^2*Sin[t] - 
          a*b*Sin[t - a*t/b] + 2*b^2*Sin[t - a*t/b] + 
          4*a*b*Sin[t - a*t/(2*b)] - 
          4*b^2*Sin[t - a*t/(2*b)])/a}

    hypocycloidinvolute[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hypocycloidinvolute[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    hypocycloidunitspeed[a_,b_][s_]:=
    {(a - b)*Cos[4*b*ArcSin[Sqrt[a*s/((8*a - 8*b)*b)]]/a] +
      b*Cos[4*(a - b)*ArcSin[Sqrt[a*s/((8*a - 8*b)*b)]]/a],
     (a - b)*Sin[4*b*ArcSin[Sqrt[a*s/((8*a - 8*b)*b)]]/a]
      -b*Sin[4*(a - b)*ArcSin[Sqrt[a*s/((8*a - 8*b)*b)]]/a]}

    hypotrochoid[a_,b_,h_][t_]:=
            {(a - b)*Cos[t] + h*Cos[((a - b)/b)*t],
             (a - b)*Sin[t] - h*Sin[((a - b)/b)*t]}

    hypotrochoid[a_,b_,h_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[hypotrochoid[a,b,h][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    kampyle[a_][t_]:= {a*Sec[t],a*Sin[t]*Sec[t]^2}

    kampyle[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[kampyle[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    kappacurve[a_][t_]:= {a*Cos[t]^2/Sin[t],a*Cos[t]}

    kappacurve[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[kappacurve[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    keplerorbit[a_,e_][t_]:= {a*Cos[t]/(1 - e*Cos[t]),
                              a*Sin[t]/(1 - e*Cos[t])}

    keplerorbit[a_,e_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[keplerorbit[a,e][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    lehr[a_,b_,c_][smin_,smax_,opt___]:=
        ParametricPlot[Evaluate[lehrnds[smin,smax][a,b,c][s]],
            {s,smin,smax},opt,Axes->None,AspectRatio->Automatic,
             PlotStyle->{{RGBColor[1,0,0],AbsoluteThickness[2]}},
             PlotPoints->300]

    lehr/: Derivative[m_?IntegerQ][lehr[a_,b_,c_]] = 
        Derivative[m - 1][{Cos[a*# + (b/c)*Sin[c*#]],
        Sin[a*# + (b/c)*Sin[c*#]]}&]

    lehrkappa2[a_,b_,c_][s_]:= a + b*Cos[c*s]
    
    lehrnds[smin_,smax_][a_,b_,c_][s_]:=
         intrinsic[lehrkappa2[a,b,c],0,{0,0,0},
         MaxSteps->2000,{smin,smax}][s]

    lemniscate[a_][t_]:=
         {a*Cos[t]/(1 + Sin[t]^2),
          a*Sin[t]*Cos[t]/(1 + Sin[t]^2)}

    lemniscate[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[lemniscate[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    lemniscatebis[a_][theta__]:=
         {a*Sqrt[Cos[2*theta]]*Cos[theta],
          a*Sqrt[Cos[2*theta]]*Sin[theta]}

    lemniscatebis[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[lemniscatebis[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    lemniscateunitspeed[a_][s_]:=
         {a*JacobiCN[s/a,-1]/JacobiDN[s/a,-1]^2,
          a*JacobiCN[s/a,-1]JacobiSN[s/a,-1]/JacobiDN[s/a,-1]^2}

    limacon[a_,b_][t_]:= {(2*a*Cos[t] + b)*Cos[t],
                          (2*a*Cos[t] + b)*Sin[t]}

    limacon[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[limacon[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    line[a1_,b1_,a2_,b2_][t_]:= {a1*t + a2,b1*t + b2}

    lissajous[n_,d_,a_,b_][t_]:= {a*Sin[n*t + d],b*Sin[t]}

    lissajous[n_,d_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[lissajous[n,d,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    lituus[a_][t_]:= {a*t/(t^2)^(3/4)*Cos[Sqrt[t^2]],
                      a*t/(t^2)^(3/4)*Sin[Sqrt[t^2]]}

    lituus[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[lituus[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    logistic[k_,a_,b_][t_]:= {t,k/(1 + E^(a + b*t))}

    logistic[k_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[logistic[k,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    logspiral[b_][t_]:= {E^(b*t)*Cos[t],E^(b*t)*Sin[t]}

    logspiral[a_,b_][t_]:= {a*E^(b*t)*Cos[t],a*E^(b*t)*Sin[t]}

    logspiral[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[logspiral[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    logspiralunitspeed[a_,b_][s_]:= 
         {b*s*Cos[Log[b*s/(a*Sqrt[1 + b^2])]/b]/Sqrt[1 + b^2],
          b*s*Sin[Log[b*s/(a*Sqrt[1 + b^2])]/b]/Sqrt[1 + b^2]}

    nephroid[a_][t_]:= {a*(3*Cos[t] - Cos[3*t]),
                        a*(3*Sin[t] - Sin[3*t])}

    nephroid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[nephroid[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    nephroidunitspeed[a_][s_]:=
      {s/2 - a*Cos[3*ArcCos[s/(6*a)]],
       a*(3*Sqrt[1 - s^2/(36*a^2)] - Sin[3*ArcCos[s/(6*a)]])}

    ngon[n_,a_][t_]:=
        Which@@Flatten[Table[{(k - 1)/n<=t<=k/n,
        a*{Cos[2*Pi*t],Sin[2*Pi*t]}/Cos[2*Pi*t - (2*k - 1)*Pi/n]},
        {k,1,n}],1]

    ngon[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[ngon[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    nielsenspiral[a_][t_]:= {a*CosIntegral[t],a*SinIntegral[t]}

    nielsenspiral[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[nielsenspiral[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->All]

    parabola[a_][t_]:= {2*a*t,a*t^2}

    parabola[a_,b_][t_]:= {2*b*t,a*t^2}

    parabola[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[parabola[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    parabolicspiral[n_,a_,b_][t_]:=
        {(a*t/(t^2)^n + b)*Cos[Sqrt[t^2]],
        (a*t/(t^2)^n + b)*Sin[Sqrt[t^2]]}

    parabolicspiral[n_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[parabolicspiral[n,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    piriform[a_,b_][t_]:=
           {a*(1 + Sin[t]),b*Cos[t]*(1 + Sin[t])}

    piriform[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[piriform[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    pseudocatenary[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[pseudocatenarynds[tmin,tmax][a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    pseudocatenary[a_,b_][s_]:= alysoid[a,b,a][s]

    pseudocatenary/: Derivative[m_?IntegerQ][pseudocatenary[a_,b_]] = 
        Derivative[m - 1][pseudocatenaryprime[a,b]]

    pseudocatenarykappa2[a_,b_][s_]:= -a/(a*b + s^2)

    pseudocatenarynds[smin_,smax_][a_,b_][s_]:=
         alysoidnds[smin,smax][a,b,a][s]

    pseudocatenaryprime[a_,b_][t_]:= alysoidprime[a,b,a][t]

    rectangle[n_,a_,b_][t_]:=
            {a*(Cos[t]*Sqrt[Cos[t]^2]^(n - 1) +
                Sin[t]*Sqrt[Sin[t]^2]^(n - 1)),
             b*(-Cos[t]*Sqrt[Cos[t]^2]^(n - 1) +
                Sin[t]*Sqrt[Sin[t]^2]^(n - 1))}

    rectangle[n_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[rectangle[n,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    reuleauxpolygon[n_,a_][t_]:= Which@@Flatten[
        Table[{k/(2*n + 1)<=t<=(k + 1)/(2*n + 1),
            a*{Re[E^(2*Pi*I*k/(2*n + 1)) +
               2*I*Sin[Pi*n/(2*n + 1)]*
               E^(Pi*I*((k + n)/(2*n + 1) + t))],
               Im[E^(2*Pi*I*k/(2*n + 1)) +
               2*I*Sin[Pi*n/(2*n + 1)]*
               E^(Pi*I*((k + n)/(2*n + 1) + t))]}},
              {k,0,2*n}],1]

    reuleauxpolygon[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[reuleauxpolygon[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    rose[n_,a_][t_]:= {a*Cos[n*t]*Cos[t],a*Cos[n*t]*Sin[t]}

    rose[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[rose[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    sc[t_]:= {t^2,t^3}

    sc[tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[sc[t]],{t,tmin,tmax},opt,
            Axes->None,AspectRatio->Automatic]

    scunitspeed[s_]:= {(s + 8/27)^(2/3) - 4/9,
                      ((s + 8/27)^(2/3) - 4/9)^(3/2)}

    scarab[a_,b_][t_]:= {(a*Cos[2*t] - b*Cos[t])*Cos[t],
                         (a*Cos[2*t] - b*Cos[t])*Sin[t]}

    scarab[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[scarab[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    semicubic[a_,b_,c_,d_][z_]:=
    {WeierstrassP[z,{b^2/12 - a*c/4,-b^3/216 + a*b*c/48 - a^2*d/16}],
     WeierstrassPPrime[z,{b^2/12 - a*c/4,-b^3/216 + a*b*c/48 - a^2*d/16}]}

    semicubic[a_,b_,c_,d_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[semicubic[a,b,c,d][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    serpentine[a_,b_][t_]:= {t,a*t/(1 + b*t^2)}

    serpentine[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[serpentine[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    sinhspiral[n_,a_][t_]:=
            {a*Cos[t]/Sinh[n*t],a*Sin[t]/Sinh[n*t]}

    sinhspiral[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[sinhspiral[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->{{-1,1},Automatic}]

    sinoval[n_,a_][t_]:= {a*Cos[t],a*Nest[Sin,t,n]}

    sinoval[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[sinoval[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    spring[a_,b_,v_][t_]:=
        {a*Cos[t],a*Cos[v]*Sin[t] + b*t*Sin[v]}

    spring[a_,b_,v_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[spring[a,b,v][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    strophoid[a_][t_]:= {a*(t^2 - 1)/(t^2 + 1),
                         t*a*(t^2 - 1)/(t^2 + 1)}

    strophoid[m_,a_][t_]:= {a*(t^2 - m)/(t^2 + 1),
                            t*a*(t^2 - m)/(t^2 + 1)}

    strophoid[m_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[strophoid[m,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    talbot[a_,b_,f_][t_]:= {(a^2 + f^2*Sin[t]^2)*Cos[t]/a,
                            (a^2 - 2*f^2 + f^2*Sin[t]^2)*Sin[t]/b}

    talbot[a_,b_,f_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[talbot[a,b,f][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tanhspiral[a_][t_]:= {Sinh[2*t]/(Cos[2*a*t] + Cosh[2*t]),
                          Sin[2*a*t]/(Cos[2*a*t] + Cosh[2*t])}

    tanhspiral[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[tanhspiral[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    teardrop[a_,b_,c_,d_,n_][t_]:=
          {a*Sin[t],d*(b*Sin[t] + c*Sin[2*t])^n}

    teardrop[a_,b_,c_,d_,n_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[teardrop[a,b,c,d,n][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tractrix[a_][t_]:= {a*Sin[t],a*(Cos[t] + Log[Tan[t/2]])}

    tractrix[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[tractrix[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tractrix[a_,b_][t_]:= {a*Sin[t],b*(Cos[t] + Log[Tan[t/2]])}

    tractrixminus[a_][t_]:= {t,Sqrt[a^2 - t^2] - a*Log[2/(a*t) +
         2*Sqrt[a^2 - t^2]/(a^2*t)] + a*Log[2/t^2]}

    tractrixminus[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[tractrixminus[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tractrixplus[a_][t_]:= {t,-Sqrt[a^2 - t^2] + a*Log[2/(a*t) +
         2*Sqrt[a^2 - t^2]/(a^2*t)] - a*Log[2/t^2]}

    tractrixplus[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[tractrixplus[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tractrixunitspeed[a_][s_]:= {a*E^(-Sqrt[s^2]/a),
        a*ArcTanh[Sqrt[1 - E^(-2*Sqrt[s^2]/a)]] -
        a*Sqrt[1 - E^(-2*Sqrt[s^2]/a)]}

    triangle[t_]:= If[t<1,t*{1,0},
         If[t<2,{1,0} + (t - 1)*{-1/2,Sqrt[3]/2},
         {1/2,Sqrt[3]/2} + (t - 2)*{-1/2,-Sqrt[3]/2}]]

    triangle[tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[triangle[t]],{t,tmin,tmax},opt,
            Axes->None,AspectRatio->Automatic]

    trident[a_,b_,c_,d_][t_]:= {t,a*t^2 + b*t + c + d/t}

    trident[a_,b_,c_,d_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[trident[a,b,c,d][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic,
             PlotRange->{Automatic,{-4,4}}]

    trisectrix[a_][t_]:=
        {a*(1 - 4*Cos[t]^2),a*(1 - 4*Cos[t]^2)*Tan[t]}

    trisectrix[a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[trisectrix[a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    tschirnhausen[n_,a_][t_]:= {a*Cos[t]/Cos[t/3]^n,
                                a*Sin[t]/Cos[t/3]^n}

    tschirnhausen[n_,a_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[tschirnhausen[n,a][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    watt[a_,b_,c_][t_]:=
        {Sqrt[b^2 - (a*JacobiCN[t,a^2/c^2] +
              c*JacobiDN[t,a^2/c^2])^2]*Cos[t],
         Sqrt[b^2 - (a*JacobiCN[t,a^2/c^2] +
              c*JacobiDN[t,a^2/c^2])^2]*Sin[t]}

    watt[a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[watt[a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

    zcprofile[pm_,a_,c_][t_]:=
       {t,pm*Sqrt[a^2*t^2 - c^2] + c*ArcSin[c/(a*t)]}

    zcprofile[pm_,a_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot[Evaluate[zcprofile[pm,a,c][t]],
            {t,tmin,tmax},opt,Axes->None,AspectRatio->Automatic]

(* Implicitly Defined Plane Curves *)

    agnesiimplicit[a_][x_,y_]:= x^2*y - 4*a^2*(2*a - y)

    agnesiimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[agnesiimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150]

    astroidimplicit[n_,a_,b_][x_,y_]:=
              (x/a)^(2/n) + (y/b)^(2/n) - 1

    bulletnoseimplicit[a_,b_][x_,y_]:= (a/x)^2 - (b/y)^2 - 1

    bulletnoseimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[bulletnoseimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150]

    cardioidimplicit[a_][x_,y_]:=
            (x^2 + y^2 - 2*a*x)^2 - 4*a^2*(x^2 + y^2)

    cardioidimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[cardioidimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150,PlotRange->All]

    cartesianimplicit[a_,c_,m_][x_,y_]:=
            ((1 - m^2)*(x^2 + y^2) + 2*m^2*c*x + a^2 - m^2*c^2)^2 -
              4*a^2*(x^2 + y^2)

    cartesianimplicit[a_,c_,m_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[cartesianimplicit[a,c,m][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150,PlotRange->All]

    cassiniimplicit[a_,b_][x_,y_]:=
             (x^2 + y^2 + a^2)^2 - b^4 - 4*a^2*x^2

    cassiniimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[cassiniimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150,PlotRange->All]

    circleimplicit[a_][x_,y_]:= x^2 + y^2 - a^2

    circleimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[circleimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    cissoidimplicit[a_][x_,y_]:= x^3 + x*y^2 - 2*a*y^2

    cissoidimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[cissoidimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    conchoidimplicit[a_,b_][x_,y_]:=
                   (x^2 + y^2)*(x - b)^2 - a^2*x^2

    conchoidimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[conchoidimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    crosscurveimplicit[a_,b_][x_,y_]:= (a/x)^2 + (b/y)^2 - 1

    crosscurveimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[crosscurveimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
        PlotPoints->150]

    cubicparabolaimplicit[a_,b_,c_,d_][x_,y_]:=
          a*x^3 + b*x^2 + c*x + d - y

    cubicparabolaimplicit[a_,b_,c_,d_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[
        cubicparabolaimplicit[a,b,c,d][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    deltoidimplicit[a_][x_,y_]:= (x^2 + y^2)^2 -
         8*a*x*(x^2 - 3*y^2) + 18*a^2*(x^2 + y^2) - 27*a^4

    deltoidimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[deltoidimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    devilimplicit[a_,b_][x_,y_]:= y^2*(y^2 - b^2) - x^2*(x^2 - a^2)

    devilimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[devilimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    duererimplicit[a_,b_][x_,y_]:=
             2*y^2*(x^2 + y^2) + 2*b(x + y)*(a^2 - y^2) +
             (b^2 - 3*a^2)*y^2 - a^2*x^2 +a^2*(a^2 - b^2)

    duererimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[duererimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    ellipseimplicit[a_,b_][x_,y_]:= x^2/a^2 + y^2/b^2 - 1

    ellipseimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[ellipseimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    foliumimplicit[x_,y_]:= x^3 + y^3 - 3*x*y

    foliumimplicit[n_,a_,b_,c_][x_,y_]:=
             a*x^(2*n + 1) + b*y^(2*n + 1) - c*x^n*y^n

    foliumimplicit[n_,a_,b_,c_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[foliumimplicit[n,a,b,c][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    hippopedeimplicit[a_,b_][x_,y_]:=
         (x^2 + y^2)^2 + 4*b*(b - a)*(x^2 + y^2) - 4*b^2*x^2

    hippopedeimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[hippopedeimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    hyperbolaimplicit[a_,b_][x_,y_]:= x^2/a^2 - y^2/b^2 - 1

    hyperbolaimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[hyperbolaimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    kappacurveimplicit[a_][x_,y_]:= (x^2 + y^2)*y^2 - a^2*x^2

    kappacurveimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[kappacurveimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    keplerimplicit[a_,b_][x_,y_]:= ((x - b)^2 + y^2)*
               (x*(x - b) + y^2) - 4*a*(x - b)*y^2

    keplerimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[keplerimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    lemniscateimplicit[a_][x_,y_]:=
               (x^2 + y^2)^2 - a^2*(x^2 - y^2)

    lemniscateimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[lemniscateimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    lemniscateimplicit[xp_,yp_][x_,y_]:=
	Product[(x - xp[[j]])^2 + (y - yp[[j]])^2,{j,Length[xp]}]

    limaconimplicit[a_,b_][x_,y_]:=
         (x^2 + y^2 - 2*a*x)^2 - b^2*(x^2 + y^2)

    limaconimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[limaconimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    nephroidimplicit[a_][x_,y_]:=
           (x^2 + y^2 - 4*a^2)^3 - 108*a^4*y^2

    nephroidimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[nephroidimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    newtonphillipsimplicit[m_,n_,a_,b_][x_,y_]:=
        Sin[y]*Sin[m*y] - a*Sin[x]*Sin[n*x] - b

    parabolaimplicit[a_][x_,y_]:= x^2 - 4*a*y

    parabolaimplicit[a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[parabolaimplicit[a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    perseusimplicit[a_,b_,c_][x_,y_]:=
            (x^2 + y^2 + a^2 - b^2 + c^2)^2 - 4*a^2*(c^2 + x^2)

    perseusimplicit[a_,b_,c_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[perseusimplicit[a,b,c][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    piriformimplicit[a_,b_][x_,y_]:= a^4*y^2 - b^2*x^3*(2*a - x)

    piriformimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[piriformimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    predatorpreyimplicit[a_,b_,p_,q_,c_][x_,y_]:=
             y^a*x^p*E^(-b*y - q*x) -
             c*(a/b)^a*(p/q)^p*E^(-a - p)

    scimplicit[x_,y_]:= y^2 - x^3

    scimplicit[{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[scimplicit[x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    semicubicimplicit[a_,b_,c_,d_][x_,y_]:=
                      a*x^3 + b*x^2 + c*x + d - y^2

    semicubicimplicit[a_,b_,c_,d_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[semicubicimplicit[a,b,c,d][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    serpentineimplicit[a_,b_][x_,y_]:= y - a*x + b*x^2*y

    serpentineimplicit[a_,b_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[serpentineimplicit[a,b][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic,
         PlotPoints->150]

    strophoidimplicit[a_][x_,y_]:= y^2*(a - x) - x^2*(a + x)

    strophoidimplicit[m_,a_][x_,y_]:= y^2*(a - x) - x^2*(a*m + x)

    strophoidimplicit[m_,a_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[strophoidimplicit[m,a][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    tridentimplicit[a_,b_,c_,d_][x_,y_]:=
                      a*x^3 + b*x^2 + c*x + d - x*y

    tridentimplicit[a_,b_,c_,d_][{xmin_,xmax_,opt___}]:=
        ImplicitPlot[Evaluate[tridentimplicit[a,b,c,d][x,y]==0],
        {x,xmin,xmax},opt,Axes->None,AspectRatio->Automatic]

    wattimplicit[a_,b_,c_][x_,y_]:= (x^2 + y^2)^3 -
        2*(a^2 + b^2 - c^2)^2*(x^2 + y^2)^2 +
        ((a^2 + b^2 - c^2)^4 + 4*a^2y^2)*(x^2 + y^2) -
        4*a^2*b^2*y^2

(* Polar Defined Plane Curves *)

    archimedesspiralpolar[n_,a_][theta_]:= a*theta^(1/n)

    archimedesspiralpolar[n_,a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[archimedesspiralpolar[n,a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    bowpolar[a_][theta_]:= a*(1 - Tan[theta]^2)

    bowpolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[bowpolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    cardioidpolar[a_][theta_]:= 2*a*(1 + Cos[theta])

    cardioidpolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[cardioidpolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    cassinipolar[a_,b_,pm1_,pm2_][theta_]:=
           pm1*Sqrt[a^2*Cos[2*theta] +
           pm2*Sqrt[b^4 - a^4*Sin[2*theta]^2]]
       
    cassinipolar[a_,b_,pm1_,pm2_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[cassinipolar[a,b,pm1,pm2][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    cochleoidpolar[n_,a_][theta_]:= a*(Sin[theta]/theta)^n

    cochleoidpolar[n_,a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[cochleoidpolar[n,a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    epispiralpolar[n_,a_][theta_]:= a/Sin[n*theta]

    epispiralpolar[n_,a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[epispiralpolar[n,a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    fermatspiralpolar[a_][theta_]:= a*Sqrt[theta]

    fermatspiralpolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[fermatspiralpolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    foliumpolar[theta_]:=
         3*Cos[theta]*Sin[theta]/(Cos[theta]^3 + Sin[theta]^3)

    foliumpolar[n_,a_,b_,c_][theta_]:=
         c*Cos[theta]^n*Sin[theta]^n/
         (a*Cos[theta]^(2*n + 1) + b*Sin[theta]^(2*n + 1))

    foliumpolar[n_,a_,b_,c_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[foliumpolar[n,a,b,c][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    hyperbolicspiralpolar[a_][theta_]:= a/theta

    hyperbolicspiralpolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[hyperbolicspiralpolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    kampylepolar[a_][theta_]:= a*Sec[theta]^2

    kampylepolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[kampylepolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    keplerorbitpolar[a_,e_][theta_]:= a/(1 - e*Cos[theta])

    keplerorbitpolar[a_,e_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[keplerorbitpolar[a,e][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    lemniscatepolar[a_][theta_]:= a*Sqrt[Cos[2*theta]]

    lemniscatepolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[lemniscatepolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    limaconpolar[a_,b_][theta_]:= 2*a*Cos[theta] + b

    limaconpolar[n_,a_,b_][theta_]:= 2*a*Cos[n*theta] + b

    limaconpolar[n_,a_,b_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[limaconpolar[n,a,b][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    lituuspolar[a_][theta_]:= a/Sqrt[theta]

    lituuspolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[lituuspolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    logspiralpolar[a_,b_][theta_]:= a*E^(b*theta)

    logspiralpolar[a_,b_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[logspiralpolar[a,b][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    nephroidpolar[a_][theta_]:=
        2*a*(Sin[theta/2]^(2/3) + Cos[theta/2]^(2/3))^(3/2)
 
    nephroidpolar[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[nephroidpolar[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    pacman[n_][theta_]:= 1 + Cos[theta]^n

    pacman[a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[pacman[a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

    rosepolar[n_,a_][theta_]:= a*Cos[n*theta]

    rosepolar[n_,a_][thetamin_,thetamax_,opt___]:=
        PolarPlot[Evaluate[rosepolar[n,a][theta]],
        {theta,thetamin,thetamax},opt,Axes->None]

(* Parametrically Defined Space Curves *)

    ast3d[n_,a_,b_][t_]:= {a*Cos[t]^n,b*Sin[t]^n,Cos[2*t]}

    ast3d[n_,a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[ast3d[n,a,b][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    baseballseam[a_,c_][t_]:=
        {a*Sin[Pi/2 - (Pi/2 - c)*Cos[t]]*Cos[t/2 + c*Sin[2*t]],
         a*Sin[Pi/2 - (Pi/2 - c)*Cos[t]]*Sin[t/2 + c*Sin[2*t]],
         a*Cos[Pi/2 - (Pi/2 - c)*Cos[t]]}

    baseballseam[a_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[baseballseam[a,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    besselcurve[a_,b_,c_][t_]:=
         {BesselJ[a,t],BesselJ[b,t],BesselJ[c,t]}

    besselcurve[a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[besselcurve[a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    bicylinder[a_,b_,pm_][t_]:= {a*Cos[t],a*Sin[t],
                                 pm*Sqrt[b^2 - a^2*Sin[t]^2]}

    bicylinder[a_,b_,pm_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[bicylinder[a,b,pm][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    biquadratic[a_,k_][t_]:=
           {a*JacobiSN[t,k],a*JacobiCN[t,k],a*JacobiDN[t,k]}

    biquadratic[a_,k_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[biquadratic[a,k][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    clelia[a_][m_,n_][t_]:=
           {a*m*Cos[t]*Sin[n*t],a*m*Sin[t]*Sin[n*t],
            a*Sqrt[1 - m^2*Sin[n*t]^2]}

    clelia[a_][m_,n_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[clelia[a][m,n][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    conicalhelix[a_,b_,c_,d_][t_]:= {a*t*Cos[d*t],b*t*Sin[d*t],c*t}

    conicalhelix[a_,b_,c_,d_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[conicalhelix[a,b,c,d][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->1000]

    cubicalellipse[a_,b_,c_,d_,e_,f_,pm_][t_]:=
           {a*t/(1 + pm*t^2),
           (b*t + c*t^2)/(1 + pm*t^2),
           (d*t + e*t^2 + f*t^3)/(1 + pm*t^2)}

    cubicalellipse[a_,b_,c_,d_,e_,f_,pm_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[cubicalellipse[a,b,c,d,e,f,pm][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    eightknot[t_]:=
        {10*(Cos[t] + Cos[3*t]) + Cos[2*t] + Cos[4*t],
         6*Sin[t] + 10*Sin[3*t],
         4*Sin[3*t]*Sin[5*t/2] + 4*Sin[4*t] - 2*Sin[6*t]}

    eightknot[tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[eightknot[t]],{t,tmin,tmax},opt,
            Axes->None,PlotPoints->150]

    epitrochoid3d[a_,b_,h_,omega_][t_]:=
        {Cos[t]*(a + b*Cos[omega]) - 
         h*(Cos[t]*Cos[a*t/b]*Cos[omega] - Sin[t]*Sin[a*t/b]),
         Sin[t]*(a + b*Cos[omega]) - 
         h*(Sin[t]*Cos[a*t/b]*Cos[omega] + Cos[t]*Sin[a*t/b]),
        (b - h*Cos[a*t/b])*Sin[omega]}

    epitrochoid3d[a_,b_,h_,omega_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[epitrochoid3d[a,b,h,omega][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    genhelix[a_,b_][f_][t_]:= {a*Cos[t],b*Sin[t],f[t]}

    genhelix[a_,b_][f_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[genhelix[a,b][f][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->400]

    helix[a_,c_][t_]:= {a*Cos[t],a*Sin[t],c*t}

    helix[a_,b_,c_][t_]:= {a*Cos[t],b*Sin[t],c*t}

    helix[a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[helix[a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    helixunitspeed[a_,b_][s_]:=
        {a*Cos[s/Sqrt[a^2 + b^2]],a*Sin[s/Sqrt[a^2 + b^2]],
         b*s/Sqrt[a^2 + b^2]}

    horopter[a_,b_][t_]:=
        {2*a/(1 + b^2*t^2),2*a*b*t/(1 + b^2 t^2),t}

    horopter[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[horopter[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    line3d[a1_,b1_,c1_,a2_,b2_,c2_][t_]:=
         {a1*t + a2,b1*t + b2,c1*t + c2}

    lissajous3d[n_,d_,a_,b_,c_][t_]:=
         {a*Sin[n*t + d],b*Sin[t],c*Cos[t]} 

    lissajous3d[n_,d_,a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[lissajous3d[n,d,a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    oneparametersubgroup[mat_,vec_][t_]:=
        ComplexExpand[Normal[MatrixExp[Rationalize[t*mat]]].vec]

    oneparametersubgroup[mat_,vec_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[oneparametersubgroup[mat,vec][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->200,PlotRange->All]

    pseudospheregeodesic[a_,c_,u0_,pm_][t_]:=
        {a*Sin[t]*Cos[u0 + pm*Sqrt[a^2 - 2*c^2 - a^2*Cos[2*t]]/
         (Sqrt[2]*c*Sin[t])],
         a*Sin[t]*Sin[u0 + pm*Sqrt[a^2 - 2*c^2 - a^2*Cos[2*t]]/
         (Sqrt[2]*c*Sin[t])],a*(Cos[t] + Log[Tan[t/2]])}

    pseudospheregeodesic[a_,c_,u0_,pm_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[pseudospheregeodesic[a,c,u0,pm][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    pseudosphericalloxodrome[a_,b_][t_]:=
         {a*Cos[b*Cosh[t]]/Cosh[t],
          a*Sin[b*Cosh[t]]/Cosh[t],a*(t - Tanh[t])}

    pseudosphericalloxodrome[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[pseudosphericalloxodrome[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->500]

    seiffertspiral[a_,k_][t_]:=
        {a*Cos[t]*JacobiSN[t,k],a*Sin[t]*JacobiSN[t,k],
         a*JacobiCN[t,k]}

    seiffertspiral[a_,k_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[seiffertspiral[a,k][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalcardioid[a_][t_]:=
        {2*a*Cos[t] - a*Cos[2*t],2*a*Sin[t] - a*Sin[2*t],
         Sqrt[8]*a*Cos[t/2]}

    sphericalcardioid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalcardioid[a][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalellipse[a_,b_,c_,pm_][t_]:=
        {b*JacobiCN[t,(c^2 - b^2)/(a^2 - b^2)],
         c*JacobiSN[t,(c^2 - b^2)/(a^2 - b^2)],
         pm*Sqrt[a^2 - b^2]*JacobiDN[t,(c^2 - b^2)/(a^2 - b^2)]}

    sphericalellipse[a_,b_,c_,pm_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalellipse[a,b,c,pm][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalhelix[a_,b_][t_]:=
        {(a + b)*Cos[t] - b*Cos[(a + b)*t/b],
         (a + b)*Sin[t] - b*Sin[(a + b)*t/b],
          2*Sqrt[a*b + b^2]*Cos[a*t/(2*b)]}

    sphericalhelix[a_,b_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalhelix[a,b][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalloxodrome[a_,b_,c_][t_]:=
        {2*a*b*E^(c*t)*Cos[t]/(1 + b^2*E^(2*c*t)),
         2*a*b*E^(c*t)*Sin[t]/(1 + b^2*E^(2*c*t)),
         a*(-1 + b^2*E^(2*c*t))/(1 + b^2*E^(2*c*t))}

    sphericalloxodrome[a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalloxodrome[a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalloxodromeunitspeed[a_,b_,c_][s_]:=
        {2*a*Cos[Log[Tan[c*s/(2*a*Sqrt[1 + c^2])]]/c]*
          Tan[c*s/(2*a*Sqrt[1 + c^2])]/
          (1 + b^2*Tan[c*s/(2*a*Sqrt[1 + c^2])]^2), 
        2*a*Sin[Log[Tan[c*s/(2*a*Sqrt[1 + c^2])]]/c]*
          Tan[c*s/(2*a*Sqrt[1 + c^2])]/
          (1 + b^2*Tan[c*s/(2*a*Sqrt[1 + c^2])]^2), 
          -a*Cos[c*s/(a*Sqrt[1 + c^2])]}

    sphericalnephroid[a_][t_]:=
        {3*a*Cos[t] - a*Cos[3*t],3*a*Sin[t] - a*Sin[3*t],
         Sqrt[12]*a*Cos[t]}

    sphericalnephroid[a_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalnephroid[a][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    sphericalspiral[a_][m_,n_][t_]:=
          {a*Cos[m*t]*Cos[n*t],a*Sin[m*t]*Cos[n*t],a*Sin[n*t]}

    sphericalspiral[a_][m_,n_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[sphericalspiral[a][m,n][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->800]

    tennisballseam[n_,a_,b_,c_][t_]:=
          {-a*(Cos[t]*(b^2 + c^2*n^2*Cos[n*t]^2) + 
           c^2*n^3*Sin[t]*Sin[2*n*t]/2)/
           (Sqrt[b^2*Cos[t]^2 + c^2*n^2*Cos[n*t]^2 + 
            a^2*Sin[t]^2]*Sqrt[a^2*b^2*Cos[t]^4 + 
            b^2*c^2*n^2*Cos[n*t]^2*Sin[t]^2 + 
            a^2*b^2*Sin[t]^4 + a^2*c^2*n^4*Sin[t]^2*Sin[n*t]^2 + 
            Cos[t]^2*(a^2*c^2*n^2*Cos[n*t]^2 + 
            b^2*(2*a^2*Sin[t]^2 + c^2*n^4*Sin[n*t]^2)) + 
            a^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2 - 
            b^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2]),
            b*(-2*(a^2 + c^2*n^2*Cos[n*t]^2)*Sin[t] + 
            c^2*n^3*Cos[t]*Sin[2*n*t])/
            (2*Sqrt[b^2*Cos[t]^2 + c^2*n^2*Cos[n*t]^2 + 
            a^2*Sin[t]^2]*Sqrt[a^2*b^2*Cos[t]^4 + 
            b^2*c^2*n^2*Cos[n*t]^2*Sin[t]^2 + 
            a^2*b^2*Sin[t]^4 + a^2*c^2*n^4*Sin[t]^2*Sin[n*t]^2 + 
            Cos[t]^2*(a^2*c^2*n^2*Cos[n*t]^2 + 
            b^2*(2*a^2*Sin[t]^2 + c^2*n^4*Sin[n*t]^2)) + 
            a^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2 - 
            b^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2]),
            -c*n*((a^2 - b^2)*Cos[t]*Cos[n*t]*Sin[t] + 
            b^2*n*Cos[t]^2*Sin[n*t] + a^2*n*Sin[t]^2*Sin[n*t])/
            (Sqrt[b^2*Cos[t]^2 + c^2*n^2*Cos[n*t]^2 + 
            a^2*Sin[t]^2]*Sqrt[a^2*b^2*Cos[t]^4 + 
            b^2*c^2*n^2*Cos[n*t]^2*Sin[t]^2 + 
            a^2*b^2*Sin[t]^4 + a^2*c^2*n^4*Sin[t]^2*Sin[n*t]^2 + 
            Cos[t]^2*(a^2*c^2*n^2*Cos[n*t]^2 + 
            b^2*(2*a^2*Sin[t]^2 + c^2*n^4*Sin[n*t]^2)) + 
            a^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2 - 
            b^2*c^2*n^3*Sin[2*t]*Sin[2*n*t]/2])}

    tennisballseam[n_,a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[tennisballseam[n,a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    torusknot[a_,b_,c_][p_,q_][t_]:=
         {(a + b*Cos[q*t])*Cos[p*t],
          (a + b*Cos[q*t])*Sin[p*t],c*Sin[q*t]}

    torusknot[a_,b_,c_][p_,q_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[torusknot[a,b,c][p,q][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

(*
     tprime[a_,b_][v_]:=1/Sqrt[-Cos[v]*(a/b + Cos[v])]


    torusasym[c_,d_,a_,b_][s_]:=
         Module[{uu,tmp1,tmp2,ss},
             tmp1=NDSolve[{uu'[ss]==tprime[a,b][ss],
               uu[c]==d},uu,{ss,0.5001Pi,1.4999Pi},
               MaxSteps->2000];
               tmp2=First[uu[s] /. tmp1];
		{(a + b*Cos[s])*Cos[tmp2],(a + b*Cos[s])*Sin[tmp2],
		b*Sin[s]}]
*)

    twicubic[t_]:= {t,t^2,t^3}

    twicubic[tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[twicubic[t]],{t,tmin,tmax},opt,
            Axes->None,PlotPoints->150]

    veryflat[1][t_]:= {t,0,5*E^(-1/t^2)}

    veryflat[1][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[veryflat[1][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    veryflat[2][t_]:= If[t<0,{t,5*E^(-1/t^2),0},
                     If[t==0,{0,0,0},{t,0,5*E^(-1/t^2)}]]

    veryflat[2][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[veryflat[2][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    viviani[a_][t_]:= {a*(1 + Cos[t]),a*Sin[t],2*a*Sin[t/2]}

    viviani[a_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[viviani[a][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

    wigglyellipse[n_,a_,b_,c_][t_]:= {a*Cos[t],b*Sin[t],c*Sin[n*t]}

    wigglyellipse[n_,a_,b_,c_][tmin_,tmax_,opt___]:=
        ParametricPlot3D[Evaluate[wigglyellipse[n,a,b,c][t]],
            {t,tmin,tmax},opt,Axes->None,PlotPoints->150]

(* Parametrically Defined Curves in R^n*)

    besseln[n_,a_][t_]:= Table[a*BesselJ[k,t],{k,0,n - 1}]

    bernstein[p_,q_][t_]:=Binomial[p,q]*t^q*(1 - t)^(p - q)
    
    beziercurve[pts_][t_]:= Module[{n=Length[pts]},
         Sum[bernstein[n - 1,k][t]*pts[[k + 1]],
         {k,0,n - 1}]]

         cosn[n_,a_][t_]:= Table[a*Sin[k*t],{k,1,n}]

    hermitecurve[p0_,m0_,m1_,p1_][t_]:=
        (bernstein[3,0][t] + bernstein[3,1][t])*p0 +
        bernstein[3,1][t]*m0 - bernstein[3,2][t]*m1 +
        (bernstein[3,2][t] + bernstein[3,3][t])*p1

    ell[ts_,i_,t_]:=Product[(ts[[j]]-t)/(ts[[j]]-ts[[i]]),{j,1,i-1}]*
        Product[(ts[[j]]-t)/(ts[[j]]-ts[[i]]),{j,i+1,Length[ts]}]
		
    lagrangecurve[pts_,ts_][t_]:= Module[{n=Length[pts]},
         Sum[ell[ts,k+1,t]*pts[[k+1]],{k,0,n - 1}]]

    sinn[n_,a_][t_]:= Table[a*Sin[k*t],{k,1,n}]

    twistedn[n_,a_][t_]:= Table[a*t^k,{k,1,n}]

(* Approximations *)

    regularpolygon[n_,a_]:=
        approxcurve[0,2*Pi,n][circle[a]]

    teeth[m_,t_][shortlines_]:=
	    Nest[Flatten[(tooth[t]/@#)]&,shortlines,m]

(*
    tooth[t_][Line[{{a_,b_},{c_,d_}}]]:=
        {Line[{{a,b},(2/3)*{a,b} + (1/3)*{c,d}}],
         Line[{(2/3)*{a,b} + (1/3)*{c,d},
         (t/2)*{a - b + c + d,a + b - c + d} +
         ((1 - t)/2)*{a + b + c - d,-a + b + c + d}}],
         Line[{(t/2)*{a - b + c + d,a + b - c + d} +
         ((1 - t)/2)*{a + b + c - d,-a + b + c + d},
         (1/3)*{a,b} + (2/3)*{c,d}}],
        Line[{(1/3)*{a,b} + (2/3)*{c,d},{c,d}}]}
*)

tooth[t_][Line[{{a_,b_},{c_,d_}}]]:=
        {Line[{{a,b},(2/3)*{a,b} + (1/3)*{c,d}}],
         Line[{(2/3)*{a,b} + (1/3)*{c,d},
         {(a + c)/2 + t*(b - d),(b + d)/2 +t*(c - a)}}],
         Line[{{(a + c)/2 + t*(b - d),(b + d)/2 +t*(c - a)},
         (1/3)*{a,b} + (2/3)*{c,d}}],
        Line[{(1/3)*{a,b} + (2/3)*{c,d},{c,d}}]}

   kochsnowflake[m_]:=
    teeth[m,(3 + Sqrt[3])/6][linetolines[regularpolygon[3,1]]]

   kochsnowflake[m_,t_]:=
    teeth[m,t][linetolines[regularpolygon[3,1]]]
    
End[]

EndPackage[]

This Notebook's Programs

Winding Number

WindingNum::usage = "WindingNum[c,t0,t1] outputs the winding number \
of the parametrized curve c ranging from t0 to t1.";

WindingNum[c_, t0_, 
        t1_] := (1/(2  π)) 
          NIntegrate[kappa2[c][t],  {t, t0, t1}] // Round

Evolute and Involute Plots

EvolutePlot::usage = "EvolutePlot[c,t0,t1,num] Ouputs the plot of \
c, ranging from t0 to t1,num normal segments of c of length equal to radius \
of the curvature, and the plot of the evolute of c (the curve traced by the  \
end point of the normals).";

EvolutePlot[c_, t0_, t1_, num_, PPopts___] := 
      Module[{lines, curves}, 
lines = 
          Graphics[
            Table[{GrayLevel[0.8], Line[{c[n], evolute[c][n]}]}, {n, t0, 
                t1, (t1 - t0)/
                  num}]]; 

curves = 
          ParametricPlot[{c[t], evolute[c][t]},  {t, t0,  t1}, 
            AspectRatio -> Automatic, 
            PlotStyle -> {Magenta, Green}, Axes -> None, 
            PlotRange -> All, PPopts, 
            DisplayFunction -> 
              Identity]; 

Show[lines, 
          curves, AspectRatio -> Automatic, PlotRange -> All, 
          DisplayFunction -> $DisplayFunction]]

EvolutePlot::usage = "InvolutePlot[c,t0,t1,p,num] Ouputs the plot \
of c, ranging from t0 to t1,num tangents of c of length equal to intricsic \
distance between c(0) and c(p), and the plot of the involute of c (the crave \
traced by the end point of the tangent segments).";

InvolutePlot[c_, t0_, t1_, p_, num_, 
        PPopts___] := 
      Module[{lines, curves}, 
lines = 
          Graphics[
            Table[{GrayLevel[0.8], Line[{c[n], involute[c, p][n]}]}, {n, 
                t0, t1, (t1 - t0)/
                  num}]]; 

curves = 
          ParametricPlot[{c[t], involute[c, p][t]},  {t, t0,  t1}, 
            AspectRatio -> Automatic, 
            PlotStyle -> {Magenta, Green}, Axes -> None, 
            PlotRange -> All, PPopts, 
            DisplayFunction -> 
              Identity]; 

Show[lines, 
          curves, AspectRatio -> Automatic, PlotRange -> All, 
          DisplayFunction -> $DisplayFunction]]

Plot Colored by Curvature

\(\(\(\(ribbon[c_]\)[t_, s_] := 
        Append[c[t] + s\ J[\(tangent[c]\)[t]], 0];\)\(
\)
    \)\)
max[f_, x0_, x1_] := 
        Max[Table[
            f[x], {x, x0, x1, (x1 - x0)/100}]];

    
min[f_, x0_, x1_] := 
        Min[Table[
            f[x], {x, x0, x1, (x1 - x0)/100}]];

    
abskappa2[c_][t_] := kappa2[c][t] // Abs;

\(\(\(KappaColoredPlot::usage = "KappaColoredPlot[c,t0,t1,thickness,tnum] outputs the graph of the curve c, colored by its curvature, ranging from t0 to t1, with the given thickness and plot points tnum. The default value of tnum is 100.  The colors range from red (big curvature) to green (small curvature).";\)\(
\)
    \)\)

KappaColoredPlot[c_, t0_, t1_, thickness_, 
        tnum_:  100] := 
Module[{M, m, color, border, 
          middle}, 

M := 
          max[abskappa2[c], t0, t1]; 

m := 
          min[abskappa2[c], t0, 
            t1]; 

color[t_] := 
          If[m == M, 
            0.5, (abskappa2[c][t] - m)/(M - 
                  m)]; 

border =  
          ParametricPlot3D[{ribbon[c][t, -thickness/2], ribbon[c][
                  t, thickness/2]} // Evaluate,  {t, t0, t1},  
            Boxed -> False, Axes -> None, Lighting -> False, 
            PlotPoints -> tnum, ViewPoint -> {0, 0, 1000}, 
            DisplayFunction -> 
              Identity]; 

middle := 
          ParametricPlot3D[
            Append[ribbon[c][t, s]
, 
                Hue[1/3 + 2  color[t]/3]] // Evaluate,  {t, t0, 
              t1},  {s, -thickness/2, thickness/2}, Boxed -> False, 
            Axes -> None, Lighting -> False, 
            PlotPoints -> {tnum, 2}, ViewPoint -> {0, 0, 1000}, 
            DisplayFunction -> 
              Identity]; 


Show[border, middle, 
          DisplayFunction -> dip[EdgeForm[]]]]

\(\(\(SignKappaColoredPlot::usage = "SignKappaColoredPlot[c,t0,t1,thickness,tnum] outputs the graph of the curve c, colored by its signed curvature, ranging from t0 to t1, with the given thickness and plot points tnum. The default value of tnum is 100.  The colors range from red (big curvature) to green (small curvature).";\)\(
\)
    \)\)

SignKappaColoredPlot[c_, t0_, t1_, thickness_, 
        tnum_:  100] := 
Module[{M, m, color, border, 
          middle}, 

M := 
          max[kappa2[c], t0, t1]; 

m := 
          min[kappa2[c], t0, t1]; 

color[
            t_] := If[m == M, 
            0.5, (kappa2[c][t] - m)/(M - 
                  m)]; 

border =  
          ParametricPlot3D[{ribbon[c][t, -thickness/2], ribbon[c][
                  t, thickness/2]} // Evaluate,  {t, t0, t1},  
            Boxed -> False, Axes -> None, Lighting -> False, 
            PlotPoints -> tnum, ViewPoint -> {0, 0, 1000}, 
            DisplayFunction -> 
              Identity]; 

middle := 
          ParametricPlot3D[
            Append[ribbon[c][t, s]
, 
                Hue[1/3 + 2  color[t]/3]] // Evaluate,  {t, t0, 
              t1},  {s, -thickness/2, thickness/2}, Boxed -> False, 
            Axes -> None, Lighting -> False, 
            PlotPoints -> {tnum, 2}, ViewPoint -> {0, 0, 1000}, 
            DisplayFunction -> 
              Identity]; 


Show[border, middle, 
          DisplayFunction -> 
            dip[EdgeForm[]]]]

Plot Determined by Curvature

\(\(\(CurvaturePlot::usage = "CurvaturePlot[k,t0,t1,optspp] outputs the graph of a curve  with the given curvature function k, ranging from t0 to t1, and options optspp which are passed on to parametric plot.";\)\(
\)
    \)\)

CurvaturePlot[k_, t0_, t1_, 
        optspp___] := 
Module[{θ, x, 
          y}, 
θ[t_] := 
          NIntegrate[k[s], {s, 0, t}]; 
x[t_] := 
          NIntegrate[Cos[θ[u]], {u, 0, t}]; 
y[t_] := 
          NIntegrate[
            Sin[θ[u]], {u, 0, 
              t}]; 
ParametricPlot[{x[t], y[t]},  {t, 
            t0,  t1}, optspp]
]

Parallel Curves

parallel::usage = "parallel[c,d][t] outputs the curve parallel to c \
at a distance of d."

parallel[c_, d_][t_] := 
      c[t] + d J[tangent[c][t]/(Sqrt[tangent[c][t] . tangent[c][t]])]

ParallelPlot::usage = "ParallelPlot[c,t0,t1,d,PPopts] ouputs the plot \
of the curve parallel to c at the distance of d. t0 and t1 are the ranges of \
the parameter of c and PPopts are the options which are passed on to \
ParametricPlot."

ParallelPlot[c_, t0_, t1_, d_, 
        PPopts___] := 
ParametricPlot[parallel[c, d][
          t], {t, t0, t1}, AspectRatio -> Automatic, Axes -> False, 
        PlotRange -> All, PPopts]

ParallelPlot::usage = "AllParallelsPlot[c,t0,t1,d0,d1,num] outputs \
num parallel curves of c[t0,t1] ranging in distance d0 to d1 from c."

AllParallelsPlot[c_, t0_, t1_, d0_, d1_, num_] := 
      ParametricPlot[
        Table[parallel[c, n][t], {n, d0, d1, (d1 - d0)/num}] // 
          Evaluate, {t, t0, t1}, AspectRatio -> Automatic, 
        Axes -> False, 
        PlotStyle -> 
          Table[Hue[1 - 1/3 - 2 (n - d0)/(3 (d1 - d0))], {n, d0, 
              d1, (d1 - d0)/num}]]

Moving Point Animations

MovingPointAnim::usage = "MovingPointAnim[c,t0, t1,fnum] outputs \
fnum plots for the animation of a point moving along the parametrized curve c \
ranging from t0 to t1.The default value of fnum is 30.";

\(MovingPointAnim[c_, t0_, \ t1_, fnum_:  30] := 
      Module[{curve, 
          movingpoint}, 

curve = 
ParametricPlot[c[t], \ {t, t0, \ t1}, \ Axes -> None, 
            PlotStyle -> Blue, AspectRatio -> Automatic, 
            DisplayFunction -> 
              Identity]; 

movingpoint = 
          Graphics[{AbsolutePointSize[7], Red, 
              Point[c[t0 + 
                    n \((t1 - t0)\)/
                        fnum]]}]; 

Do[
Show[curve, movingpoint, 
            DisplayFunction -> $DisplayFunction], {n, 0, \ 
            fnum - 1}
]]\)

MovingPointTraceAnim::usage = "MovingPointTraceAnim[c,t0, t1,fnum] \
outputs fnum plots for the animation of a point tracing the parametrized \
curve c ranging from t0 to t1.The default value of fnum is 30.";

\(MovingPointTraceAnim[c_, t0_, \ t1_, fnum_:  30] := 
      Module[{curve, invisiblecurve, startingpoint, movingpoint, 
          t}, 

t[n_] := 
          t0 + n \((t1 - t0)\)/
                fnum; 

invisiblecurve = 
ParametricPlot[c[t], \ {t, t0, \ t1}, \ Axes -> None, 
            PlotStyle -> White, AspectRatio -> Automatic, 
            DisplayFunction -> 
              Identity]; 

curve = 
ParametricPlot[c[t], \ {t, t0, \ t[n]}, \ 
            Axes -> None, PlotStyle -> Blue, 
            AspectRatio -> Automatic, 
            DisplayFunction -> 
              Identity]; 

startingpoint = Show[Graphics[{AbsolutePointSize[6], Blue, Point[c[t0]]}], 
            DisplayFunction -> 
              Identity]; 

movingpoint = 
          Graphics[{AbsolutePointSize[6], 
              Red, 
Point[
                c[t[n]]]}]; 

Do[
Show[invisiblecurve, curve, movingpoint, startingpoint, 
            DisplayFunction -> $DisplayFunction], 
{n, 
            1, \ fnum}
]]\)

Turning Angle Animation

TangentAnim::usage = "TangentAnim[c,t0,t1,d,fnum] outputs fnum \
plots for a the animation of a tangent vector of length d moving along a \
curve c with parameter ranging from t0 to t1.";

\(TangentAnim[c_, t0_, t1_, d_, fnum_] := 
      Module[{t, \ curve, \ invisiblecurve, \ rightcircle, \ leftpoint, \ 
          leftarrow, \ rightarrow, \ rightpoint}, 


        t[n_] := t0 + 
            n \((t1 - t0)\)/
                fnum; 

curve = 
ParametricPlot[c[t], \ {t, t0, \ t1}, \ Axes -> None, 
            PlotStyle -> Blue, 
            AspectRatio -> 
              Automatic, 
DisplayFunction -> Identity, 
            PlotRange -> 
              framesize]; 

invisiblecurve = 
ParametricPlot[
            c[t] + d\ \(tangent[c]\)[t], \ {t, t0, \ t1}, \ 
            Axes -> None, PlotStyle -> White, 
            AspectRatio -> 
              Automatic, 
DisplayFunction -> 
              Identity]; 

rightcircle = 
ParametricPlot[\(circle[1]\)[t], \ {t, t0, \ t1}, \ 
            Axes -> None, PlotStyle -> Red, 
            AspectRatio -> Automatic, \ 
            PlotRange -> {{\(-2.5\), 2.5}, {\(-2.5\), 
                  2.5}}, 
DisplayFunction -> 
              Identity]; 

leftpoint = 
          Graphics[{AbsolutePointSize[3.5], Blue, 
              Point[c[t[
                    n]]]}]; 

leftarrow = 
          Graphics[{Red, 
Arrow[c[t[n]], 
                c[t[n]] + 
                  d\ \(tangent[c]\)[
                      t[n]]]}]; 

rightarrow = 
          Graphics[{Red, 
Arrow[{0, 0}, \ \(tangent[c]\)[
                  t[n]]]}]; 

rightpoint = Graphics[\({AbsolutePointSize[3.5], Blue, 
              Point[{0, 
                  0}]}\)\(,\)]; 


Do[

leftframe = 
            Show[invisiblecurve, curve, leftpoint, leftarrow, \ 
              DisplayFunction -> 
                Identity]; 


rightframe = 
            Show[rightcircle, rightarrow, \ rightpoint, 
              DisplayFunction -> 
                Identity]; 

Show[
            GraphicsArray[{leftframe, rightframe}], \ 
            DisplayFunction -> $DisplayFunction], 

{n, 0, \ fnum - 1}
]]\)

Cycloid Animation

CycloidAnim::usage = "CycloidAnim[r,v,fnum] outputs fnum plots \
for the animation of a curve which is traced by a point of distance r from \
the center of a circle of radius 1 rolling v revolutions along a straight \
line.";

\(CycloidAnim[r_, v_, fnum_] := 
      Module[{t0, t1, t, c, floor, \ movingpoint, wheelcenter, wheelfill, 
          wheel, spoke}, 

t0 = 0; \ 
        t1 = 2\ v\ Pi; 

t[n_] := 
          t0 + n \((t1 - t0)\)/fnum; 

c[
            t_] := \(cycloid[r, 1]\)[
            t]; 

floor = 
          Graphics[{NavyBlue, 
              Line[{{0, 0}, {2\ v\ Pi\ r, 
                    0}}]}]; 

movingpoint = Graphics[{AbsolutePointSize[5], 
              Red, 
Point[
                c[t[n]]]}]; 

wheelcenter = Graphics[{AbsolutePointSize[4], 
              Blue, 
Point[{r\ t[n], 
                  r}]}]; 

wheelfill = 
          Graphics[{LightBlue, 
Disk[{r\ t[n], r}, 
                r]}]; 

wheel = 
          Graphics[{Blue, 
Circle[{r\ t[n], r}, 
                r]}]; 

spoke = 
          Graphics[{Blue, 
              Line[{{r\ t[n], r}, 
                  c[t[n]]}]}]; 


Do[
curve = 
ParametricPlot[c[t], \ {t, t0, \ t[n]}, \ 
              Axes -> None, PlotStyle -> Red, 
              AspectRatio -> Automatic, 
              DisplayFunction -> 
                Identity]; 

Show[
            wheelfill, wheel, wheelcenter, floor, spoke, movingpoint, curve, 
            PlotRange -> {{\(-1\) - r, 2\ v\ Pi\ r + 1 + r}, {\(-1\), 
                  2\ r + 1}}, AspectRatio -> Automatic, 
            DisplayFunction -> $DisplayFunction], 
{n, 
            1, \ fnum}
]]\)

Trochoid Animation

TrochoidAnim::usage = "TrochoidAnim[b,h,fnum] outputs fnum plots \
for the animation of a curve traced by a point a distance of h away from a \
circle of radius |b| rolling along a fixed circle of radius 1. If b<0, then \
the rolling circle and the fixed circle  both lie on the same side of the \
tangent line at their point of contact; otherwise, the roling circle rolls \
outside the fixed circle. The value of b must be a fraction. The default \
value for fnum is 20.";

\(TrochoidAnim[b_, h_, \ fnum_:  20] := 
      Module[{t0, t1, t, stationarycircle, \ movingpoint, wheelcenter, \ 
          wheelfill, \ wheel, spoke, \ invisiblecurve1, 
          invisiblecurve2}, 

t0 = 
          0; \ 

t1 = 
          If[Abs[b] > 1, 
Denominator[Abs[Simplify[b]]] 
              Max[1\ , Abs[b]\ ] 2  
              Pi, 
\ \ \ \ \ Numerator[Abs[Simplify[b]]] 
              Max[1\ , Abs[b]\ ]\ 2  
              Pi]; 


t[n_] := 
          t0 + n \((t1 - t0)\)/fnum; 

If[
          b > 0, 
\(c[x_, y_]\)[
              t_] := \(epitrochoid[1, x, y]\)[
              t], 
\(c[x_, y_]\)[
              t_] := \(hypotrochoid[1, Abs[x], y]\)[
              t]]; 

stationarycircle = 
          ParametricPlot[\(circle[1]\)[t], \ {t, 0, 2  Pi}, \ 
            Axes -> None, PlotStyle -> NavyBlue, 
            DisplayFunction -> 
              Identity]; 


movingpoint = 
          Graphics[{AbsolutePointSize[5], 
              Red, 
Point[\(c[b, h]\)[
                  t[n]]]}]; 

wheelcenter = Graphics[{AbsolutePointSize[4], 
              Blue, 
Point[\((1 + b)\) \(circle[1]\)[
                    t[n]]]}]; 

wheelfill = Graphics[{LightBlue, 
Disk[\((1 + b)\) \(circle[1]\)[
                    t[n]], Abs[
                  b]]}]; 

wheel = 
          Graphics[{Blue, 
Circle[\((1 + b)\) \(circle[1]\)[
                    t[n]], Abs[
                  b]]}]; 

spoke = 
          Graphics[{Blue, 
              Line[{\((1 + b)\) \(circle[1]\)[t[n]], \(c[Abs[b], h]\)[
                    t[n]]}]}]; 

invisiblecurve1 = 
          ParametricPlot[\(c[Abs[b], h]\)[t], \ {t, t0, \ t1}, \ 
            Axes -> None, PlotStyle -> White, 
            AspectRatio -> Automatic, 
            DisplayFunction -> 
              Identity]; 

invisiblecurve2 = \ 
          Graphics[{White, 
Circle[{0, 0}, 
                1 + 2  Abs[
                      b]]}]; 

Do[
curve = 
ParametricPlot[\(c[Abs[b], h]\)[
                t], \ {t, t0, \ t[n]}, \ Axes -> None, 
              PlotStyle -> Red, AspectRatio -> Automatic, 
              DisplayFunction -> 
                Identity]; 

Show[
            invisiblecurve1, invisiblecurve2, wheelfill, wheel, wheelcenter, 
            stationarycircle, spoke, movingpoint, curve, 
            AspectRatio -> Automatic, 
            DisplayFunction -> $DisplayFunction], 
{n, 
            1, \ fnum}
]]\)

Tractrix Animation

TractrixAnim::usage = "TractrixAnim[fnum] outputs fnum plots for \
the animation of the curve traced by an endpoint of a line segment whose \
other endpoint moves along a straigh line.";

\(TractrixAnim[fnum_] := 
      Module[{curve, invisiblecurve, startingpoint, movingpoint, rod, floor, 
          t, c, t0, t1, rodpt, 
          movingrectangle}, 

c[
            t_] := {\(-\@\(1 - E\^\(\(-2\)\ \@t\^2\)\)\) + 
              ArcTanh[\@\(1 - E\^\(\(-2\)\ \@t\^2\)\)], E\^\(-\@t\^2\)}; 

t0 = 
          0; \ t1 = 4; 

t[n_] := 
          t0 + n \((t1 - t0)\)/
                fnum; 

floor = 
          Graphics[{NavyBlue, 
              Line[{{0, 0}, {5, 
                    0}}]}]; 

invisiblecurve = 
ParametricPlot[c[t], \ {t, t0, \ t1}, \ Axes -> None, 
            PlotStyle -> White, AspectRatio -> Automatic, 
            PlotRange -> All, 
            DisplayFunction -> 
              Identity]; 

curve[
            n_] := 
ParametricPlot[
            c[t], \ {t, t0, \ t[n]}, \ Axes -> None, 
            PlotStyle -> Red, AspectRatio -> Automatic, 
            DisplayFunction -> Identity]; 


        movingpoint[n_] := 
          Graphics[{AbsolutePointSize[5], 
              Red, 
Point[
                c[t[n]]]}]; 

rodpt[n_] := 
          Graphics[{AbsolutePointSize[5], 
              Blue, 
Point[
                c[t[n]] + \(c'\)[
                    t[n]]]}]; 

movingrectangle[n_] := 
          Graphics[{Rectangle[{\(rodpt[n]\)[\([1]\)] - 
                    0.03, \(-0.02\)}, {\(rodpt[n]\)[\([1]\)] + 0.03, 0.02}], 
              NavyBlue}]; 

rod[n_] := 
          Graphics[{Blue, 
Line[{c[t[n]], 
                  c[t[n]] + \(c'\)[
                      t[n]]}]}]; 

Do[
Show[invisiblecurve, floor, curve[n], rod[n], rodpt[n], 
            movingpoint[n], 
            DisplayFunction -> $DisplayFunction], 
{n, 
            1, \ fnum}
]]\)

Evolute and Involute Animations

InvoluteAnim::usage = "InvoluteAnim[c,t0,t1,fnum] Outputs fnum frames \
for a tracing animation of c[t0,t1] as the evolute of its envolute.The \
default value of fnum is 40."

InvoluteAnim[c_, t0_, t1_, fnum_:  40] := 
      Module[{lines, curves, trace, 
          point}, 

line[n_] = 
          Graphics[{NavyBlue, 
              Line[{c[n], evolute[c][
                    n]}]}]; 

curves = 
          ParametricPlot[{c[t], evolute[c][t]},  {t, t0,  t1}, 
            AspectRatio -> Automatic, PlotStyle -> {White, Blue}, 
            PlotRange -> All, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

trace1[n_] := 
          ParametricPlot[c[t], {t, t0,  n}, AspectRatio -> Automatic, 
            PlotStyle -> Red, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

trace2[n_] := 
          ParametricPlot[evolute[c][t], {t, t0,  n}, 
            AspectRatio -> Automatic, PlotStyle -> Blue, 
            Axes -> None, 
            DisplayFunction -> 
              Identity]; 



point[n_] := 
          Graphics[{Red, AbsolutePointSize[5], 
              Point[c[n]]}]; 

Do[
          Show[line[n], curves, trace1[n], point[n], 
            AspectRatio -> Automatic, PlotRange -> All, 
            DisplayFunction -> $DisplayFunction], {n, 
            t0 + (t1 - t0)/fnum, t1, (t1 - t0)/fnum}]]

EvoluteAnim::usage = "EvoluteAnim[c,t0,t1,p,fnum] Outputs fnum frames \
for a tracing animation of evolute of c[t0,t1].The default value of fnum is \
40."

EvoluteAnim[c_, t0_, t1_, p_, fnum_:  40] := 
      Module[{lines, curves, trace1, trace2, 
          point}, 

line[n_] = 
          Graphics[{NavyBlue, 
              Line[{c[n], involute[c, p][
                    n]}]}]; 

curves = 
          ParametricPlot[{c[t], involute[c, p][t]},  {t, t0,  t1}, 
            AspectRatio -> Automatic, PlotStyle -> {Blue, White}, 
            PlotRange -> All, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

trace1[n_] := 
          ParametricPlot[c[t], {t, t0,  n}, AspectRatio -> Automatic, 
            PlotStyle -> Red, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

trace[n_] := 
          ParametricPlot[involute[c, p][t], {t, t0,  n}, 
            AspectRatio -> Automatic, PlotStyle -> Red, 
            Axes -> None, 
            DisplayFunction -> 
              Identity]; 

point[n_] := 
          Graphics[{Red, AbsolutePointSize[5], 
              Point[involute[c, p][
                  n]]}]; 

Do[
          Show[line[n], curves, trace[n], point[n], 
            AspectRatio -> Automatic, PlotRange -> All, 
            DisplayFunction -> $DisplayFunction], {n, 
            t0 + (t1 - t0)/fnum, t1, (t1 - t0)/fnum}]]

DeltoidDoubleInvoluteAnim::usage = "DeltoidDoubleInvoluteAnim[d,fnum] \
Outputs fnum frames for the animation of line segment rolling around a \
deltoid and tracing the evolute of the deltoid at distance d."

DeltoidDoubleInvoluteAnim[d_, fnum_:  40] := 
      Module[{c, t0, t1, lines, curve1, curve2,  
          point}, 

c[
            t_] := parallel[deltoidinvolute[1], d][
            t]; 

t0 = 
          0; 

t1 = 
          2  Pi; 

line[n_] = 
          Graphics[{NavyBlue, 
              Line[{c[n], evolute[c][
                    n]}]}]; 

curve1 = 
          ParametricPlot[c[t],  {t, t0,  2  t1}, 
            AspectRatio -> Automatic, PlotStyle -> Red, 
            PlotRange -> All, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

curve2 = 
          ParametricPlot[evolute[c][t],  {t, t0,  t1}, 
            AspectRatio -> Automatic, PlotStyle -> Blue, 
            PlotRange -> All, Axes -> None, 
            DisplayFunction -> 
              Identity]; 

point[n_] := 
          Graphics[{Red, AbsolutePointSize[5], 
              Point[c[n]]}]; 

Do[
          Show[line[n], line[n + 2  Pi], curve1, curve2, point[n], 
            point[n + 2  Pi], AspectRatio -> Automatic, 
            PlotRange -> All, 
            DisplayFunction -> $DisplayFunction], {n, 
            t0 + (t1 - t0)/fnum, t1, (t1 - t0)/fnum}]]

Reuleaux Triangle Animations

ReuleauxSquareAnim::usage = "ReuleauxSquareAnim[fnum] Outputs fnum \
frames for  animation of a reuleaux triangle rotating inside a square.The \
default value of fnum is 40."

ReuleauxSquareAnim[fnum_:  40]:=Module[{v1, v2, v3, c1, c2, c3, c, solid, curve, maxx, minx, maxy, 
            miny, p, box},
v1 = {-1/2, 0};v2 = {1/2, 0};v3 = {0, (Sqrt[3])/2};

c1[t_] := circle[1][t] + v1;
c2[t_] := circle[1][t] + v2;
c3[t_] := circle[1][t] + v3;

c[t_] := 
              Which[         0 <= t <  Pi/3, 
                c1[t], 
                               Pi/3 <= t < 2  Pi/3, 
                c2[t + Pi/
                      3], 
                           2  Pi/3 <= t <= Pi, c3[t + 2  Pi/3]];

r[θ_]:=(({{Cos[θ], Sin[θ]}, {-Sin[θ], Cos[θ]}}));

solid[n_] := 
              ParametricPlot[r[n] . c[t], {t, 0, Pi}, 
                DisplayFunction -> Identity, 
                AspectRatio -> Automatic, AspectRatio -> Automatic, 
                Axes -> False, PlotStyle -> LightSteelBlue];

curve[n_] := 
              ParametricPlot[r[n] . c[t], {t, 0, Pi}, 
                DisplayFunction -> Identity, 
                AspectRatio -> Automatic, AspectRatio -> Automatic, 
                Axes -> False, PlotStyle -> Blue];

maxx[θ_] := 
              Max[(r[θ] . v1)[[1]], (r[θ] . 
                      v2)[[1]], (r[θ] . v3)[[1]]];
minx[θ_] := 
              Min[(r[θ] . v1)[[1]], (r[θ] . 
                      v2)[[1]], (r[θ] . v3)[[1]]];
maxy[θ_] := 
              Max[(r[θ] . v1)[[2]], (r[θ] . 
                      v2)[[2]], (r[θ] . v3)[[2]]];
miny[θ_] := 
              Min[(r[θ] . v1)[[2]], (r[θ] . 
                      v2)[[2]], (r[θ] . v3)[[2]]];

p[θ_] := 
              Which[        0 <= θ < 
                  Pi/6, {minx[θ] + 1, 
                  maxy[θ]}, 
                              Pi/6 <= θ < 
                  Pi/3, {minx[θ] + 1, 
                  miny[θ] + 
                    1}, 
                              Pi/3 <= θ < Pi/2, {maxx[θ], 
                  miny[θ] + 
                    1}, 
                              Pi/2 <= θ <= 2  Pi/3, {maxx[θ], 
                  maxy[θ]}];

box[θ_] := {p[θ], 
                p[θ] + {-1, 0}, p[θ] + {-1, -1}, 
                p[θ] + {0, -1}, p[θ]};

Do[
              Show[filledcurve[solid[ n]], 
                Graphics[{Red, Thickness[0.006], Line[box[n]]}], 
                curve[ 
                  n], 
DisplayFunction -> $DisplayFunction], {n, 0, 
                2  Pi/3 - (2  Pi/3)/fnum, (2  Pi/3)/fnum}]]

ReuleauxRectangleAnim::usage = "ReuleauxRectangleAnim[fnum] Outputs \
fnum frames for  animation of a reuleaux triangle rotating inside a \
rectangle.The default value of fnum is 40."

ReuleauxRectangleAnim[fnum_:  40]:=
Module[{v1, v2, v3, c1, c2, c3, c, solid, curve, maxx, minx, 
              maxy, miny, rc, rectangle},

v1 = {-1/2, 0};v2 = {1/2, 0};v3 = {0, (Sqrt[3])/2};

c1[t_] := circle[1][t] + v1;
c2[t_] := circle[1][t] + v2;
c3[t_] := circle[1][t] + v3;

c[t_] := 
                Which[         0 <= t <=  Pi/3, 
                  c1[ t], 
                               Pi/3 < t < 2  Pi/3, 
                  c2[t + Pi/
                        3], 
                           2  Pi/3 <= t <= Pi, c3[t + 2  Pi/3]];

r[θ_]:=(({{Cos[θ], Sin[θ]}, {-Sin[θ], Cos[θ]}}));

maxx[θ_] := 
                Max[(r[θ] . v1)[[1]], (r[θ] . 
                        v2)[[1]], (r[θ] . v3)[[1]]];
minx[θ_] := 
                Min[(r[θ] . v1)[[1]], (r[θ] . 
                        v2)[[1]], (r[θ] . v3)[[1]]];
maxy[θ_] := 
                Max[(r[θ] . v1)[[2]], (r[θ] . 
                        v2)[[2]], (r[θ] . v3)[[2]]];
miny[θ_] := 
                Min[(r[θ] . v1)[[2]], (r[θ] . 
                        v2)[[2]], (r[θ] . v3)[[2]]];

rc[θ_] := 
Which[-2 Pi/3 - Pi/6  <= θ < -Pi/3 - 
                      Pi/6, 
{-Pi/6, (Sqrt[3])/2} + 
                    r[θ + Pi/3 + 
                          Pi/6] . (rc[-Pi/3 - Pi/6] - {-Pi/6, (Sqrt[3])/
                              2}) + {θ + Pi/3 + Pi/6, 
                      0},    
            -Pi/3 - Pi/6 <= θ < -Pi/
                      6, 
{-Pi/6, (Sqrt[3])/2 - 1} + 
                    r[θ + 
                          Pi/6] . (rc[-Pi/6] - {-Pi/6, (Sqrt[3])/2 - 
                              1}),      
            -Pi/6 <= θ <= Pi/6, 
v3 + 
                    r[θ] . (c[t] - v3) + {θ, 
                      0}, 
             Pi/
                      6 < θ <= 
                    Pi/3 + Pi/6, 
{Pi/6, (Sqrt[3])/2 - 1} + 
                    r[θ - 
                          Pi/6] . (rc[
                            Pi/6] - {Pi/6, (Sqrt[3])/2 - 
                              1}), 
              Pi/3 + Pi/6 < θ <= 
                    2  Pi/3 + Pi/6, 
{Pi/6, (Sqrt[3])/2} + 
                    r[θ - Pi/3 - 
                          Pi/6] . (rc[
                            Pi/3 + Pi/6] - {Pi/6, (Sqrt[3])/2}) + {θ - 
                        Pi/3 - Pi/6, 0}];

solid[n_] := 
                ParametricPlot[rc[n], {t, 0, Pi}, 
                  AspectRatio -> 
                    Automatic, 
PlotPoints -> 100, 
                  Axes -> 
                    False, 
PlotRange -> {{-Pi/
                            2 + (Sqrt[3])/2 - 1, 
                        Pi/2 - (Sqrt[3])/2 + 1}, {(Sqrt[3])/2 - 1, (Sqrt[3])/
                          2}}, 
PlotStyle -> 
                    LightSteelBlue, DisplayFunction -> Identity];

curve[n_] := 
                ParametricPlot[rc[n], {t, 0, Pi}, 
                  AspectRatio -> 
                    Automatic, 
PlotPoints -> 100, 
                  Axes -> 
                    False, 
PlotRange -> {{-Pi/
                            2 + (Sqrt[3])/2 - 1, 
                        Pi/2 - (Sqrt[3])/2 + 1}, {(Sqrt[3])/2 - 1, (Sqrt[3])/
                          2}}, 
PlotStyle -> Blue, 
                  DisplayFunction -> Identity];

rectangle = {{-Pi/2 + (Sqrt[3])/2 - 
                      1, (Sqrt[3])/2 - 1}, 
{Pi/2 - (Sqrt[3])/2 + 
                      1, (Sqrt[3])/2 - 1}, 
{Pi/2 - (Sqrt[3])/2 + 
                      1, (Sqrt[3])/2}, 
{-Pi/2 + (Sqrt[3])/2 - 
                      1, (Sqrt[3])/2}, 
{-Pi/2 + (Sqrt[3])/2 - 
                      1, (Sqrt[3])/2 - 1}};

Do[
                Show[filledcurve[
                    solid[n]], 
Graphics[{Red, 
                      Line[rectangle]}], 
                  curve[n], 
DisplayFunction -> $DisplayFunction], 
{n, -2 Pi/3 - Pi/6, 
                  2  Pi/3 + Pi/6, (5  Pi/3)/fnum}]]

Wave Front Animation

WaveFrontAnim::usage = "WaveFrontAnim[c,t0,t1,d0,d1,fnum] outputs \
fnum plots for the animation of the parallel curves of c[t0,t1] ranging in \
distance to c from d0 to d1."

WaveFrontAnim[c_, t0_, t1_, d0_, d1_, fnum_] := 
      Module[{frame, curve}, 

curve = 
          ParametricPlot[c[t], {t, t0, t1}, AspectRatio -> Automatic, 
            Axes -> False, PlotStyle -> Magenta, PlotRange -> All, 
            DisplayFunction -> 
              Identity]; 

frame[n_, 
            PPopts___] := 
          ParallelPlot[c, t0, t1, n, PPopts, 
            DisplayFunction -> 
              Identity]; 

Do[
          Show[frame[d0, PlotStyle -> White], 
            frame[d1, PlotStyle -> White], curve, 
            frame[n, PlotStyle -> Green] // Evaluate, 
            PlotRange -> All, 
            DisplayFunction -> $DisplayFunction], {n, 
            d0 + (d1 - d0)/fnum, d1, (d1 - d0)/fnum}]]

Index of Curves

Parametrized

{2 a Tan[t], 2 a Cos[t]^2}

{a AiryAi[t], a AiryBi[t]}

{a (t^((1/n))) Cos[t], a (t^((1/n))) Sin[t]}

{a Cos[t]^3, a Sin[t]^3}

\({t, e\^\(-\(\((\(-mean\) + t)\)\^2\/\(2\ variance\^2\)\)\)\/\(\@\(2\ π\)\ \@variance\^2\)}\)

{a Sin[
          t], ((a Cos[t]^2 (2 + Cos[t]))/(3 + Sin[t]^2))}

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

{a (1 + Cos[t]^2) Sin[t], 
      Cos[t] (b + Sin[t]^2)}

{a Cos[t], {b1 Cot[t], b2 Cot[t], b3 Cot[t]}}

{2 a Cos[t] (1 + Cos[t]), 
      2 a (1 + Cos[t]) Sin[t]}

\({pm1\ Cos[
          t]\ \@\(a\^2\ Cos[2\ t] + pm2\ \@\(b\^4 - a\^4\ Sin[2\ t]\^2\)\), 
      pm1\ Sin[t]\ \@\(a\^2\ Cos[2\ t] + pm2\ \@\(b\^4 - a\^4\ Sin[2\ t]\^2\)\)}\)

{a Cosh[(t/a)], t}

{4 a Cos[(t/2)]^4 (-1 + 2 Cos[t]), 
      4 a Cos[(t/2)]^3 Sin[((3 t)/2)]}

{a Cos[t], a Sin[t]}

{a (Cos[t] + t Sin[t]), 
      a (-t Cos[t] + Sin[t])}

{((2 a (t^2))/(1 + (t^2))), ((2 a (t^3))/(1 + (t^2)))}

{a (Sqrt[π]) FresnelS[(s/(Sqrt[π]))], 
      a (Sqrt[π]) FresnelC[(s/(Sqrt[π]))]}

\({b\ pm\ Sinh[
          s\/a], \(-i\)\ \@\(a\^2 - b\^2\)\ EllipticE[\(i\ s\)\/a, \(-\(b\^2\/\(a\^2 - b\^2\)\)\)]}\)

\({b\ pm\ Cosh[
          s\/a], \(-i\)\ a\ EllipticE[\(i\ s\)\/a, \(-\(b\^2\/a\^2\)\)]}\)

{a Cos[t] (((Sin[t]/t))^n), 
      a Sin[t] (((Sin[t]/t))^n)}

{b + a Cos[t], a Sin[t] + b Tan[t]}

{a Cos[t] Sech[n t], a Sech[n t] Sin[t]}

{-Sinh[2 t]/(Cos[2 a t] - Cosh[2 t]), 
      Sin[2 a t]/(Cos[2 a t] - Cosh[2 t])}

{b pm Cos[(s/a)], a EllipticE[(s/a), ((b^2)/(a^2))]}

{a Sec[t], b Csc[t]}

{t, {d1 + c1 t + b (t^2) + a (t^3), d2 + c2 t + b (t^2) + a (t^3), 
        d3 + c3 t + b (t^2) + a (t^3)}}

{a t - b Sin[t], a - b Cos[t]}

{-a + 2 a Cos[t] (1 + Cos[t]), 
      2 a (1 - Cos[t]) Sin[t]}

{(1/3) a (8 Cos[(t/2)] + 2 Cos[t] - Cos[2 t]), 
      (1/3) a (-8 Sin[(t/2)] + 2 Sin[t] + 
            Sin[2 t])}

{a Cos[t] (Sqrt[Cos])[t]^2, a Sin[t] (Sqrt[Sin])[t]^2}

{Sin[t], Cos[t] Sin[t]}

\({\(-s\) + \(2\ EllipticE[JacobiAmplitude[a\ s, k\^2], k\^2]\)\/a, \(-\(\(2\ k\ \((\(-1\) + JacobiCN[a\ s, k\^2])\)\)\/a\)\)}\)

\({\((1 - 
              2\/k\^2)\)\ s + \(2\ EllipticE[JacobiAmplitude[\(a\ s\)\/k, k\^2], k\^2]\)\/\(a\ k\), \(-\(\(2\ \((\(-1\) + 
                  JacobiDN[\(a\ s\)\/k, 
                    k\^2])\)\)\/\(a\ k\)\)\)}\)

{a Cos[t], b Sin[t]}

{a Sech[t], b Tanh[t]}

\({a\ JacobiSN[t, 
            1 - b\^2\/a\^2] + \(c\ \((a\ Cos[ψ]\ JacobiCN[t, 1 - b\^2\/a\^2] + b\ JacobiSN[t, 1 - b\^2\/a\^2]\ Sin[ψ])\)\)\/\(a\ JacobiDN[t, 1 - b\^2\/a\^2]\), 
      b\ JacobiCN[t, 
            1 - b\^2\/a\^2] + \(c\ \((\(-b\)\ Cos[ψ]\ JacobiSN[t, 1 - b\^2\/a\^2] + a\ JacobiCN[t, 1 - b\^2\/a\^2]\ Sin[ψ])\)\)\/\(a\ JacobiDN[t, 1 - b\^2\/a\^2]\)}\)

{(a + b) Cos[t] - 
        b Cos[(((a + b) t)/b)], (a + b) Sin[t] - 
        b Sin[(((a + b) t)/b)]}

{a Cos[t] Csc[n t], a Csc[n t] Sin[t]}

{(a + b) Cos[t] - 
        h Cos[(((a + b) t)/b)], (a + b) Sin[t] - 
        h Sin[(((a + b) t)/b)]}

{a (Sqrt[t]) Cos[t], a (Sqrt[t]) Sin[t]}

{((3 t)/(1 + (t^3))), ((3 (t^2))/(1 + (t^3)))}

{t, (t^n)}

{a BesselJ[n, t], a BesselY[n, t]}

{2 Cos[t] (Sqrt[a b - (b^2) Sin[t]^2]), 
      2 Sin[t] (Sqrt[a b - (b^2) Sin[t]^2])}

{a Cosh[t], b Sinh[t]}

{a Sec[t], b Tan[t]}

{((a Cos[t])/t), ((a Sin[t])/t)}

{(a - b) Cos[t] + 
        b Cos[(((a - b) t)/b)], (a - b) Sin[t] - 
        b Sin[(((a - b) t)/b)]}

{(1/a) ((a^2) Cos[t] - 3 a b Cos[t] + 2 (b^2) Cos[t] - 
            a b Cos[t - ((a t)/b)] + 2 (b^2) Cos[t - ((a t)/b)] + 
            4 a b Cos[t - ((a t)/(2 b))] - 
            4 (b^2) Cos[t - ((a t)/(2 b))]), (1/a) ((a^2) Sin[
                t] - 3 a b Sin[t] + 2 (b^2) Sin[t] - 
            a b Sin[t - ((a t)/b)] + 2 (b^2) Sin[t - ((a t)/b)] + 
            4 a b Sin[t - ((a t)/(2 b))] - 
            4 (b^2) Sin[t - ((a t)/(2 b))])}

{(a - b) Cos[t] + 
        h Cos[(((a - b) t)/b)], (a - b) Sin[t] - 
        h Sin[(((a - b) t)/b)]}

{a Sec[t], a Sec[t] Tan[t]}

{a Cos[t] Cot[t], a Cos[t]}

\({\(a\ Cos[t]\)\/\(1 - e\ Cos[t]\), \(a\ Sin[t]\)\/\(1 - e\ Cos[t]\)}\)

\({\(a\ Cos[t]\)\/\(1 + Sin[t]\^2\), \(a\ Cos[t]\ Sin[t]\)\/\(1 + Sin[t]\^2\)}\)

{a Cos[θ] (Sqrt[Cos])[2 θ], 
      a (Sqrt[Cos])[2 θ] Sin[θ]}

{(1 - 2 Cos[t]) Cos[t], (1 - 2 Cos[t]) Sin[
          t]}

{a2 + a1 t, b2 + b1 t}

{{a Sin[d1 + n t], a Sin[d2 + n t], a Sin[d3 + n t]}, 
      b Sin[t]}

\({\(a\ t\ Cos[\@t\^2]\)\/\((t\^2)\)\^\(3/4\), \(a\ t\ Sin[\@t\^2]\)\/\((t\^2)\)\^\(3/4\)}\)

{t, (k/(1 + (e^(a + b t))))}

{a (e^(b t)) Cos[t], 
      a (e^(b t)) Sin[t]}

{a (3 Cos[t] - Cos[3 t]), 
      a (3 Sin[t] - Sin[3 t])}

{a CosIntegral[t], a SinIntegral[t]}

{2 a t, a (t^2)}

{(b + a t ((((t^2)))^(-n))) Cos[(Sqrt[(t^2)])], (b + 
            a t ((((t^2)))^(-n))) Sin[(Sqrt[(t^2)])]}

{a (1 + Sin[t]), b Cos[t] (1 + Sin[t])}

{a Cos[t] Cos[n t], a Cos[n t] Sin[t]}

{(t^2), (t^3)}

{Cos[
          t] (-b Cos[t] + a Cos[2 t]), (-b Cos[t] + 
            a Cos[2 t]) Sin[t]}

\({WeierstrassP[
          z, {b\^2\/12 - \(a\ c\)\/4, \(-\(b\^3\/216\)\) + \(a\ b\ c\)\/48 - \(a\^2\ d\)\/16}] 
        WeierstrassPPrime[
          z, {b\^2\/12 - \(a\ c\)\/4, \(-\(b\^3\/216\)\) + \(a\ b\ c\)\/48 - \(a\^2\ d\)\/16}]}\)

{t, ((a t)/(1 + b (t^2)))}

{a Cos[t] Csch[n t], a Csch[n t] Sin[t]}

{a Cos[t], a Nest[Sin, t, n]}

{a Cos[t], a Cos[v] Sin[t] + b t Sin[v]}

{a Cos[t], a Cos[v] Sin[t] + b t Sin[v]}

\({\(Cos[t]\ \((a\^2 + f\^2\ Sin[t]\^2)\)\)\/a, \(Sin[t]\ \((a\^2 - 2\ f\^2 + f\^2\ Sin[t]\^2)\)\)\/b}\)

{Sinh[2 t]/(Cos[2 a t] + Cosh[2 t]), 
      Sin[2 a t]/(Cos[2 a t] + Cosh[2 t])}

{a Sin[t], d (((b Sin[t] + c Sin[2 t]))^n)}

{a Sin[t], a (Cos[t] + Log[Tan[(t/2)]])}

{s, (Sqrt[(a^2) - (s^2)]) + a Log[(2/(s^2))] - 
        a Log[(2/(a s)) + ((2 (Sqrt[(a^2) - (s^2)]))/((a^2) s))]}

{s, -(Sqrt[(a^2) - (s^2)]) - a Log[(2/(s^2))] + 
        a Log[(2/(a s)) + ((2 (Sqrt[(a^2) - (s^2)]))/((a^2) s))]}

{t, c + (d/t) + b t + a (t^2)}

{a (1 - 4 Cos[t]^2), 
      a (1 - 4 Cos[t]^2) Tan[t]}

{a Cos[(t/3)]^(-n) Cos[t], 
      a Cos[(t/3)]^(-n) Sin[t]}

\({Cos[
          t]\ \@\(b\^2 - \((a\ JacobiCN[t, a\^2\/c\^2] + c\ JacobiDN[t, a\^2\/c\^2])\)\^2\), \@\(b\^2 - \((a\ JacobiCN[t, a\^2\/c\^2] + c\ JacobiDN[t, a\^2\/c\^2])\)\^2\)\ Sin[t]}\)

{t, 
      pm (Sqrt[-(c^2) + (a^2) (t^2)]) + 
        c ArcSin[(c/(a t))]}

Implicit

Polar

Polygonal

Computations

Length

Description

?length

?N

?arclength

Examples

length[0, 2  Pi][circle[r]]

length[0, 2  Pi][ellipse[2, 1]]

length[0, 2  Pi][ellipse[2, 1]] // N

length[0, 2  Pi][cycloid[r, r]]

c[t_] := {t - 5, t^2 + t + 1};  length[-1, 3][c]

Signed Curvature

Description

?kappa2

Examples

kappa2[circle[r]][t] // FullSimplify

kappa2[ellipse[a, b]][t] // Simplify
Plot[kappa2[ellipse[1, 2]][t], {t, 0, 2  Pi}, 
      PlotStyle -> Magenta]

kappa2[eight][t] // Simplify
Plot[kappa2[eight][t], {t, 0, 2  Pi}, 
      PlotStyle -> Magenta]

Abs[kappa2[eight][t]] // Simplify
Plot[Abs[kappa2[eight][t]], {t, 0, 2  Pi}, 
      PlotStyle -> Magenta]

kappa2[limacon[-1, 1]][t] // Simplify
Plot[kappa2[limacon[-1, 1]][t], {t, 0, 2  Pi}, 
      PlotStyle -> Magenta]

Winding Number

Description

?WindingNum

Examples

WindingNum[ellipse[2, 1], 0, 2  Pi]

WindingNum[eight, -Pi, Pi]

Plots

Basic

Description

The basic command for plotting a parametrized curve is:

ParametricPlot[c[t],  {t, t0,  t1}, AspectRatio -> Automatic, 
      PlotStyle -> {Magenta, Thickness[ .006]}, 
      Axes -> None]

The option "AspectRatio" above set the ratio of the height and width of the graph The default value is the 1/(golden ratio), not one. So to obtain a faithful picture of your curve, you should set AspectRatio to Automatic.
The option "PlotStyle" sets up the color and thickness of the curve. You may choose any color by typing its name, or use the command RGBColor[r,g,b], where "r", "g", "b" are numbers between 0 and 1.
To see the coordinate axis, eliminate the option "Axis->None". 
The following command gives the complete list of all the options and their default setting. Use the "?" command to find more about each option.

Options[ParametricPlot]

Examples

ParametricPlot[ellipse[3, 2],  {t, 0,  2  Pi}, 
      AspectRatio -> Automatic, 
      PlotStyle -> {Magenta, Thickness[ .006]}, 
      Axes -> None]

ParametricPlot[
      Table[ellipse[1 - n, n][t], {n, 0, 1, 1/16}] // Evaluate,  {t, 
        0,  2  Pi}, AspectRatio -> Automatic, 
      PlotStyle -> Table[Hue[n], {n, 0, 1, 1/16}], 
      Axes -> None]

ParametricPlot[limacon[-1, 1],  {t, 0,  2  Pi}, 
      AspectRatio -> Automatic, 
      PlotStyle -> {Magenta, Thickness[ .006]}, 
      Axes -> None]

ParametricPlot[
      Table[limacon[-1, 4  n][t], {n, 0, 1, 1/16}] // Evaluate,  {t, 
        0,  2  Pi}, AspectRatio -> Automatic, 
      PlotStyle -> Table[Hue[n], {n, 0, 1, 1/16}], 
      Axes -> None]

ParametricPlot[deltoid[1],  {t, 0,  2  Pi}, 
      AspectRatio -> Automatic, 
      PlotStyle -> {Magenta, Thickness[ .006]}, 
      Axes -> None]

ParametricPlot[
      Table[epitrochoid[3, -2, 2  n][t], {n, 0, 1, 1/8}] // 
        Evaluate,  {t, 0,  4  Pi}, AspectRatio -> Automatic, 
      PlotStyle -> Table[Hue[n], {n, 0, 1, 1/8}], 
      Axes -> None]

Filled

Description

?filledcurve

Examples

filledcurve[eight[t] // Evaluate, {t, 0,  2  Pi}, Axes -> None, 
        AspectRatio -> Automatic, Prolog -> Magenta];

filledcurve[limacon[1, 1][t] // Evaluate, {t, 0,  2  Pi}, 
        Axes -> None, AspectRatio -> Automatic, 
        Prolog -> Magenta];

filledcurve[lissajous[3/4, 0, 9, 8][t] // Evaluate, {t, 0,  
          8  Pi}, Axes -> None, AspectRatio -> Automatic, 
        Prolog -> Magenta];

Parallel

Description

?AllParallelsPlot

Examples

AllParallelsPlot[ellipse[3, 2], 0, 2  Pi, 0, 5, 12]

AllParallelsPlot[eight, 0, 2  Pi, 0, 2, 8]

AllParallelsPlot[limacon[-1, 1], 0, 2  Pi, 0, 2.15, 8]

Evolutes and Involutes

Descriptions

?EvolutePlot

?InvolutePlot

Examples

c[t_] := ellipse[3, 2][t];
EvolutePlot[c, 0, 2  Pi, 70]

c[t_] := deltoidinvolute[1][t];
EvolutePlot[c, 0, 4  Pi, 150]

c[t_] := circle[1][t];
InvolutePlot[c, 0, 2  Pi, 0, 75, PlotRange -> All]

c[t_] := limacon[-1, 1][t];
EvolutePlot[c, 0, 2  Pi, 90]

c[t_] := limacon[-1, 1][t];
InvolutePlot[c, 0, 2  Pi, Pi, 90]

c[t_] := limacon[-1, 1][t];
InvolutePlot[c, 0, 2  Pi, 0, 90, PlotRange -> All]

c[t_] := deltoid[1][t];
EvolutePlot[c, 0, 2  Pi, 90]

c[t_] := deltoid[1][t];
InvolutePlot[c, 0.01, 2  Pi - 0.01, Pi, 90]

c[t_] := nephroid[1][t];
EvolutePlot[c, 0, 2  Pi, 100]

c[t_] := nephroid[1][t];
InvolutePlot[c, 0.01, 2  Pi - 0.01, Pi/2, 100]

c[t_] := cycloid[1][t];
EvolutePlot[c, 2  Pi, 6  Pi, 60]

c[t_] := cycloid[1][t];
InvolutePlot[c, Pi, 5  Pi - 0.01, Pi, 60]

c[t_] := J[tractrix[1][t]];
EvolutePlot[c, 0.3, Pi - 0.3, 60, PlotRange -> All]

c[
          t_] := -J[catenary[-1][
              t]];
InvolutePlot[c, -2, 2, 0, 40]

Colored by Curvature

Descriptions

?KappaColoredPlot

?SignKappaColoredPlot

Examples

c[t_] := ellipse[3, 2][t]; 
    KappaColoredPlot[c, 0, 2  Pi, 0.06]

c[t_] := eight[t];
KappaColoredPlot[c, -Pi, Pi, 0.025]

c[t_] := eight[t];
SignKappaColoredPlot[c, -Pi, Pi, 0.025]

c[t_] := limacon[-1, 1][t]; 
    KappaColoredPlot[c, -Pi, Pi, 0.04]

c[t_] := clothoid[1, 1][t];
KappaColoredPlot[c, -5, 5, 0.03]

c[t_] := clothoid[1, 1][t]; 
    SignKappaColoredPlot[c, -5, 5, 0.035]

c[t_] := logspiral[1, 0.04][t];
SignKappaColoredPlot[c, 0, 8  Pi, 0.08, 500]

Determined by Curvature

Description

?CurvaturePlot

Examples

k[t_] := 0;
CurvaturePlot[k, -3, 3, PlotStyle -> Magenta,  
      AspectRatio -> Automatic]

k[t_] := 1;
CurvaturePlot[k, 0, 2  Pi, PlotStyle -> Magenta, 
      AspectRatio -> Automatic]

k[t_] := t;
CurvaturePlot[k, -5, 5, PlotStyle -> Magenta, 
      AspectRatio -> Automatic]

k[t_] := t^2;
CurvaturePlot[k, -4, 4, PlotStyle -> Magenta, 
      AspectRatio -> Automatic, PlotRange -> All]

k[t_] := Sin[t];
CurvaturePlot[k, -3 Pi, 3  Pi, PlotStyle -> Magenta, 
      AspectRatio -> Automatic]

k[t_] := 1/(t^2 + 1);
CurvaturePlot[k, -3, 3, PlotStyle -> Magenta, 
      AspectRatio -> Automatic]

Animations

Orbits; Planetary Motion

Description

?MovingPointAnim

?MovingPointTraceAnim

Examples

c[t_] := keplerorbit[2, 0.7][t];
MovingPointAnim[c, 0, 2  Pi]

c[t_] := eight[t];
MovingPointAnim[c, -Pi, Pi]

c[t_] := limacon[-1, 1][t];
MovingPointAnim[c, 0, 2  Pi]

c[t_] := lissajous[3/4, 0, 9, 8][t]; 
    MovingPointAnim[c, 0, 8  Pi, 60]

c[t_] := lissajous[3/4, 0, 9, 8][t]; 
    MovingPointTraceAnim[c, 0, 8  Pi, 60]

Turning Angle

Description

?TangentAnim

Examples

c[t_] :=  eight[t];
TangentAnim[c, 0, 2  Pi, 0.5, 30]

c[t_] :=  lissajous[3/4, 0, 9, 8][t]; 
    TangentAnim[c, 0, 8  Pi, 4, 50]

c[t_] :=  limacon[-1, 1][t];
TangentAnim[c, 0, 2  Pi, 0.75, 30]

Cycloids

Description

?CycloidAnim

Examples

CycloidAnim[0.5, 1.5, 30]

CycloidAnim[1, 1.5, 30]

CycloidAnim[1.5, 1.5, 30]

Tractrix

Description

?TractrixAnim

Example

TractrixAnim[60]

Trochoids

Description

?TrochoidAnim

Examples

TrochoidAnim[-1/3, 
        1/5] ;

TrochoidAnim[-2/3, 
        1.1] ;

TrochoidAnim[-1/2, 
        1/2] ;

TrochoidAnim[-1/2, 
        1/5] ;

TrochoidAnim[-1/2, 
        3] ;

TrochoidAnim[1, 
        3/2] ;

TrochoidAnim[1/2, 
        1] ;

TrochoidAnim[-1/4, 
        1/4] ;

TrochoidAnim[-1/3, 
        1/3] ;

Evolutes and Involutes; Huygen's Pendulum; Curves of Constant Width

Description

?InvoluteAnim

?EvoluteAnim

?DeltoidDoubleInvoluteAnim

Examples

c[t_] := ellipse[3, 2][t];
InvoluteAnim[c, 0, 2  Pi, 40]

c[t_] := deltoidinvolute[1][t];
InvoluteAnim[c, 0, 4  Pi, 40]

DeltoidDoubleInvoluteAnim[0]

c[t_] := parallel[deltoidinvolute[1], 1][t];
InvoluteAnim[c, 0, 4  Pi, 20]

DeltoidDoubleInvoluteAnim[1]

c[t_] := -cycloid[1][t];
InvoluteAnim[c, 0, 2  Pi, 40]

c[t_] := deltoid[1][t];
InvoluteAnim[c, 0, 2  Pi, 40]

c[t_] := limacon[-1, 1][t];
InvoluteAnim[c, 0, 2  Pi, 40]

c[t_] := nephroid[1][t];
InvoluteAnim[c, 0, 2  Pi, 100]

c[t_] := circle[1][t];
EvoluteAnim[c, 0, 2  Pi, 0, 30]

c[t_] := limacon[-1, 1][t];
EvoluteAnim[c, 0, 2  Pi, Pi, 30]

Reuleaux Triangle

Description

?ReuleauxSquareAnim

?ReuleauxRectangleAnim

Examples

ReuleauxSquareAnim[]

ReuleauxRectangleAnim[]

Wave Fronts

Description

?WaveFrontAnim

Examples

c[t_] := ellipse[3, 2][t];
WaveFrontAnim[c, 0, 2  Pi, 0, 5, 30]

c[t_] := limacon[-1, 1][t];
WaveFrontAnim[c, 0, 2  Pi, 0, 5, 30]

c[t_] := eight[t];
WaveFrontAnim[c, 0, 2  Pi, 0, 1.5, 30]