4
$\begingroup$

Dmccooey is a site that contains 3D virtual models and coordinates of a large variety of polyhedra.

An example of a coordinates file you can retrieve from the site is:

Propello Tetrahedron (canonical)

C0 = 0.139680581996106531822799916239
C1 = 0.509755332493385520099017792717
C2 = 0.606267870861478462919986663126

C0 = (cbrt(4 * (11 + 3 * sqrt(69))) - cbrt(4 * (3 * sqrt(69) - 11)) - 1) / 3
C1 = (cbrt(4 * (25 + 3 * sqrt(69))) + cbrt(4 * (25 - 3 * sqrt(69))) - 5) / 3
C2 = (cbrt(4 * (371 + 33*sqrt(69))) + cbrt(4 * (371 - 33*sqrt(69))) - 1) / 33

V0  = (  C1,   C0,  1.0)
V1  = (  C1,  -C0, -1.0)
V2  = ( -C1,  -C0,  1.0)
V3  = ( -C1,   C0, -1.0)
V4  = ( 1.0,   C1,   C0)
V5  = ( 1.0,  -C1,  -C0)
V6  = (-1.0,  -C1,   C0)
V7  = (-1.0,   C1,  -C0)
V8  = (  C0,  1.0,   C1)
V9  = (  C0, -1.0,  -C1)
V10 = ( -C0, -1.0,   C1)
V11 = ( -C0,  1.0,  -C1)
V12 = (  C2,  -C2,   C2)
V13 = (  C2,   C2,  -C2)
V14 = ( -C2,   C2,   C2)
V15 = ( -C2,  -C2,  -C2)

Faces:
{ 12,  0,  2, 10 }
{ 12, 10,  9,  5 }
{ 12,  5,  4,  0 }
{ 13,  1,  3, 11 }
{ 13, 11,  8,  4 }
{ 13,  4,  5,  1 }
{ 14,  2,  0,  8 }
{ 14,  8, 11,  7 }
{ 14,  7,  6,  2 }
{ 15,  3,  1,  9 }
{ 15,  9, 10,  6 }
{ 15,  6,  7,  3 }
{  0,  4,  8 }
{  1,  5,  9 }
{  2,  6, 10 }
{  3,  7, 11 }

Each time that I want to open such a polyhedron in mathematica, I copy the information and manually adjust it to fit the language for mathematica.

For example, I rewrote the information above to the code shown below:

C0 = 0.139680581996106531822799916239;
C1 = 0.509755332493385520099017792717;
C2 = 0.606267870861478462919986663126;

V0  = {  C1,   C0,  1.0};
V1  = {  C1,  -C0, -1.0};
V2  = { -C1,  -C0,  1.0};
V3  = { -C1,   C0, -1.0};
V4  = { 1.0,   C1,   C0};
V5  = { 1.0,  -C1,  -C0};
V6  = {-1.0,  -C1,   C0};
V7  = {-1.0,   C1,  -C0};
V8  = {  C0,  1.0,   C1};
V9  = {  C0, -1.0,  -C1};
V10 = { -C0, -1.0,   C1};
V11 = { -C0,  1.0,  -C1};
V12 = {  C2,  -C2,   C2};
V13 = {  C2,   C2,  -C2};
V14 = { -C2,   C2,   C2};
V15 = { -C2,  -C2,  -C2};

vTSIc = {};
For[i = 0, i <= 79, i++;
    AppendTo[vTSIc, ToExpression[StringJoin[{"V", ToString[i-1]}]]]
    ]
    
fTSIc = {{13,  1,  3, 11}, {13, 11,  10,  6}, {13,  6,  5,  1}, {14,  2,  4, 12}, 
    {14, 12,  9,  5}, {14,  5,  6,  2}, {15,  3,  1,  9 }, {15,  9, 12,  8}, 
    {15,  8,  7,  3}, {16,  4,  2,  10}, {16,  10, 11,  7}, {16,  7,  8,  4}, 
    {1,  5,  9}, {2,  6,  10}, {3,  7, 11}, {4,  8, 12}};

