Pensieve header: Ribbon drawings continuing pensieve://2015-07/PolyPoly/ and pensieve://Projects/Killam-2017/.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\RibbonKnots"];

ribbon=Graphics3D[
{
Green, Tube[{{-1,0,0},{1,0,0}},0.05],
Red,
Tube[{{-3,1,0},{3,1,0}}, 0.1],Tube[{{3,-1,0},{-3,-1,0}}, 0.1],
Tube[{{-1,0,-2}, {-1,0,2}}, 0.1],  Tube[{{1,0,2}, {1,0,-2}}, 0.1],
Opacity[0.6],Blue,EdgeForm[None],
Polygon[{{-3,1,0},{3,1,0}, {3,-1,0},{-3,-1,0}}],
Polygon[{{-1,0,-2}, {-1,0,2},{1,0,2}, {1,0,-2}}]
},
Boxed -> False, ViewPoint->{-1.05544,-2.48236,2.04302},ViewVertical->{-0.355079,0.320399,1.36975}
]

ribbon2=Graphics3D[
{
Green, Tube[{{0,-1,0},{0,1,0}},0.08],
Red,Tube[{{-2,2,0},{2,2,0}}, 0.1],Tube[{{2,-2,0},{-2,-2,0}}, 0.1],
Red,Tube[{{0,-1,-2}, {0,-1,2}}, 0.1],  Tube[{{0,1,2}, {0,1,-2}}, 0.1],
Opacity[0.8],Blue,EdgeForm[None],Specularity[1],
Polygon[{{-2,2,0},{2,2,0}, {2,-2,0},{-2,-2,0}}],
Polygon[{{0,-1,-2}, {0,-1,2},{0,1,2}, {0,1,-2}}]
},
Boxed -> False,
ViewPoint->{-0.991586,-3.10187,0.919339},ViewVertical->{-0.0564272,-0.237344,0.969785}
]

Export["../Discovery-2024/figs/RibbonSingularity.pdf", ImageCrop@ribbon2]

dz=1/32; dθ=π/64;
Seifert4Ribbon=Graphics3D[
{
Red,Tube[{{-2,2,0},{2,2,0}}, 0.1],Tube[{{2,-2,0},{-2,-2,0}}, 0.1],
Red,Tube[{{0,-1,-2}, {0,-1,2}}, 0.1],  Tube[{{0,1,2}, {0,1,-2}}, 0.1],
Green, Tube[Table[{1.5Cos[θ],1.5Sin[θ],0},{θ,0,2π,dθ}],0.05],
Opacity[0.8],Blue,EdgeForm[None],Specularity[1],
DiscretizeRegion@RegionDifference[
Polygon[{{-2,2,0},{2,2,0}, {2,-2,0},{-2,-2,0}}],
Ball[]
],
λ[z_,θ_]:={Max[0,1-(Sqrt[z/2])]Sin[θ],Cos[θ],z};
Table[
Polygon[{λ[z,θ],λ[z+dz,θ],λ[z+dz,θ+dθ], λ[z,θ+dθ]}],
{z,0,2-dz,dz},{θ,0,π-dθ,dθ}
],
λ[z_,θ_]:={-Max[0,1-(Sqrt[z/2])]Sin[θ],Cos[θ],-z};
Table[
Polygon[{λ[z,θ],λ[z+dz,θ],λ[z+dz,θ+dθ], λ[z,θ+dθ]}],
{z,0,2-dz,dz},{θ,0,π-dθ,dθ}
]
},
Boxed -> False,
ViewPoint->{-0.991586,-3.10187,0.919339},ViewVertical->{-0.0564272,-0.237344,0.969785}
]

Export["../Discovery-2024/figs/Seifert4Ribbon.pdf", ImageCrop@Seifert4Ribbon]

dt=π/32;
γ1[t_]:={2Cos[t]-3/2,Sin[t],0};
γ2[t_]:={3/2-2Cos[t],0,Sin[t]};
clasp=Graphics3D[
{
Green, Tube[{{-1/2,0,0}, {1/2,0,0}}, 0.05],
Red,
Tube[Table[γ1[t], {t, -π/2,π/2,dt}],0.1],
Tube[Table[γ2[t], {t, -π/2,π/2,dt}],0.1],
Opacity[0.6],Blue,EdgeForm[None],
Table[Polygon[{{-3/2,0,0},γ1[t],γ1[t+dt]}], {t,-π/2,π/2-dt,dt}],
Table[Polygon[{{3/2,0,0},γ2[t],γ2[t+dt]}], {t,-π/2,π/2-dt,dt}]
},
Boxed->False,ViewPoint->{0.530012,-2.81796,1.79672},ViewVertical->{0.0301724,-0.099258,1.45049}
]

pts={
{-1,-1,0}, {-1,-1,3},
{-1,-1,3},{-1,0,3},{-1,1,3},
{0,2,1}, {1,2,1},{3,2,1},
{3,0,1},{1,0,1},{0,0,1}
};
pts=Join[pts, Reverse[pts /. {x_,y_,z_} :> {-x,-y,z}]];
Graphics3D[BezierCurve[pts]] // Rasterize

zs=0.5;
γs=BezierFunction/@Partition[pts /. {x_,y_,z_} :> {x,y,z*zs}, 4,3];
dt=1/120; r=0.1;
RibbonKnot=Graphics3D[{
Green,
Tube[{{-1,0,-zs}, {-1,0,zs}}, r/1.5],
Tube[{{1,0,-zs}, {1,0,zs}}, r/1.5],
Red,CapForm[None],
Table[{
Tube[Table[γ[t], {t,0,1,dt}],r],
Tube[Table[γ[t]*{1,1,-1}, {t,0,1,dt}], r]
}, {γ,γs}],
Opacity[0.8],Blue,EdgeForm[None],Specularity[1],
Table[
Polygon[{γ[t], γ[t+dt], {1,1,-1}*γ[t+dt],{1,1,-1}*γ[t]}],
{γ,γs}, {t,0,1-dt,dt}
]
},Boxed->False,ViewPoint->{1.73822,-2.13894,-1.96304},ViewVertical->{0.498569,-0.732403,-1.02979}]

Export["../Discovery-2024/figs/RibbonKnot.pdf", ImageCrop@RibbonKnot]