home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GEOMETRY.PAK / POLYTOPE.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  4.6 KB  |  183 lines
  1.  
  2. (* :Title: Polytopes *)
  3.  
  4. (* :Author: Stephen Wolfram *)
  5.  
  6. (* :Summary: Regular Polygons and Polyhedra *)
  7.  
  8. (* :Context: Geometry`Polytopes` *)
  9.  
  10. (* :Package Version: 1.2 *)
  11.  
  12. (* :Copyright: Copyright 1987,1990 *)
  13.  
  14. (* :History:
  15.     Modified by E.C.Martin (Wolfram Research), December 1990
  16.     Version 1.1 by Stephen Wolfram (Wolfram Research), February 1987
  17. *)
  18.  
  19. (* :Keywords: *)
  20.  
  21. (* :Source:
  22.     H. S. M. Coxeter, "Regular Polytopes", (Dover, 1973) *)
  23.  
  24. (* :Warning: none *)
  25.  
  26. (* :Mathematica Version: 2.0 *)
  27.  
  28. (* :Limitation: none *)
  29.  
  30. (* :Discussion: *)
  31.         
  32.         
  33.  
  34. BeginPackage["Geometry`Polytopes`"]
  35.  
  36. Vertices::usage =
  37.     "Vertices[polytope] gives the number of vertices of polytope."
  38. Edges::usage =
  39.     "Edges[polytope] gives the number of edges of polytope."
  40. Faces::usage=
  41.     "Faces[polytope] gives the number of faces of polytope."
  42. Coords::usage = 
  43.     "Coords[polytope] gives a list of the coordinates of vertices."
  44.     (** Note: edges are not necessarily normalized to unit length **)
  45. Area::usage =
  46.     "Area[polytope] gives the area of each face with unit edge length."
  47. Inscribed::usage =
  48.     "Inscribed[polytope] gives the radius of an inscribed circle/sphere."
  49. Circumscribed::usage =
  50.     "Circumscribed[polytope] gives the radius of a circumscribed
  51.     circle/sphere."
  52. Volume::usage =
  53.     "Volume[polytope] gives the volume with unit edge length."
  54. Dual::usage =
  55.     "Dual[p] gives the dual of polytope p (if it exists)."
  56. Schlafli::usage =
  57.     "Schlafli[p] gives the Schlafli symbol for polytope p."
  58.  
  59. Map[(Evaluate[#]::"usage" =
  60.     StringJoin[ToString[#], " is a polygon."])&,
  61.     {Digon,Triangle,Square,Pentagon,Hexagon,Heptagon,Octagon,Nonagon,
  62.     Decagon,Undecagon,Dodecagon}]
  63.  
  64. Map[(Evaluate[#]::"usage" =
  65.     StringJoin[ToString[#], " is a polyhedron."])&,
  66.     {Tetrahedron, Cube, Octahedron, Dodecahedron, Icosahedron}]
  67.  
  68.  
  69. Begin["`Private`"]
  70.  
  71.  
  72. (* 2 dimensions *)
  73.  
  74. Digon =     polygon[2]
  75. Triangle =     polygon[3]
  76. Square =    polygon[4]
  77. Pentagon =    polygon[5]
  78. Hexagon =    polygon[6]
  79. Heptagon =    polygon[7]
  80. Octagon =    polygon[8]
  81. Nonagon =    polygon[9]
  82. Decagon =    polygon[10]
  83. Undecagon =    polygon[11]
  84. Dodecagon =    polygon[12]
  85.  
  86. Vertices[polygon[n_]] ^=         n
  87. Edges[polygon[n_]] ^=             n
  88. Faces[polygon[n_]] ^=             1
  89. Coords[polygon[n_Integer]] ^:=
  90.             Table[{Cos[2Pi i/n], Sin[2Pi i/n]}, {i,1,n}]
  91. Area[polygon[n_Integer]] ^=         n/(4 Tan[Pi/n])
  92. Inscribed[polygon[n_Integer]] ^=     1/(2 Tan[Pi/n])
  93. Circumscribed[polygon[n_Integer]] ^=     1/(2 Sin[Pi/n])
  94.  
  95.  
  96.  
  97. (* 3 dimensions *)
  98.  
  99. PT$AllCyc[list_] := Array[RotateLeft[list,#]&, Length[list], 0]
  100.  
  101. PT$AllSign = Flatten[Array[-1^List[##]&, {2,2,2}, 0], 2]
  102.  
  103.  
  104. (* Tetrahedron *)
  105.  
  106. Vertices[Tetrahedron] ^=    4
  107. Edges[Tetrahedron] ^=        6
  108. Faces[Tetrahedron] ^=        4
  109. Coords[Tetrahedron] ^=         {{1,1,1}} ~Join~ PT$AllCyc[{1,-1,-1}]
  110. Area[Tetrahedron] ^=         Sqrt[3]/4
  111. Inscribed[Tetrahedron] ^=     Sqrt[6]/12
  112. Circumscribed[Tetrahedron] ^=     Sqrt[6]/4
  113. Volume[Tetrahedron] ^=         Sqrt[2]/12
  114. Dual[Tetrahedron] ^=         Tetrahedron
  115. Schlafli[Tetrahedron] ^=     {3,3}
  116.  
  117. (* Cube *)
  118.  
  119. Hexahedron = Cube
  120.  
  121. Vertices[Cube] ^=         8
  122. Edges[Cube] ^=             12
  123. Faces[Cube] ^=             6
  124. Coords[Cube] ^=         PT$AllSign
  125. Area[Cube] ^=             1
  126. Inscribed[Cube] ^=         1/2
  127. Circumscribed[Cube] ^=         Sqrt[3]/2
  128. Volume[Cube] ^=         1
  129. Dual[Cube] ^=             Octahedron
  130. Schlafli[Cube] ^=         {4,3}
  131.  
  132. (* Octahedron *)
  133.  
  134. Vertices[Octahedron] ^=     6
  135. Edges[Octahedron] ^=         12
  136. Faces[Octahedron] ^=         8
  137. Coords[Octahedron] ^=        PT$AllCyc[{1,0,0}] ~Join~ PT$AllCyc[{-1,0,0}]
  138. Area[Octahedron] ^=         Sqrt[3]/4
  139. Inscribed[Octahedron] ^=     Sqrt[6]/6
  140. Circumscribed[Octahedron] ^=     Sqrt[2]/2
  141. Volume[Octahedron] ^=         Sqrt[2]/3
  142. Dual[Octahedron] ^=         Cube
  143. Schlafli[Octahedron] ^=     {3,4}
  144.  
  145. (* Dodecahedron *)
  146.  
  147. Vertices[Dodecahedron] ^=     20
  148. Edges[Dodecahedron] ^=         30
  149. Faces[Dodecahedron] ^=         12
  150. Coords[Dodecahedron] ^=
  151.     PT$AllSign ~Join~ 
  152.        Flatten[
  153.           Array[PT$AllCyc[{0,(-1)^#1 GoldenRatio^-1,(-1)^#2 GoldenRatio}]&,
  154.              {2,2}],
  155.               2]
  156. Area[Dodecahedron] ^=         Sqrt[25+10 Sqrt[5]]/4
  157. Inscribed[Dodecahedron] ^=     Sqrt[250+110 Sqrt[5]]/20
  158. Circumscribed[Dodecahedron] ^=     (Sqrt[15]+Sqrt[3])/4
  159. Volume[Dodecahedron] ^=     (15 + 7 Sqrt[5])/4
  160. Dual[Dodecahedron] ^=         Icosahedron
  161. Schlafli[Dodecahedron] ^=     {5,3}
  162.  
  163. (* Icosahedron *)
  164.  
  165. Vertices[Icosahedron] ^=     12
  166. Edges[Icosahedron] ^=         30
  167. Faces[Icosahedron] ^=         20
  168. Coords[Icosahedron] ^=
  169.     Flatten[ Array[PT$AllCyc[{0,(-1)^#1 GoldenRatio,(-1)^#2}]&,
  170.         {2,2}],
  171.         2]
  172. Area[Icosahedron] ^=         Sqrt[3]/4
  173. Inscribed[Icosahedron] ^=     Sqrt[42+18 Sqrt[5]]/12
  174. Circumscribed[Icosahedron] ^=     Sqrt[10+2 Sqrt[5]]/4
  175. Volume[Icosahedron] ^=         5 (3 + Sqrt[5])/12
  176. Dual[Icosahedron] ^=         Dodecahedron
  177. Schlafli[Icosahedron] ^=     {3,5}
  178.  
  179. End[]
  180.  
  181. EndPackage[]
  182.  
  183.