Surface folding Demonstration

Jason Cantarella, June 2011

This notebook contains a quick demonstration of surface folding showing the effect on the normals as a polyhedral surface with constant (zero) curvature deforms around a vertex. To simplify the coding, we're going to assume that the vertex angles are all constant and all the lengths of the edges are one.

We now need a function which converts bending angles along edges incident to the central vertex to triangles in space. We will do this iteratively, so we start with a function which takes two adjacent guys and a bending angle and returns the next guy:

VertexAngle = Pi/3; EdgeLength = 1.0;

TriangleNormal[A_,B_] :=  Normalize[Cross[A,B]];

NextVertexPair[{A_,B_},BendingAngle_] := Module[{NewNormal},
NewNormal = RotationTransform[BendingAngle,B][TriangleNormal[A,B]];
{B,RotationTransform[VertexAngle,NewNormal][EdgeLength*Normalize[B]]}
];

Now we try a little test.

TriangleNormal[{1,0,0},{Cos[Pi/3],Sin[Pi/3],0}]

NextVertexPair[{{1,0,0},{Cos[Pi/3],Sin[Pi/3],0}},0]

So far, so good. We now try to apply that to a chain of bending angles.

ToTriangles[BendingAngles_] := FoldList[NextVertexPair,{{1,0,0},{Cos[Pi/3],Sin[Pi/3],0}},BendingAngles];

Here's an example:

ToTriangles[{0,0.2,0.3,0.2,-0.3}]

This will make more sense if we convert these guys to graphics.

ColorList = {Red, Green, Blue, Yellow, Purple, Gray};

ToGraphics[EdgePairs_] := Graphics3D[Table[{EdgeForm[Directive[Darker[Blue],Opacity[0.7]]],Directive[Opacity[0.7],RotateLeft[ColorList,i-1][[1]]],Polygon[{EdgePairs[[i,1]],EdgePairs[[i,2]],{0,0,0}}]},{i,1,Length[EdgePairs]}],Boxed->False];

ToGraphics[ToTriangles[{0,0.2,0.3,0.2,-0.2}]]

This seems to be working more or less as expected. So let's work on closing the polygon now. We need to work out the position of the last vertex so that the vertex angles will be correct and so that the edge lengths will work out. We use the fact that the location of the last vertex is along the normal to the triangle connecting the last and first vertices of the polygon and lies along the circle centered at the

ToClosedTriangles[BendingAngles_] := Module[{SideLength,LastNormal,PolygonSoFar,F,L,M,FLdist,Rad,RotAngle,LastVert,NewTriangles,Up,AvgNormal,RotVec,VP,TriangleNormals,RF},

PolygonSoFar = Prepend[ToTriangles[BendingAngles][[All,2]],{1,0,0}];
SideLength = Sqrt[2*EdgeLength^2 - 2*EdgeLength^2*Cos[VertexAngle]];
F = PolygonSoFar[[1]]; L = PolygonSoFar[[-1]];
FLdist = Norm[F - L];
M = (F + L)/2.0;

If[SideLength > FLdist/2.0,

Rad = Sqrt[SideLength^2 - (FLdist/2.0)^2];
RotAngle = 1.0*ArcCos[(Norm[M]^2+ SideLength^2 - Rad^2)/(2*SideLength*Norm[M])];
LastVert = SideLength*Normalize[RotationTransform[RotAngle,F-L][M]];
NewTriangles = Partition[Partition[Flatten[{ToTriangles[BendingAngles],{L,LastVert},{LastVert,F}}],3],2];

"We now want to rotate these guys to a consistent orientation in space";

TriangleNormals = Table[Normalize[Cross[NewTriangles[[i,2]],NewTriangles[[i,1]]]],{i,1,Length[NewTriangles]}];
AvgNormal = (1/Length[NewTriangles])*Sum[TriangleNormals[[i]],{i,1,Length[TriangleNormals]}];

RotVec = If[Norm[Cross[{0,0,1},AvgNormal]] > 0.01,Cross[{0,0,1},AvgNormal],RotVec = {1,0,0}];
RF = RotationTransform[-VectorAngle[{0,0,1},AvgNormal],RotVec];

Up = -Sum[PolygonSoFar[[i]],{i,1,Length[PolygonSoFar]}];
VP = PolygonSoFar[[5]]+PolygonSoFar[[4]];

{Map[RF,NewTriangles,{2}],M,LastVert,F,L,Up,VP},

"Can't close this polygon"
]

];

