Golden ratio
Golden ratio
Golden rectangle and logarithmic spiral
Golden rectangle and logarithmic spiral
Sándor Kabai
Quarter circles are used on the surface of cubes to approximate a logarithmic spiral. The series of cubes are placed on one another with their edges in contact. Then the the cubes are rotated along their contacting lines. As a result the cubes are folded into a golden rectangle, and the quarter circles add together to form a spiral. The size of each cube in the series is reduced in the proportion of the golden ration. (Notice the motion similar to that of catapults. The velocity of each cube is larger than the previous one.)
For more details see: https://community.wolfram.com/groups/-/m/t/2286059
Quarter circles are used on the surface of cubes to approximate a logarithmic spiral. The series of cubes are placed on one another with their edges in contact. Then the the cubes are rotated along their contacting lines. As a result the cubes are folded into a golden rectangle, and the quarter circles add together to form a spiral. The size of each cube in the series is reduced in the proportion of the golden ration. (Notice the motion similar to that of catapults. The velocity of each cube is larger than the previous one.)
For more details see: https://community.wolfram.com/groups/-/m/t/2286059
In[]:=
Manipulate[fi=GoldenRatio;h=Sqrt[2]/2;s2=Sqrt[2];s1=ParametricPlot3D[{Sin[x]+h,-0.5,Cos[x]+h},{x,5Pi/4,7Pi/4}][[1]];cub=PolyhedronData["Cube"][[1]];c0={Translate[Rotate[cub,ArcTan[1],{0,1,0}],{0,0,h}]};c1={Translate[Scale[Rotate[{c0,Yellow,s1,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}]};c2=Translate[Scale[Rotate[{c0,Green,c1,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}];c3=Translate[Scale[Rotate[{c0,Yellow,c2,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}];c4=Translate[Scale[Rotate[{c0,Green,c3,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}];c5=Translate[Scale[Rotate[{c0,Yellow,c4,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}];c6=Translate[Scale[Rotate[{c0,Green,c5,s1},rot,{0,1,0}],0.618,{0,-0.5,0}],{0,0,2h}];ay=Cylinder[{{0,-1,0},{0,1,0}},0.05];Graphics3D[{{Yellow,Scale[cub,0.99]},s1,Cyan,c0,Yellow,c6,Red,ay},SphericalRegionTrue,BoxedFalse,PlotRange{{-1.5,1.5},{-1,1},{-0.4,3.6}},ViewAngle0.25],{{rot,0,"rotate"},-Pi/2,Pi/2},TrackedSymbols{rot}]
Out[]=
