Three interwoven rings

Sándor Kabai
This is a summary of my memos dealing with three interwoven rings with Borromean rings among them.

International Mathematical Union (IMU) logo

In[]:=
Manipulate[Module[{r,g1,g3,g2,ico,icon},r=a+Cos[2*t];g1=ParametricPlot3D[{r*Sin[t],r*Cos[t],0},{t,(-gen)*Pi,gen*Pi},PerformanceGoal->"Speed",PlotStyle->Tube[dia]][[1]];​​g3={Rotate[Rotate[g1,Pi/2+0.001,{1,0,0}],Pi/2+0.001,{0,1,0}]};g2=Rotate[Rotate[g1,Pi/2+0.001,{0,1,0}],Pi/2+0.001,{1,0,0}];ico=GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Line[PolyhedronData["Icosahedron","EdgeIndices"]]]/.Line->Tube;icon=Rotate[Scale[ico,3.5*{1,1,1},{0,0,0}],1,{0,1,0}];Graphics3D[{Specularity[0.8],g1,g2,g3,If[icos,icon,{}]},PlotRange->All,SphericalRegion->True,Boxed->False,ViewPoint->{20,-20,20}]],{{a,2.5,"depression"},0,10},{{dia,0.3,"tube diameter"},0.2,2},{{gen,1,"generate"},0.1,1},{{icos,False,"show icosahedron"},{True,False}},TrackedSymbols->{a,dia,gen,icos}]
Out[]=
​
depression
tube diameter
generate
show icosahedron
Torus coils are interwoven
In[]:=
Manipulate[​​par=ParametricPlot3D[{​​(ext+Cos[turnx])Cos[knotx],​​(ext+Cos[turnx])Sin[knotx],​​Sin[turnx]},​​{x,0,2Pi},PlotStyleTube[dia],ColorFunction->"TemperatureMap"][[1]];​​core=RevolutionPlot3D[{0.6Sin[t]+2,0.6Cos[t]},{t,0,2Pi},{z,0,2Pi},MeshNone,PlotStyleFaceForm[Yellow,Blue]][[1]];​​Graphics3D[{core,par},AxesFalse,BoxedFalse,ViewPoint{0,0,6},ImageSize200],​​{{turn,3,"number of turns"},1,10,1,RadioButton},​​{{knot,3,"knot"},1,6,1,RadioButton},​​{{ext,2,"extend"},-5,5},​​{{dia,0.3,"diameter"},0.04,0.5},​​TrackedSymbols{turn,knot,ext,dia}]
Out[]=
​
number of turns
1
2
3
4
5
6
7
8
9
10
knot
1
2
3
4
5
6
extend
diameter
In[]:=
par3=Table[Rotate[par,i2Pi/3,{0,0,1}],{i,3}];​​Graphics3D[{core,par3}]
Out[]=
In[]:=
par3=Table[Rotate[par,i2Pi/3,{0,0,1}],{i,3}];​​Graphics3D[{par3},ViewPoint{0,0,100},BoxedFalse,SphericalRegionTrue]
Out[]=
Three ring puzzle
In[]:=
Manipulate[z=0.5;​​c1=Cuboid[{-x,-y,-3z},{x,y,3z}];​​c2=Cuboid[{-x,3y,-3z},{x,5y,3z}];​​c3=Translate[Cuboid[{-x,-y,3z},{x,5y,5z}],{0,0,un-open}];​​c4=Cuboid[{-x,-y,-5z},{x,5y,-3z}];​​f1=Translate[{c1,c2,c3,c4},{0,-2y,open}];​​f2={Specularity[0.6],RGBColor[0.2,0.8,0.7],Rotate[Rotate[f1,-Pi/2+0.001,{0,0,1}],Pi/2+0.001,{1,0,0}]};​​f3={Specularity[0.8],RGBColor[1,0.8,0.2],Rotate[Rotate[f1,Pi/2+0.001,{1,0,0}],Pi/2+0.001,{0,0,1}]};​​Graphics3D[{f1,f2,f3},BoxedFalse,SphericalRegionTrue,ViewAngle0.08,ImageSize300,ViewPoint{6,-6,6},PlotRange6.5{{-1,1},{-1,1},{-1,1}}],​​{{open,-3,"close-open"},0,-3},​​{{un,3,"lock-unlock"},0,3},​​{{x,0.5,"size x"},0.2,0.5},​​{{y,0.5,"size y"},0.2,0.5},TrackedSymbolsManipulate]
Out[]=
​
close-open
lock-unlock
size x
size y

Escher solid as a puzzle with six congruent pieces

Any two of the rings are not interwoven