Frenet Frame

This notebook illustrates the concept of the Frenet frame and curvature.

(SetDirectory[ToFileName[Extract["FileName"/.NotebookInformation[EvaluationNotebook[]],{1},FrontEnd`FileName]]];)


n=5;  (* degree *)
ll=7;  (* domain intervals *)
knot=Join[Table[0,{i,0,n}],Table[i/ll,{i,1,ll-1}],Table[1,{i,0,n}]]//N;
ll=Length[knot]-2*n-1; (* domain intervals *)

dd=Table[{Cos[0.6t],Sin[0.6t],0.2*t},{t,0,ll+n-1,1}]//N;

dd=Table[{t,Sqrt[t]+0.3RandomReal[],0.1t^2},{t,0,ll+n-1,1}]//N;
(*dd={{0,0,0},{1,0,0},{1,1,0},{1,0,0},{2,0,1}}//N;*)
(*dd={{2.107012072628232`,0.5345017955805248`,0},{3.199627102464968`,0.43681937886679173`,0},{2.6563348866558423`,3.54793447582658`,0},{-1.0090687197805543`,4.857992513632747`,0},{-5.433587918250792`,1.449801937955173`,0},{-4.124798981180299`,-4.596534077114284`,0},{2.0782090233778834`,-7.857336474191923`,0},{9.742916305652201`,-2.215332946599599`,0},{8.342535060116404`,7.014893890300587`,0},{-0.6653766480173567`,12.32463551147173`,0},{-11.486584786499508`,5.842192027052816`,0},{-11.298441143383586`,-2.1985550037484156`,0},{-9.472081777385014`,-6.317207199716419`,0}} (*cubic, ll=10 *)
*)
dd={{2.3447719553398803`,0.7060862945513243`,0},{3.408099354240049`,0.9676362951424352`,0},{1.918648738806246`,2.726453516203428`,0},{2.218840664605672`,5.2990025422196005`,0},{-7.567966292373646`,4.5613673795229035`,0},{-5.130065445321827`,-7.839998653060135`,0},{10.374946992089676`,-8.499935802363796`,0},{11.55788514553702`,11.704675980036937`,0},{-5.11515465518081`,13.107216792754366`,0},{-12.160750197170032`,4.819712590005321`,0},{-11.629857258023627`,-3.1429949411653317`,0},{-9.436353050124987`,-6.3010716733097984`,0}}
points=Graphics3D[{Red,PointSize[0.025],Point[dd]}]; (*quntic, ll =7 *)

ddplot=Graphics3D[{Thick,Line[dd]}];

curve[t_]:=Sum[BSplineBasis[{n,knot},i,t]*dd[[i+1]],{i,0,n+ll-1}];
first[t_]:=(curve[t+0.0001]-curve[t])/0.0001;
second[t_]:= (first[t+0.0001]-first[t])/0.0001;
binormal[t_]:=Cross[first[t],second[t]];
normal[t_]:=Cross[first[t],binormal[t]]/Norm[Cross[first[t],binormal[t]]];
kappa[t_]:=Norm[Cross[first[t],second[t]]]/(Norm[first[t]])^3;
firstsurf[t_,u_]:=curve[t]+u*first[t];
kappasurf[t_,u_]:=curve[t]+3u*kappa[t]*normal[t];

cplot=ParametricPlot3D[curve[t],{t,knot[[1]],knot[[2n+ll+1]]},PlotStyle->{Thick,Green},Boxed-> False,ViewPoint->{-1.8,-1,1.7}];

{{2.107012072628232`,0.5345017955805248`,0},{3.199627102464968`,0.43681937886679173`},{2.6563348866558423`,3.54793447582658`},{-1.0090687197805543`,4.857992513632747`},{-5.433587918250792`,1.449801937955173`},{-4.124798981180299`,-4.596534077114284`},{2.0782090233778834`,-7.857336474191923`},{9.742916305652201`,-2.215332946599599`},{8.342535060116404`,7.014893890300587`},{-0.6653766480173567`,12.32463551147173`},{-11.486584786499508`,5.842192027052816`},{-11.298441143383586`,-2.1985550037484156`},{-9.472081777385014`,-6.317207199716419`}}

Explore arc length :

num=1000;
length=Table[0.0, {i,1,num}];
delt=(knot[[ 2n+ll+1]] - knot[[1]])/num;
arcs=Table[Norm[curve[(i+1)*delt]-curve[i*delt]],{i,1,num}];
length[[1]]=0.0;
Do[length[[i+1]]=length[[i]]+arcs[[i]],{i,1,num-1}]
ListLinePlot[length,Filling-> Axis]

Explore curvature :

kappasurfplot=ParametricPlot3D[kappasurf[t,u],{t,knot[[1]],knot[[2n+ll+1]]},{u,0,1},Boxed-> False,Mesh->None,Axes->False,PlotRange->Automatic,ViewPoint->{-1.8,-1,1.7}];

Plot[kappa[t],{t,knot[[1]],knot[[2n+ll+1]]-0.0003},Filling->Bottom,AxesOrigin->{0,0}]
(*Export["kappa-quintic-spiral.eps",%]*)
Show[{  kappasurfplot,cplot}]
(*Export["comb-quintic-spiral.eps",%] *)