We now try a very simple test of this stuff:

ToClosedTriangles[{0.0,0.0,0.0}]

Now we need to see the normals of the various polygons and the total spherical area enclosed:

TriangleNormals[BendingAngles_] := Module[{Triangles,M,LastVert,F,L,U},
{Triangles,M,LastVert,F,L,U,VP} = ToClosedTriangles[BendingAngles];
Table[Normalize[Cross[Triangles[[i,2]],Triangles[[i,1]]]],{i,1,Length[Triangles]}]
];

Weird. Let's start with the polygon itself.

SphericalPolygon[Vertices_] := Module[{Verts,i,s,poly,spheres},
Verts = Append[Vertices,Vertices[[1]]];
poly = Table[ParametricPlot3D[Normalize[Verts[[i]]*(1-s) + Verts[[i+1]]*(s)],{s,0,1},PlotRange->{{-1,1},{-1,1},{-1,1}},Boxed->False,Axes->None,PlotPoints->200],{i,1,Length[Verts]-1}];
spheres = Table[Graphics3D[{Directive[RotateLeft[ColorList,i-1][[1]] ],Sphere[Verts[[i]],0.025]}],{i,1,Length[Verts]} ];
Join[poly,spheres]
];

Show[SphericalPolygon[TriangleNormals[{0.2,0.2,0.19}]],Graphics3D[{Opacity[0.2],Sphere[{0,0,0},1]}]]

And now the final demonstration:

Manipulate[{NewTriangles,M,LastVert,F,L,U,VP} = ToClosedTriangles[{angle,angle,(0.9)*angle}];
Grid[{{Show[ToGraphics[NewTriangles],ImageSize->400,ViewVertical->{0,0,1}],Show[SphericalPolygon[TriangleNormals[{angle,angle,(0.9)*angle}]],Graphics3D[{Opacity[0.6],Sphere[{0,0,0},1]}],ImageSize->400,ViewVertical->{0,0,1}]}}],{angle,0,1.29}]

Here’s some code to generate a frame-by-frame animation and save it to disk.

AnimatedVersion = Table[{NewTriangles,M,LastVert,F,L,U,VP} = ToClosedTriangles[{angle,angle,(0.9)*angle}];
Grid[{{Show[ToGraphics[NewTriangles],ImageSize->400,ViewVertical->{0,0,1}],Show[SphericalPolygon[TriangleNormals[{angle,angle,(0.9)*angle}]],Graphics3D[{Opacity[0.6],Sphere[{0,0,0},1]}],ImageSize->400,ViewVertical->{0,0,1}]}}],{angle,0,1.29,0.01}];

Export["FoldingAnimation.png",AnimatedVersion[[1]]]

Export["FoldingSplash.png",AnimatedVersion[[130]]]

ListAnimate[AnimatedVersion,24]

Export["FoldingMovie.mov",AnimatedVersion]

Now it is easier to see the polygon if we look from the top down. Here we need to set the ViewVertical as well to make sure that the images are registered with each other in 3d. (Otherwise, they seem to come out slightly rotated.)

TopViewAnimatedVersion = Table[{NewTriangles,M,LastVert,F,L,U,VP} = ToClosedTriangles[{angle,angle,(0.9)*angle}];
Grid[{{Show[ToGraphics[NewTriangles],ImageSize->400,ViewVector->{0,0,3},ViewVertical->{1,0,0}],Show[SphericalPolygon[TriangleNormals[{angle,angle,(0.9)*angle}]],Graphics3D[{Opacity[0.6],Sphere[{0,0,0},1]}],ImageSize->400,ViewVector->{0,0,3},ViewVertical->{1,0,0}]}}],{angle,0,1.29,0.01}];

Export["TopViewFoldingMovie.mov",TopViewAnimatedVersion]

Export["TopViewFoldingAnimation.png",AnimatedVersion[[1]]]

ListAnimate[TopViewAnimatedVersion,24]