(*:Title: CURVES3D *)

(*:Author: Alfred Gray *)

(* Copyright 1994  by Alfred Gray *)

(*:Package Version: 1.0 *)

(*:Mathematica Version: 2.2 *)

(*:Summary: 
	This package consists of definitions of parametrizations of
space curves.
*)

(*:Keywords:
ast3d, baseballseam, besselcurve, bicylinder, biquadratic, cubicalellipse, 
eightknot, epitrochoid3d, genhelix, helix, helixunitspeed, line3d, 
lissajous3d, loxodrome, oneparametersubgroup, seiffertspiral, sphericalhelix, 
sphericalspiral, torusknot, twicubic, veryflat, viviani
*)

Print["For a list of parametrized space curves type curves3d."]

BeginPackage["CURVES3D`"]

    curves3d:=Print[Select[Names["CURVES3D`*"],#!="curves3d"&]]

    ast3d::usage="t->ast3d[n,a,b][t] is a space curve analog of the
plane curve astroid."

    baseballseam::usage="t->baseballseam[a,b,c][t] is an approximation
to the seam on a baseball of radius a."

    besselcurve::usage="t->besselcurve[a,b,c][t] is a space curve
whose components are Bessel functions."

    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."

    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^2z^2=a^2."

    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."

    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."

    eightknot::usage="t->eightknot[t] is a parametrization of an eight
knot."

    genhelix::usage="t->genhelix[a,b][f][t] is a generalized elliptical
helix with slant function f."

    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."

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

    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."

    loxodrome::usage="t->loxodrome[a,b,pm][t] is a loxodrome of slant b on a
sphere of radius a. It is a curve whose angle with each meridian is constant.
The parameter pm is plus or minus 1."

    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."

    seiffertspiral::usage="t->seiffertspiral[a,k][t] is Seiffert's spiral
of slant k on an sphere of radius a."

    sphericalhelix::usage="t->sphericalhelix[a,b][t] is a spherical helix
on a sphere of radius a + 2b.  It is a curve of constant slope which
projects to t->epicycloid[a,b][t]."

    sphericalspiral::usage="t->sphericalspiral[a][m,n][t] is a spherical spiral
of type (m,n) on an sphere of radius a."

    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)."

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

    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 have
the same curvature and torsion."

    viviani::usage="t->viviani[a][t] is a Viviani curve on a sphere
of radius a."

Begin["`Private`"]

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

    baseballseam[a_,b_,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]]}

    besselcurve[a_,b_,c_][t_]:=
         {BesselJ[a,t],BesselJ[b,t],BesselJ[c,t]}

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

    biquadratic[a_,k_][t_]:=
           {a*JacobiSN[t,k],a*JacobiCN[t,k],a*JacobiDN[t,k]}

    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)}

    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]), 
        (a + b*Cos[omega])*Sin[t] - 
         h*(Cos[(a*t)/b]*Cos[omega]*Sin[t] + Cos[t]*Sin[(a*t)/b]), 
        (b - h*Cos[(a*t)/b])*Sin[omega]}

    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]}

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

    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}

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

    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]} 

    loxodrome[a_,b_,pm_][t_]:=
        {a*Cos[Log[Sqrt[t^2]]/b]*2*t/(1+t^2),
         a*pm*Sin[Log[Sqrt[t^2]]/b]*2*t/(1+t^2),
         a*pm*(1-t^2)/(1+t^2)}

    oneparametersubgroup[mat_,vec_][t_]:=
        ComplexExpand[MatrixExp[Rationalize[t*mat]].vec]

    seiffertspiral[a_,k_][t_]:=
        {a*Cos[t]*JacobiSN[t,k],a*Sin[t]*JacobiSN[t,k],
         a*JacobiCN[t,k]}

    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(a*b + b^2)^(1/2)*Cos[(a*t)/(2*b)]}

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

    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]}

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

    veryflat[1][t_]:= {t,0,5*E^(-1/t^2)}

    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)}]]

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

End[]

EndPackage[]
