WFL>[Thread mysteriously split into two ...] There seems to be a growing latency before posts to math-fun are appearing, leading people to respond to stale posts. BobB> Does anyone have the equations for either a Reuleaux or a Meissner tetrahedron that could be plugged into Mathematica? Try hal.archives-ouvertes.fr/docs/00/38/51/13/*PDF*/*spheroforms*.*pdf* Here's my attempt at plain Reuleaux. It produces a plausible Plot, but integrates to an absurd face area. Perhaps someone will be good enough to designate my error. If it's truly egregious, I point the finger of blame squarely at Neil, whose directions I was trying to follow. (His 3D printerware intersected the spheres for him.) In[728]:= four = PolyhedronData["Tetrahedron", "Faces"][[1]] Out[728]= {{0, 0, Sqrt[2/3] - 1/(2 Sqrt[6])}, {-(1/(2 Sqrt[3])), -(1/2), -(1/( 2 Sqrt[6]))}, {-(1/(2 Sqrt[3])), 1/2, -(1/(2 Sqrt[6]))}, {1/Sqrt[ 3], 0, -(1/(2 Sqrt[6]))}} (*Centroid is {0,0,0}:*) In[729]:= Plus @@ % Out[729]= {0, 0, 0} (*Edge lengths = 1 *) In[730]:= EuclideanDistance @@ # & /@ Permutations[%%, {2}] Out[730]= {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} In[731]:= ParametricPlot3D[ Table[{t, u, 1 - t - u}.Drop[four, {k}], {k, 4}], {t, 0, 1}, {u, 0, 1 - t}] (*plots the tetrahedron*) In[740]:= Table[# /. Solve[EuclideanDistance[four[[k]], #] == 1, v][[2]] &[ v*{t, u, 1 - t - u}.Drop[four, {k}]], {k, 4}] (*Purporting to project each flat face from {0,0,0} onto the unit sphere centered at the opposite vertex. Plot looks plausible:*) In[741]:= ParametricPlot3D[%, {t, 0, 1}, {u, 0, 1 - t}] (*Try for surface area of one face:*) In[742]:= Simplify[Cross[D[%740[[1]], t], D[%740[[1]], u]]] (*half a page of quadratic surds*) In[743]:= Simplify[Sqrt[%.%], 0 < t < 1 && 0 < u < 1] (*√ half a page of quadratic surds*) In[744]:= Integrate[%, {t, 0, 1}, {u, 0, 1 - t}] (* No progress *) In[745]:= N[%] Out[745]= 8.37513 This is way off the wall--should be <1. I'm being incredibly dumb. --rwg
participants (1)
-
Bill Gosper