Unfolded Approximation to a Hemisphere

The animated GIF featured below are a sort of slide show which give increasing levels of precision in polyhedral approximations to a hemisphere. The SVG one works properly in Google Chrome, but it may not work in all browsers. In theory, you could print these out, cut along the outline, and fold along the internal lines and you would have a polyhedral approximation to a sphere—if you use a lot of tape and your very best dexterity. More precisely, all of the corners would be coincident with the hemisphere being approximated. Notice that as the number of fold lines (latitudinal-ish lines) increases, for a given number of segments (longitudinal-ish divisions) the extent of the unfolded approximation approaches the grey line, which (probably) represents the limiting extent of these approximations. Specifically, this circle has radius of πr/2 or one fourth the circumference of the approximated sphere.

I wrote the code which generates this sequence of pictures in Maxima, a computer algebra system. The code is below and you can modify the range variable near the end to change the level of precision in the resulting pictures. The pattern for each range item is

[number of segments, [starting latitude divisions, ending latitude divisions]]

The "segments" are longitudinal segments like an orange. The latitude divisions are the number of latitude divisions in each of the segments.

load(draw)$ ExplodedHemiSphereLine(radius, deltaAlpha, theta) := block([line,vc,alpha,xpnm1,ypn,upperThresh,x,y,w,xpn], line: Polyline([0,0]), vc: radius*sqrt(2*(1-cos(deltaAlpha))), alpha: deltaAlpha, xpnm1: 0, ypn: 0, upperThresh: 3.14159265358979/2 + deltaAlpha/2, while alpha <= upperThresh do ( x: radius*sin(alpha), y: radius*cos(alpha), w: x*sqrt(2*(1-cos(theta))), xpn: w/2, dvn: sqrt(vc^2 - (xpn - xpnm1)^2), ypn: ypn + dvn, xpnm1: xpn, line: append(line, Polyline([xpn, ypn])), alpha: alpha + deltaAlpha ), return(line) )$ Reflect(points) := map(lambda([p],[-p[1],p[2]]), points)$ MakePrimaryLines(polyLine) := block([reflection,lis], reflection: Reflect(polyLine), lis: [polyLine, reflection], for i: 2 thru length(polyLine) do ( lis: append(lis, [Line(part(polyLine,i),part(reflection,i))]) ), return(lis) )$ RotatePoint(point, rotationVector) := [point[1]*rotationVector[1] - point[2]*rotationVector[2], point[1]*rotationVector[2] + point[2]*rotationVector[1]]; RotateLine(line, rotationVector) := block([p,res], res: part(line,0)(), for p in line do ( res: append(res, part(line, 0)(RotatePoint(p, rotationVector))) ), return(res) )$ RoundTheWorld(line, rotationVector, Ns) := block([lines,i], lines: [line], for i: 2 thru Ns do ( lines: append(lines, [RotateLine(lines[i-1], rotationVector)]) ), return(lines) )$ ExplodedHemiSphere(radius, Na, Ns) := block([deltaAlpha,theta,line,baseLines,allLines,rotationVector,obj], deltaAlpha: 3.14159265358979/(2*Na), theta: 2*3.14159265358979/Ns, line: ExplodedHemiSphereLine(radius, deltaAlpha, theta), baseLines: MakePrimaryLines(line), allLines: [], rotationVector: [cos(theta), sin(theta)], for obj in baseLines do ( allLines: append(allLines, RoundTheWorld(obj, rotationVector, Ns)) ), return(allLines) )$ FindMinMax(LineObjects, index) := block([min,max,p,obj], min: part(LineObjects[1],1)[index], max: min, for obj in LineObjects do ( for p in obj do ( if p[index] < min then ( min: p[index] ) else if p[index] > max then ( max: p[index] ) ) ), return([min, max]) )$ MakeScene(LineObjects) := block([res], res: gr2d(color = grey, fill_color = white, points_joined = true, point_type = none, axis_top = false, axis_bottom = false, axis_left = false, axis_right = false, xtics = none, ytics = none, ellipse(0,0,float(%pi/2),float(%pi/2),0,360), color = black), for obj in LineObjects do ( if part(obj, 0) = Line then ( res: append(res,gr2d(points([[part(obj,1)[1], part(obj,1)[2]], [part(obj,2)[1], part(obj,2)[2]]]))) ) else if part(obj, 0) = Polyline then ( res: append(res,gr2d(points(makelist([part(obj,i)[1],part(obj,i)[2]],i,1,length(obj))))) ) ), res )$ /* main */ ranges: [[3, [1, 3]], [4, [1, 4]],[5,[1,5]],[6,[1,6]],[7,[1,7]],[8,[1,8]],[9,[1,9]],[10,[1,10]],[11,[1,11]],[12,[1,12]],[13,[1,13]],[14,[1,14]],[15,[1,15]],[16,[1,16]],[17,[1,17]]]$ exp_ranges: map(lambda([u],makelist([1,i,u[1]],i,u[2][1],u[2][2])),ranges)$ ranges: []$ for i: 1 thru length(exp_ranges) do ranges: append(ranges,exp_ranges[i]); draw( delay = 100, dimensions = [500,500], file_name = "C:/Users/whateverpath/whatever", terminal = 'animated_gif, map(lambda([u],MakeScene(ExplodedHemiSphere(u[1],u[2],u[3]))),ranges) )$