The Union of reals and removal of duplicates

*To*: mathgroup at smc.vnet.net*Subject*: [mg8290] The Union of reals and removal of duplicates*From*: Russell Towle <rustybel at foothill.net>*Date*: Sun, 24 Aug 1997 04:46:31 -0400*Sender*: owner-wri-mathgroup at wolfram.com

Hi all, I have posted questions in the past concerning the Union of real numbers. This has continued to be an issue for me, but I have succeeded in finding solutions for some applications of this Union. For instance, consider the problem of, given an arbitrary Graphics3D polyhedron in Mathematica, to obtain a list of its vertices, with duplicates dropped; a list of its polygons, as a list of lists of indices into its vertices; and a list of its edges, as a list of lists of indices into its vertices. Here is my solution, where "obj" has been defined, perhaps, as obj = Polyhedron [ Dodecahedron ]; (*needs the Graphics "polyhedra" package*) (*****) Length [h = Level [obj, {-2}] ]; (*how many vertices altogether?*) Length [g = Union [ r = Rationalize [h, 10^-2] ] ]; (*how many distinct?*) (*now, what are the indices of the distinct in the altogether?*) s = Table [Flatten [Position[ r, x_ /; x==g[[i]] ] ], { i, Length [g] } ]; (*go back and get the un-rationalized distinct vertices*) v = h [[ Map[ First[#]&, s] ] ]; (*vertices*) (*****) So far so good. If there is a better, especially faster, way of accomplishing this, I would be pleased to know it. Below I find the polygons bounding the polyhedron "obj," and proceed to transform them into a list of indices into the vertices, "v." I overwrite some previous variables, such as h, but use some previous variables, such as g (the Rationalized Union of vertices). (*****) Length [h = Level [obj, {-3}] ]; (*how many polygons altogether?*) h = Rationalize[ h, 10^-2]; (*rationalize them*) (*now, what are the indices of the distinct in each polygon?*) s = Table[ Position[ h, x_ /; x==g[[i]] ], {i, Length [g]} ]; (*This gives the indices into g (hence 'v') of the polygons h*) gons = Table [qq = Position [s, x_List /; First[x]==j ]; Map[ #[[2]]&, Sort[ Table[ Join[{s[[ qq[[i,1]],qq[[i,2]] ]] [[2]]},{qq[[i,1]]} ], {i, Length[qq]}] ] (*Sort ends here*) ], (*Map ends here*) {j, Length[h]}]; (*****) Finally, with the polygons construed as lists of indices into vertices, find the edges, and remove duplicates. The slowest and most problematical part of all code is the Table below, given the not very descriptive name, "c." The indices have already been split into pairs, and it only remains to find and discard all those cases where the indices {i,j} reappear as {j,i}. When a polyhedron is very complex (has over, say, twenty or thirty faces), this Table of Positions can take a very very long time to create. (*****) (*find face indices and make edge indices*) rings = Map[Join[#,{First[#]}]&, gons ];(*add first index to end of list*) edges = Flatten[ Map[ Partition[#,2,1]&, rings], 1];(*break into pairs*) (*remove duplicates (indices in reverse order)*) c=Table[ Position[edges, x_ /; x == edges[[i]] || x == Reverse[edges[[i]]] ], {i,Length[edges]}]; f=Map[Take[#,1]&, Union[c]]; f=Flatten[f,2]; (*****) I have used these methods to build a function, wherein an arbitrary Mathemtica polyhedron is written to POV-Ray format, with spheres on every vertex, cylinders on every edge, and the faces divided into triangles as POV likes them. I will post this to MathSource as soon as I find out how to speed up the removal of edge duplicates. Russell Towle Giant Gap Press: books on California history, digital topographic maps P.O. Box 141 Dutch Flat, California 95714 ------------------------------ Voice: (916) 389-2872 e-mail: rustybel at foothill.net ------------------------------

**Re: Locating text in Show**

**RungeKutta**

**Re: Simplifying Sqrt[a^2*d^2] -> a*d**

**RungeKutta**