Examples of closed asymptotic curves

Mohammad Ghomi and Matteo Raffaelli
December 2024

This notebook is an accompaniment to the Section 4 of the paper

                           Topology of closed asymptotic curves on negatively curved surfaces 
 
 by the authors.

Note: Due to conflicting functions in the sections below, Mathematica Kernel needs to be restarted when runing one section after another.

First Example

We start with the example given by Kovaleva.

Definition

r=Sqrt[63/8]; a=1/8;

c[t_]={(3+Sin[t])Cos[r Cos[t]],(3+Sin[t])Sin[r Cos[t]],a(Sin[2t]+46Cos[t]-27Cos[t]^3+(27/5)Cos[t]^5)};

ParametricPlot3D[c[t],{t,0,2Pi}]

ParametricPlot[{c[t][[1]],c[t][[2]]}, {t,0,2Pi}]

Spherical Images

T[t_]=c'[t]/Sqrt[c'[t].c'[t]];

g=ParametricPlot3D[T[t], {t,0,2Pi}];
Show[{Graphics3D[{Opacity[0.6],Sphere[]}],Graphics3D[Point[{0,0,1}]],g},Boxed->False]

The principal normal is given by

PN[t_]=T'[t]/Sqrt[T'[t].T'[t]];

Plot[T'[t].T'[t],{t,0,2Pi}]

FindRoot[T'[t].T'[t],{t,3}]

FindRoot[T'[t].T'[t],{t,6}]

So we may define the vector (n^⊥) as:

nperp[t_]=If[3.48143<t<5.94335,PN[t],-PN[t]];

g=ParametricPlot3D[nperp[t], {t,0,2Pi}];
Show[Graphics3D[{Opacity[0.6],Sphere[]}],g,Boxed->False]

n[t_]=Cross[T[t],nperp[t]];

g=ParametricPlot3D[n[t], {t,0,2Pi}];
Show[{Graphics3D[{RGBColor[1,1,1,0.25],Sphere[]}],g}, Boxed->False]

Curvatures and Geodesic Torsion

κ[t_]=Norm[Cross[c'[t],c''[t]]]/Norm[c'[t]]^2;

Plot[κ[t],{t,0,2Pi}]

τg[t_]=Det[{c'[t],c''[t],c'''[t]}]/Norm[Cross[c'[t],c''[t]]]^2;

Plot[τg[t], {t,0,2Pi}]

Composite Picture

r=Sqrt[63/8]; a=1/8;

c[t_]={(3+Sin[t])Cos[r Cos[t]],(3+Sin[t])Sin[r Cos[t]],a(Sin[2t]+46Cos[t]-27Cos[t]^3+(27/5)Cos[t]^5)};

cproj[t_]={(3+Sin[t])Cos[r Cos[t]],(3+Sin[t])Sin[r Cos[t]],-6};

g=ParametricPlot3D[c[t],{t,0,2Pi},PlotStyle->{Purple,Thickness[0.011]}];

g1=ParametricPlot3D[cproj[t],{t,0,2Pi},PlotStyle->{Gray,Thickness[0.007]}];

Show[{g,g1},Boxed->False,Axes->False,PlotRange->All]

Second Example

Here we construct a simple closed curve Γ with an injective Darboux binormal n such that Lk(Γ,n)=2.

The Binormal

x[t_]=(3+Sin[t])Cos[2.5 Cos[t]]/6; y[t_]=(3+Sin[t])Sin[2.5 Cos[t]]/6;

z[t_]=Sqrt[1-x[t]^2-y[t]^2]//Simplify

n[t_]={x[t],y[t],z[t]};

sphere=Graphics3D[{RGBColor[1,1,1,0.25],{Opacity[0.25],Sphere[]}}];

graphn=ParametricPlot3D[n[t], {t,0,2Pi}];

Show[sphere,graphn,Boxed->False]

The Tangent

T[t_]=n[t]\[Cross]n'[t]/Sqrt[n'[t].n'[t]];

graphT=ParametricPlot3D[T[t], {t,0,2Pi}];

Show[sphere,graphT,Boxed->False]

The Function ρ

a1=Pi+Pi/6;
a2=2Pi-Pi/6;
a3=Pi/2-Pi/3;
a4=Pi/2+Pi/3;
a5=Pi/2;

Show[sphere,graphT,
Graphics3D[
{PointSize[0.03],{Red,Point[T[a1]]},{Orange,Point[T[a2]]},{Green,Point[T[a3]]},{Purple,Point[T[a4]]},{Blue,Point[T[a5]]}}
],Boxed->False]

Integrate[(1.1+Cos[t])^10,{t,-Pi,Pi}]

phi[a_,t_]=(1+Cos[t-a])^10/1894.7;

p1=NIntegrate[phi[a1,t]T[t],{t,0,2Pi}];

p2=NIntegrate[phi[a2,t]T[t],{t,0,2Pi}];

p3=NIntegrate[phi[a3,t]T[t],{t,0,2Pi}];

p4=NIntegrate[phi[a4,t]T[t],{t,0,2Pi}];

p5=NIntegrate[phi[a5,t]T[t],{t,0,2Pi},AccuracyGoal->16];

Solve[p1*x1+p2*x2+p3*x3+p4*x4+p5*x5==0 ,{x1,x2,x3,x4,x5}]

%/.{x1->1,x2->1}

c1=1;
c2=1;
c3=0.081524;
c4=0.081524;
c5=0.746522;

ρ[t_]=c1*phi[a1,t]+c2*phi[a2,t]+c3*phi[a3,t]+c4*phi[a4,t]+c5*phi[a5,t];

The Curve

Γ[t_]:=NIntegrate[ρ[s]*T[s],{s,0,t},AccuracyGoal->5];

coords=Table[{Γ[t][[1]],Γ[t][[2]],Γ[t][[3]]}, {t,0,2Pi,Pi/60}];

Graphics3D[{Thick,Purple,Line[coords]}]

Graphics3D[{Thick,Purple,Line[coords]},ViewPoint->{0,0,1000}]

Graphics3D[{Thick,Purple,Line[coords]},ViewPoint->{1000,0,0}]

Curvature and Geodesic Torsion

nperp[t_]=T[t]\[Cross]n[t];

κ[t_]=Dot[T'[t],nperp[t]]/ρ[t];

Plot[κ[t],{t,0,2Pi}]

So there are two inflections.

τg[t_]=Dot[-n'[t],nperp[t]]/ρ[t];

Plot[τg[t],{t,0,2Pi}]

So the torsion is indeed nonvanishing.

Composite Picture

projcoords1=Table[{Γ[t][[1]],Γ[t][[2]],-1.1}, {t,0,2Pi,Pi/60}];

g=Graphics3D[{Thickness[0.011],Purple,Line[coords]}];

g1=Graphics3D[{Gray,Thickness[0.007],Line[projcoords1]}];

Show[{g,g1},Boxed->False]