(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 14332, 332] NotebookOptionsPosition[ 13846, 311] NotebookOutlinePosition[ 14192, 326] CellTagsIndexPosition[ 14149, 323] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{ "Faces", " ", "of", " ", "polyhedra", " ", "are", " ", "described", " ", "using", " ", "a", " ", "graphics", " ", RowBox[{"complex", ".", " ", "Thus"}]}], ",", " ", RowBox[{ "only", " ", "the", " ", "vertices", " ", "need", " ", "to", " ", "be", " ", RowBox[{"scaled", ".", " ", "The"}], " ", "following", " ", "function", " ", "scales", " ", StyleBox["any", FontSlant->"Italic"], " ", "graphics", " ", RowBox[{"complex", "."}]}]}], " ", "*)"}], RowBox[{ RowBox[{"ScaleGC", " ", "[", RowBox[{"gc_", ",", RowBox[{"scale_", " ", ":", " ", "1"}]}], "]"}], ":=", " ", RowBox[{"GraphicsComplex", "[", RowBox[{ RowBox[{"scale", " ", RowBox[{"gc", "[", RowBox[{"[", "1", "]"}], "]"}]}], ",", " ", RowBox[{"gc", "[", RowBox[{"[", "2", "]"}], "]"}]}], "]"}]}]}]], "Input", CellChangeTimes->{{3.422888478722453*^9, 3.4228885101197777`*^9}, { 3.422888568631542*^9, 3.422888569340108*^9}, {3.4228904631937695`*^9, 3.4228905668317413`*^9}, {3.4228933339146323`*^9, 3.422893403705241*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Selects", " ", "from", " ", "available", " ", "polyhedra", " ", "those", " ", "with", " ", "a", " ", RowBox[{"dual", ".", " ", "Takes"}], " ", "duals", " ", "so", " ", "that", " ", "they", " ", "are", " ", "in", " ", "alphabetical", " ", RowBox[{"order", "."}]}], " ", "*)"}], RowBox[{"PolyhedraWithDuals", " ", "=", RowBox[{ RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"#", ",", "\"\\""}], "]"}], "&"}], " ", "/@", RowBox[{"Select", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"#", ",", "\"\\""}], "]"}], "&"}], " ", "/@", RowBox[{"PolyhedronData", "[", "All", "]"}]}], ",", RowBox[{ RowBox[{"!", RowBox[{"(", RowBox[{"#", "==", "\"\\""}], ")"}]}], "&"}]}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.422891405026619*^9, 3.422891469352685*^9}, { 3.422891520163559*^9, 3.4228915469908257`*^9}, {3.4228915896925845`*^9, 3.422891644909567*^9}, {3.4228917155467577`*^9, 3.422891726072545*^9}, { 3.4228919030402765`*^9, 3.4228919145201097`*^9}, {3.4228919556690784`*^9, 3.422891996250986*^9}, {3.4228932133800116`*^9, 3.422893264624427*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{"\<\"CsaszarPolyhedron\"\>", ",", "\<\"Cube\"\>", ",", "\<\"Cuboctahedron\"\>", ",", "\<\"DeltoidalHexecontahedron\"\>", ",", "\<\"DeltoidalIcositetrahedron\"\>", ",", "\<\"DisdyakisDodecahedron\"\>", ",", "\<\"DisdyakisTriacontahedron\"\>", ",", "\<\"Dodecahedron\"\>", ",", "\<\"GreatDodecahedron\"\>", ",", "\<\"GreatIcosahedron\"\>", ",", "\<\"GreatRhombicosidodecahedron\"\>", ",", "\<\"GreatRhombicuboctahedron\"\>", ",", "\<\"GreatStellatedDodecahedron\"\>", ",", "\<\"Icosahedron\"\>", ",", "\<\"Icosidodecahedron\"\>", ",", "\<\"Octahedron\"\>", ",", "\<\"PentakisDodecahedron\"\>", ",", "\<\"RhombicDodecahedron\"\>", ",", "\<\"RhombicTriacontahedron\"\>", ",", "\<\"SmallRhombicosidodecahedron\"\>", ",", "\<\"SmallRhombicuboctahedron\"\>", ",", "\<\"SmallStellatedDodecahedron\"\>", ",", "\<\"SmallTriakisOctahedron\"\>", ",", "\<\"SzilassiPolyhedron\"\>", ",", "\<\"TetrakisHexahedron\"\>", ",", "\<\"TriakisIcosahedron\"\>", ",", "\<\"TriakisTetrahedron\"\>", ",", "\<\"TruncatedCube\"\>", ",", "\<\"TruncatedDodecahedron\"\>", ",", "\<\"TruncatedIcosahedron\"\>", ",", "\<\"TruncatedOctahedron\"\>", ",", "\<\"TruncatedTetrahedron\"\>"}], "}"}]], "Output", CellChangeTimes->{{3.422891984803604*^9, 3.4228919968296103`*^9}, { 3.4228932187437086`*^9, 3.4228932216679397`*^9}, 3.422893482284181*^9, 3.4228951391348143`*^9, 3.422895188002314*^9, 3.4228963460579033`*^9, 3.4443988357938366`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ RowBox[{ "Initializes", " ", "to", " ", "the", " ", "case", " ", "of", " ", "the", " ", "truncated", " ", "tetrahedron", " ", "and", " ", "triakis", " ", RowBox[{"tetrahedron", ".", " ", "Allows"}], " ", "for", " ", "the", " ", "selection", " ", "of", " ", "any", " ", "polyhedron", " ", "which", " ", "has", " ", "a", " ", "dual"}], ",", " ", RowBox[{ RowBox[{ RowBox[{"although", " ", StyleBox["Mathematica", FontSlant->"Italic"], " ", "sometimes", " ", "has", " ", "the", " ", "wrong", " ", "dual"}], "..."}], "."}]}], " ", "*)"}], RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Graphics3D", "[", RowBox[{ RowBox[{"{", RowBox[{"Blue", ",", RowBox[{"Opacity", "[", "po", "]"}], ",", RowBox[{"PolyhedronData", "[", RowBox[{"poly", ",", " ", "\"\\""}], "]"}], ",", "Green", ",", RowBox[{"Opacity", "[", "do", "]"}], ",", " ", RowBox[{"ScaleGC", "[", RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"poly", ",", "\"\\""}], "]"}], ",", "\"\\""}], "]"}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ RowBox[{ "We", " ", "want", " ", "the", " ", "midradius", " ", "of", " ", "the", " ", "polyhedron", " ", "and", " ", "its", " ", "dual", " ", "to", " ", "be", " ", "the", " ", "same"}], ",", " ", RowBox[{ "so", " ", "we", " ", "scale", " ", "the", " ", "dual", " ", RowBox[{"accordingly", ".", " ", "Luckily"}]}], ",", " ", RowBox[{ "the", " ", "data", " ", "are", " ", "all", " ", "built", " ", "in", " ", "to", " ", StyleBox[ RowBox[{"Mathematica", "."}], FontSlant->"Italic"]}]}], " ", "*)"}], RowBox[{ RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"poly", ",", "\"\\""}], "]"}], "/", RowBox[{"PolyhedronData", "[", RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"poly", ",", "\"\\""}], "]"}], ",", "\"\\""}], "]"}]}], "//", "N"}]}], "]"}], ",", "Red", ",", " ", RowBox[{"Opacity", "[", "so", "]"}], ",", RowBox[{"Sphere", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"PolyhedronData", "[", RowBox[{"poly", ",", "\"\\""}], "]"}]}], "]"}]}], "}"}], ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"ImageSize", "\[Rule]", "600"}], ",", RowBox[{"ImagePadding", "\[Rule]", "0.2"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "poly", ",", "\"\\"", ",", "\"\\""}], "}"}], ",", "PolyhedraWithDuals"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"po", ",", "1", ",", "\"\\""}], "}"}], ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"do", ",", "1", ",", "\"\\""}], "}"}], ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"so", ",", "1", ",", "\"\\""}], "}"}], ",", "0", ",", "1"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->CompressedData[" 1:eJxTTMoPSmViYGCQAGIQrVH0jnFZw0tHTWZWThAddUhfGESr/S4WA9FmF9tl QDTT9j96IHrirzBzEB2/x8ETREffeRAKovNeBMaC6MNbNBJBtN6V/WDaaq9C GojetV8HTM/eOisfRL+7E14AojdteL4BRNd+kNkEomUmSB0D0Qejk86A6LvC E2+C6Jsnp90C0TaPxaWWA+nTJwrkQPSGIm1HEJ1Uoh0EovVY9WNA9F/t12Ca y5o3CUQ3nLVPB9GLJl3JB9EushwFIFpn4rISEJ1iXVwKoie/mFwLopsCfjSC 9a1VbwPLOzSD6fDStbNBdLHa5qUg2mhB+HUQbaX/4z6IZrG9/wUsHsH8G0Rf ybVkXAGkjxWdYALRV1a95wHRP12khEA0AAZ7yuM= "]], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`do$$ = 1., $CellContext`po$$ = 0.8240000000000001, $CellContext`poly$$ = "GreatRhombicosidodecahedron", $CellContext`so$$ = 0., Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`poly$$], "TruncatedTetrahedron", "Polyhedron"}, { "CsaszarPolyhedron", "Cube", "Cuboctahedron", "DeltoidalHexecontahedron", "DeltoidalIcositetrahedron", "DisdyakisDodecahedron", "DisdyakisTriacontahedron", "Dodecahedron", "GreatDodecahedron", "GreatIcosahedron", "GreatRhombicosidodecahedron", "GreatRhombicuboctahedron", "GreatStellatedDodecahedron", "Icosahedron", "Icosidodecahedron", "Octahedron", "PentakisDodecahedron", "RhombicDodecahedron", "RhombicTriacontahedron", "SmallRhombicosidodecahedron", "SmallRhombicuboctahedron", "SmallStellatedDodecahedron", "SmallTriakisOctahedron", "SzilassiPolyhedron", "TetrakisHexahedron", "TriakisIcosahedron", "TriakisTetrahedron", "TruncatedCube", "TruncatedDodecahedron", "TruncatedIcosahedron", "TruncatedOctahedron", "TruncatedTetrahedron"}}, {{ Hold[$CellContext`po$$], 1, "Polyhedron Opacity"}, 0, 1}, {{ Hold[$CellContext`do$$], 1, "Dual Opacity"}, 0, 1}, {{ Hold[$CellContext`so$$], 1, "Sphere Opacity"}, 0, 1}}, Typeset`size$$ = {600., {312., 316.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = True, $CellContext`poly$6327$$ = 0, $CellContext`po$6328$$ = 0, $CellContext`do$6329$$ = 0, $CellContext`so$6330$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`do$$ = 1, $CellContext`po$$ = 1, $CellContext`poly$$ = "TruncatedTetrahedron", $CellContext`so$$ = 1}, "ControllerVariables" :> { Hold[$CellContext`poly$$, $CellContext`poly$6327$$, 0], Hold[$CellContext`po$$, $CellContext`po$6328$$, 0], Hold[$CellContext`do$$, $CellContext`do$6329$$, 0], Hold[$CellContext`so$$, $CellContext`so$6330$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Graphics3D[{Blue, Opacity[$CellContext`po$$], PolyhedronData[$CellContext`poly$$, "Faces"], Green, Opacity[$CellContext`do$$], $CellContext`ScaleGC[ PolyhedronData[ PolyhedronData[$CellContext`poly$$, "Dual"], "Faces"], N[PolyhedronData[$CellContext`poly$$, "Midradius"]/PolyhedronData[ PolyhedronData[$CellContext`poly$$, "Dual"], "Midradius"]]], Red, Opacity[$CellContext`so$$], Sphere[{0, 0, 0}, PolyhedronData[$CellContext`poly$$, "Midradius"]]}, Boxed -> False, ImageSize -> 600, ImagePadding -> 0.2], "Specifications" :> {{{$CellContext`poly$$, "TruncatedTetrahedron", "Polyhedron"}, { "CsaszarPolyhedron", "Cube", "Cuboctahedron", "DeltoidalHexecontahedron", "DeltoidalIcositetrahedron", "DisdyakisDodecahedron", "DisdyakisTriacontahedron", "Dodecahedron", "GreatDodecahedron", "GreatIcosahedron", "GreatRhombicosidodecahedron", "GreatRhombicuboctahedron", "GreatStellatedDodecahedron", "Icosahedron", "Icosidodecahedron", "Octahedron", "PentakisDodecahedron", "RhombicDodecahedron", "RhombicTriacontahedron", "SmallRhombicosidodecahedron", "SmallRhombicuboctahedron", "SmallStellatedDodecahedron", "SmallTriakisOctahedron", "SzilassiPolyhedron", "TetrakisHexahedron", "TriakisIcosahedron", "TriakisTetrahedron", "TruncatedCube", "TruncatedDodecahedron", "TruncatedIcosahedron", "TruncatedOctahedron", "TruncatedTetrahedron"}}, {{$CellContext`po$$, 1, "Polyhedron Opacity"}, 0, 1}, {{$CellContext`do$$, 1, "Dual Opacity"}, 0, 1}, {{$CellContext`so$$, 1, "Sphere Opacity"}, 0, 1}}, "Options" :> {}, "DefaultOptions" :> {}], ImageSizeCache->{645., {396., 401.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{ 3.4228954079885693`*^9, 3.42289580440574*^9, 3.422895873035474*^9, 3.422895937598323*^9, {3.422896144442898*^9, 3.4228961511379576`*^9}, 3.4228963461047506`*^9, 3.4443988359032116`*^9}] }, Open ]] }, WindowSize->{1014, 711}, WindowMargins->{{74, Automatic}, {Automatic, 79}}, FrontEndVersion->"7.0 for Microsoft Windows (32-bit) (November 10, 2008)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[545, 20, 1174, 29, 72, "Input"], Cell[CellGroupData[{ Cell[1744, 53, 1315, 30, 72, "Input"], Cell[3062, 85, 1535, 26, 126, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[4634, 116, 4202, 101, 272, "Input"], Cell[8839, 219, 4991, 89, 814, "Output"] }, Open ]] } ] *) (* End of internal cache information *)