Show[Graphics3D[{EdgeForm[{Thick}], Polygon /@ Map[vTSIc[[#1]] & , fTSIc, {2}]}], PlotRange-> All,Boxed -> False]

canonical propello tetrahedron

I am sure there must be a more efficient way than manually changing all curved brackets () seen for the vertices V0-V15 to the curly ones {}, adding semi-colons ; to the end of the lines and copy-pasting the faces in a new list.

I am wondering if anyone has done this before or if there are ways to automate it.

Thank you in advance.

$\endgroup$
2
  • 1
    $\begingroup$ Are you aware of the polyhedra already built-in in Mathematica? Have a look at PolyhedronData[] $\endgroup$ May 5 at 14:23
  • $\begingroup$ Oh no I wasn't aware. Thank you! I didn't know there were so many built in in Mathematica. I cannot find the propellor solids in the list, is that correct? $\endgroup$
    – P Teeuwen
    May 5 at 17:18

2 Answers 2

4
$\begingroup$
getDMMCCOOEYpolyhedron = 
  Import["http://dmccooey.com/polyhedra/" <> # <> ".txt", "Lines"] &;

split =  If[Length[#] == 4, Drop[#, {2}], #] & @
  Map[DeleteCases["Faces:" | ""]] @
  Split[Drop[#, 2], ! StringStartsQ["Faces" | "V0" | "C0"] @ #2 &] &;

processStrings = Map @ 
  StringReplace[{"cbrt" -> "CubeRoot", "sqrt" -> "Sqrt", 
    "(" ~~ a__ ~~ ")" /; StringContainsQ[a, ","] :> "{" <> a <> "}",
    "=" ~~ a : Shortest[__] ~~ "=" ~~ __ :> "=" <> a}];

coordsAndFaceIndices = If[Length @ # == 2, {0, 1} + #,
  {#2, 1 + #3} & @@ #] & @ ToExpression[#, TraditionalForm] &;


fromDMCCCOOEY = coordsAndFaceIndices @* processStrings @* 
  split @* getDMMCCOOEYpolyhedron;

Examples:

{coords, faceIndices} = fromDMCCCOOEY @ "PropelloTetrahedron";

Graphics3D[GraphicsComplex[coords, Polygon @ faceIndices], Boxed -> False]

enter image description here

Graphics3D[GraphicsComplex[#, Polygon@#2], Boxed -> False] & @@ 
 fromDMCCCOOEY["GreatDisdyakisDodecahedron"]

enter image description here

Graphics3D[GraphicsComplex[#, Polygon@#2], Boxed -> False] & @@ 
 fromDMCCCOOEY["IcositruncatedDodecadodecahedron"]

enter image description here

$\endgroup$
3
  • $\begingroup$ When I try this approach with "Cube" I get an error saying " Function::slotn: Slot number 3 in {#2,1+#3}& cannot be filled from ({#2,1+#3}&)[{{0.5,0.5,0.5},{0.5,0.5,-0.5},{0.5,-0.5,0.5},{0.5,-0.5,-0.5},{-0.5,0.5,0.5},{-0.5,0.5,-0.5},{-0.5,-0.5,0.5},{-0.5,-0.5,-0.5}},{{0,1,5,4},{0,4,6,2},{0,2,3,1},{7,3,2,6},{7,6,4,5},{7,5,1,3}}]." And it doesn't print $\endgroup$
    – P Teeuwen
    May 8 at 15:18
  • 1
    $\begingroup$ @PTeeuwen, please use the updated coordsAndFaceIndices . $\endgroup$
    – kglr
    May 8 at 16:34
  • $\begingroup$ Awesome! Thank you $\endgroup$
    – P Teeuwen
    May 8 at 19:58
6
$\begingroup$

If you do not want to use built-in function PolyhedronData[] as proposed by @Sjoerd C. de Vries and want to train your Mathematica programming, you can automate the whole process of parsing the file. Below is an example – not the optimal or the most pedagogical one – of how you can do it by combining several functions for string and expression manipulation.

parseDmccooeyFile[fileName_] := 
  Module[{replaceParentheses, parse, initString, facesString, rules, vertices, faces},
   replaceParentheses[s_String] := 
    If[StringCount[s, ","] == 2, StringReplace[s, {"(" -> "{", ")" -> "}"}], s];
   parse[s_String] := 
    ToExpression[s, TraditionalForm, Hold] /. sqrt -> Sqrt /. 
        cbrt -> CubeRoot /. Set -> Rule // Rationalize // ReleaseHold;
   
   {initString, facesString} = StringSplit[fileString, "Faces:"];

   rules = parse@*replaceParentheses /@ 
     Drop[StringSplit[initString, ("\r" | "\n") ..], 1];
   
   vertices = Last /@ Select[rules, 
       StringTake[SymbolName[First[#]], 1] == "V" &] /. Reverse[rules];

   faces = Part[vertices, # + 1] & /@ (ToExpression /@ 
       StringSplit[facesString, ("\r" | "\n") ..]);
   
   {vertices, faces}
   ];

{vertices, faces} = parseDmccooeyFile["data.txt"]
$\endgroup$
3
  • $\begingroup$ Awesome! Thank you. I am a bit stuck though still as I don't know yet how to import data.txt to the mathematica workspace and to then use it? I know about << Import["/Users/...../data.txt"] >>, but I don't know yet how to use it as input to the function you have written. $\endgroup$
    – P Teeuwen
    May 5 at 17:46
  • $\begingroup$ You just use parseDmccooeyFile["/Users/.../data.txt"]. $\endgroup$
    – Domen
    May 5 at 17:51
  • $\begingroup$ Oh that does make sense. Thanks! $\endgroup$
    – P Teeuwen
    May 5 at 18:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.