(* 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[ 103751, 2676] NotebookOptionsPosition[ 99064, 2533] NotebookOutlinePosition[ 99450, 2550] CellTagsIndexPosition[ 99407, 2547] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Procedural Generation of Sculptural Forms", "Section", CellChangeTimes->{{3.402181361703125*^9, 3.402181380984375*^9}, 3.402222625921875*^9, {3.4023500843032503`*^9, 3.4023500948657503`*^9}, { 3.4023509066938753`*^9, 3.4023509285376253`*^9}, {3.4101091720484*^9, 3.4101091822104*^9}, {3.410353305113*^9, 3.410353307183*^9}}], Cell["\<\ George W. Hart, Stony Brook University, http://www.georgehart.com, Jan 2008 This notebook contains all the examples from my Bridges 2008 paper.\ \>", "Text", CellChangeTimes->{{3.40216216015625*^9, 3.402162202484375*^9}, { 3.402222075546875*^9, 3.402222098828125*^9}, {3.402247299234375*^9, 3.40224735228125*^9}, {3.4023501053501253`*^9, 3.4023502517876253`*^9}, { 3.4023502824126253`*^9, 3.4023503238501253`*^9}, {3.4023503899907503`*^9, 3.4023504292563753`*^9}, {3.4023505036782503`*^9, 3.4023505054751253`*^9}, {3.4023505998032503`*^9, 3.4023506065063753`*^9}, 3.4023519496782503`*^9, 3.402767928296875*^9, {3.4101091898334*^9, 3.4101092354364*^9}, {3.4103533102799997`*^9, 3.410353405755*^9}}], Cell[CellGroupData[{ Cell["\<\ 1. Built-in polyhedra, face representation, display, and stl output\ \>", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111798714*^9, 3.4101112075034*^9}, {3.4101320663992*^9, 3.4101320673582*^9}}], Cell[BoxData[ RowBox[{"PolyhedronData", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.4101092470864*^9, 3.4101092547444*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Length", "[", RowBox[{"PolyhedronData", "[", "All", "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101107061954*^9, 3.4101107193794003`*^9}, { 3.4101286554762*^9, 3.4101286609372*^9}, {3.4103534315109997`*^9, 3.4103534516029997`*^9}}], Cell[BoxData["147"], "Output", CellChangeTimes->{ 3.4101286625472*^9, 3.4101881018904*^9, 3.4102780904474*^9, { 3.410353434216*^9, 3.410353452091*^9}, 3.4103577169040003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"vertices", "[", "gc_", "]"}], ":=", RowBox[{"N", "[", RowBox[{"gc", "[", RowBox[{"[", RowBox[{"1", ",", "1"}], "]"}], "]"}], "]"}]}], " ", RowBox[{"(*", " ", RowBox[{"vertices", " ", "from", " ", "graphics", " ", "complex"}], " ", "*)"}]}], "\n", RowBox[{"vertices", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101093168294*^9, 3.4101093170654*^9}, 3.4101093644533997`*^9, {3.4101096337524*^9, 3.4101096345973997`*^9}, { 3.4103534648050003`*^9, 3.4103534690150003`*^9}, 3.410353846913*^9}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", "0.5`"}], "}"}]}], "}"}]], "Output", CellChangeTimes->{{3.4101093417684*^9, 3.4101093696034*^9}, 3.4101096355184*^9, 3.4101262824952*^9, 3.4101881019114*^9, 3.4102780904653997`*^9, {3.4103534700360003`*^9, 3.4103534727*^9}, 3.410357716926*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"faces", "[", "gc_", "]"}], " ", ":=", " ", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"vertices", "[", "gc", "]"}], "[", RowBox[{"[", "#", "]"}], "]"}], "&"}], ",", " ", RowBox[{"gc", "[", RowBox[{"[", RowBox[{"1", ",", "2", ",", "1"}], "]"}], "]"}], ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";"}], " ", RowBox[{"(*", " ", RowBox[{"faces", " ", "from", " ", "gc"}], " ", "*)"}]}], "\[IndentingNewLine]", RowBox[{"cube", "=", RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}]}]}], "Input", CellChangeTimes->{{3.4101094188943996`*^9, 3.4101094325294*^9}, { 3.4101096163434*^9, 3.4101096171303997`*^9}, {3.4101098949434*^9, 3.4101098962534*^9}}], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", "0.5`"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", "0.5`", ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", RowBox[{"-", "0.5`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.5`", ",", RowBox[{"-", "0.5`"}], ",", "0.5`"}], "}"}]}], "}"}]}], "}"}]], "Output", CellChangeTimes->{3.4101094342274*^9, 3.4101096187044*^9, 3.4101098982004004`*^9, 3.4101262825341997`*^9, 3.4101881019323997`*^9, 3.4102780905144*^9, 3.410357716951*^9}] }, Open ]], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"view", "[", "obj_", "]"}], ":=", RowBox[{"Graphics3D", "[", RowBox[{ RowBox[{"Map", "[", RowBox[{"Polygon", ",", "obj"}], "]"}], ",", " ", RowBox[{"Boxed", "\[Rule]", "False"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", "cube", "]"}]}], "Input", CellChangeTimes->{{3.4101101101554003`*^9, 3.4101101186614*^9}}], Cell[CellGroupData[{ Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"stl", "[", RowBox[{"filename_", ",", "obj_"}], "]"}], ":=", RowBox[{"Export", "[", RowBox[{"filename", ",", RowBox[{"Graphics3D", "[", RowBox[{"Map", "[", RowBox[{"Polygon", ",", "obj"}], "]"}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"stl", "[", RowBox[{"\"\\"", ",", " ", "cube"}], "]"}]}], "Input", CellChangeTimes->{{3.4101098733954*^9, 3.4101099025534*^9}}], Cell[BoxData["\<\"cube.stl\"\>"], "Output", CellChangeTimes->{3.4101262826512003`*^9, 3.4101881022194*^9, 3.4102780906954*^9, 3.410357717137*^9}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["2. Tetrahedron, compounds", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101320702841997`*^9, 3.4101320711982*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Test", " ", "if", " ", "given", " ", "point", " ", "p", " ", "is", " ", "above", " ", "given", " ", "triangle"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"above", "[", RowBox[{"p_", ",", RowBox[{"{", RowBox[{"v0_", ",", "v1_", ",", "v2_"}], "}"}]}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"normal", "=", RowBox[{"Cross", "[", RowBox[{ RowBox[{"v1", "-", "v0"}], ",", RowBox[{"v2", "-", "v1"}]}], "]"}]}], "}"}], ",", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"p", "-", "v0"}], ")"}], ".", "normal"}], ">", "0"}]}], " ", "]"}], " "}]}]], "Input", CellChangeTimes->{{3.4021535989279375`*^9, 3.4021537701741776`*^9}, 3.402153846523963*^9, {3.4021538832367535`*^9, 3.402153883837618*^9}, { 3.402222515203125*^9, 3.402222517984375*^9}, {3.4023517571313753`*^9, 3.4023517718970003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "construct", " ", "tetrahedron", " ", "from", " ", "four", " ", "points"}], "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"tetra", "[", RowBox[{"{", RowBox[{"p1_", ",", "p2_", ",", "p3_", ",", "p4_"}], "}"}], "]"}], ":=", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"above", "[", RowBox[{"p1", ",", RowBox[{"{", RowBox[{"p2", ",", "p3", ",", "p4"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"p1", ",", "p2", ",", "p3"}], "}"}], ",", RowBox[{"{", RowBox[{"p1", ",", "p3", ",", "p4"}], "}"}], ",", RowBox[{"{", RowBox[{"p1", ",", "p4", ",", "p2"}], "}"}], ",", RowBox[{"{", RowBox[{"p3", ",", "p2", ",", "p4"}], "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"p1", ",", "p3", ",", "p2"}], "}"}], ",", RowBox[{"{", RowBox[{"p1", ",", "p4", ",", "p3"}], "}"}], ",", RowBox[{"{", RowBox[{"p1", ",", "p2", ",", "p4"}], "}"}], ",", RowBox[{"{", RowBox[{"p3", ",", "p4", ",", "p2"}], "}"}]}], "}"}]}], "]"}]}]}]], "Input", CellChangeTimes->{{3.402153886972125*^9, 3.402154098386123*^9}, { 3.4021547329585934`*^9, 3.4021548150967026`*^9}, {3.402156757750101*^9, 3.40215676043396*^9}, {3.402161581796875*^9, 3.402161617421875*^9}, { 3.402161717453125*^9, 3.40216179759375*^9}, {3.402162082140625*^9, 3.40216209578125*^9}, {3.40216214*^9, 3.402162141046875*^9}, 3.4021624789375*^9, 3.40218211115625*^9, {3.40222149240625*^9, 3.402221516734375*^9}, {3.402221581265625*^9, 3.40222168978125*^9}, { 3.402221844765625*^9, 3.40222187196875*^9}, {3.40222252159375*^9, 3.40222252875*^9}, {3.4023500747251253`*^9, 3.4023501012563753`*^9}, { 3.4101084541534*^9, 3.4101084555713997`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"v4", "=", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"1", ",", "1", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", RowBox[{"-", "1"}], ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1", ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"tetra", "[", "v4", "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101117007824*^9, 3.4101117513224*^9}, { 3.4101313070372*^9, 3.4101313203992*^9}}], Cell["\<\ The following makes a Stella Octangula in which the large triangular faces \ intersect others, and there are internal walls. On some older SFF machines \ this \"non-manifold\" set of triangles confuses simple slicing algorithms and \ so will not build properly. But with recent machines the slicing algorithms \ are smarter and there is no problem. In other examples below, we will also \ use this technique of combining several overlapping objects, without further \ comment.\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550111429996`*^9}, { 3.410355055297*^9, 3.41035529977*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"tetra", "[", "v4", "]"}], ",", RowBox[{"tetra", "[", RowBox[{"-", "v4"}], "]"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101139131314*^9, 3.4101139512574*^9}, { 3.4101313019502*^9, 3.4101313034312*^9}}], Cell[TextData[{ "To see which vertices go together in the following set of five tetrahedra, \ I separately printed out faces[PolyhedronData[\"Cube\"]] and manually made a \ Schlegel diagram labeled with the particular vertex indices that ", StyleBox["Mathematica", FontSlant->"Italic"], " happens to use. In a future version of ", StyleBox["Mathematica", FontSlant->"Italic"], ", the indices might be permuted arbitrarily, requiring this code to be \ updated:" }], "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550111429996`*^9}, { 3.410355055297*^9, 3.410355498557*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"v", "=", RowBox[{"vertices", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}]}], ";"}], "\n", RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"tetra", "[", RowBox[{"{", RowBox[{ RowBox[{"v", "[", RowBox[{"[", "2", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "4", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "7", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "9", "]"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"tetra", "[", RowBox[{"{", RowBox[{ RowBox[{"v", "[", RowBox[{"[", "1", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "11", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "17", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "20", "]"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"tetra", "[", RowBox[{"{", RowBox[{ RowBox[{"v", "[", RowBox[{"[", "3", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "12", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "13", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "15", "]"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"tetra", "[", RowBox[{"{", RowBox[{ RowBox[{"v", "[", RowBox[{"[", "5", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "8", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "14", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "18", "]"}], "]"}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"tetra", "[", RowBox[{"{", RowBox[{ RowBox[{"v", "[", RowBox[{"[", "6", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "10", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "16", "]"}], "]"}], ",", RowBox[{"v", "[", RowBox[{"[", "19", "]"}], "]"}]}], "}"}], "]"}]}], "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101118932874002`*^9, 3.4101119180214*^9}, 3.4101120301684*^9, {3.4101135386504*^9, 3.4101135572234*^9}, { 3.4101141141804*^9, 3.4101141154144*^9}, {3.4101158175564003`*^9, 3.4101158181424*^9}, {3.4101158494944*^9, 3.4101158501284*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["3. Rigid motions: translate, scale, and rotate", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101141714194*^9, 3.4101141909203997`*^9}, {3.4101151276954*^9, 3.4101151305144*^9}, { 3.4101320739302*^9, 3.4101320748241997`*^9}}], Cell[TextData[{ "To translate an object, add a fixed offset to each XYZ coordinate in it. \ Map does this. Our XYX's are down at \"level 2\" (inside faces which are \ inside objects). ", StyleBox["Mathematica", FontSlant->"Italic"], "l allows a third argument to Map of the form \"{2}\" which is a level \ specifier, just for this sort of thing. " }], "Text", CellChangeTimes->{{3.399736135954189*^9, 3.399736260683541*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"translate", "[", RowBox[{"obj_", ",", "offset_"}], "]"}], ":=", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"#", "+", "offset"}], ")"}], "&"}], ",", " ", "obj", ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";", " ", RowBox[{"(*", " ", RowBox[{"offset", " ", "should", " ", "be", " ", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{"cube", ",", RowBox[{"translate", "[", RowBox[{"cube", ",", RowBox[{"{", RowBox[{"1.1", ",", "0", ",", "0"}], "}"}]}], "]"}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4101142286124*^9, 3.4101142867854*^9}, { 3.410353878451*^9, 3.4103538942209997`*^9}}], Cell[TextData[{ "To scale an object, multiply each XYZ coordinate by a scale factor. We get \ this for free if we multiply the entire object by a scale factor, because in \ ", StyleBox["Mathematica", FontSlant->"Italic"], " multiplication distributes across lists. Demonstrate this by joining two \ cubes together, one of which is scaled." }], "Text", CellChangeTimes->{{3.399736135954189*^9, 3.399736260683541*^9}, { 3.399736438819688*^9, 3.3997364867586207`*^9}, {3.3997365499995565`*^9, 3.399736568315894*^9}, {3.399736642492555*^9, 3.399736677092307*^9}, { 3.3997367217865744`*^9, 3.3997367620344477`*^9}, {3.4103540518640003`*^9, 3.410354057059*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{"cube", ",", RowBox[{"translate", "[", RowBox[{ RowBox[{"0.5", " ", "cube"}], ",", RowBox[{"{", RowBox[{".75", ",", "0", ",", "0"}], "}"}]}], "]"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101143160284*^9, 3.4101143708794003`*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{"translate", "[", RowBox[{ RowBox[{"i", " ", "cube"}], ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"i", "^", "2"}], "/", "2"}], ",", "0", ",", "0"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "10"}], "}"}]}], "]"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101143938484*^9, 3.4101146088204*^9}, { 3.4101146419014*^9, 3.4101146718554*^9}}], Cell["\<\ In a Linear Algebra class, they explain how a rotation matrix works. The \ built-in RotationMatrix function provides a matrix for rotating a given angle \ about a given axis. Multiply the matrix times a point {x,y,z} to get a new, \ rotated point. In Mathematica, the dot is used for this type of matrix-vector \ multiplication\ \>", "Text", CellChangeTimes->{{3.410354162929*^9, 3.4103542605950003`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"rotate", "[", RowBox[{"obj_", ",", "angle_", ",", "axis_"}], "]"}], ":=", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"RotationMatrix", "[", RowBox[{"angle", ",", "axis"}], "]"}], ".", "#"}], ")"}], "&"}], ",", " ", "obj", ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{"cube", ",", RowBox[{"rotate", "[", RowBox[{"cube", ",", RowBox[{"Pi", "/", "4"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101148843934*^9, 3.4101150191394*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{"cube", ",", RowBox[{"rotate", "[", RowBox[{"cube", ",", "angle", ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "]"}], "]"}], ",", RowBox[{"{", RowBox[{"angle", ",", "0", ",", "Pi"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4101160657883997`*^9, 3.4101160930674*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"rotate", "[", RowBox[{"cube", ",", RowBox[{"Pi", "/", "4"}], ",", RowBox[{"{", RowBox[{"1", ",", "0", ",", "0"}], "}"}]}], "]"}], ",", "\[IndentingNewLine]", " ", RowBox[{"rotate", "[", RowBox[{"cube", ",", RowBox[{"Pi", "/", "4"}], ",", RowBox[{"{", RowBox[{"0", ",", "1", ",", "0"}], "}"}]}], "]"}], ",", "\[IndentingNewLine]", " ", RowBox[{"rotate", "[", RowBox[{"cube", ",", RowBox[{"Pi", "/", "4"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.410346664394*^9, 3.4103467462209997`*^9}, { 3.41034692499*^9, 3.410346933693*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["4. Poke", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101320784462*^9, 3.4101320792242002`*^9}}], Cell["\<\ This method will create a unit-length vector in the direction of a given \ vector, by dividing out its length:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"unit", "[", "vec_", "]"}], ":=", RowBox[{"vec", "/", RowBox[{"Sqrt", "[", RowBox[{"vec", ".", "vec"}], "]"}]}]}], ";", " ", RowBox[{"(*", " ", RowBox[{"will", " ", "fail", " ", "if", " ", "given", " ", RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}]}], " ", "*)"}]}]], "Input", CellChangeTimes->{{3.4101100158414*^9, 3.4101100647414*^9}, { 3.4101102204424*^9, 3.4101102299104*^9}, 3.410354377158*^9, { 3.41035441955*^9, 3.4103544336070004`*^9}}], Cell["This method returns the mean of the elements in the list:", "Text", CellChangeTimes->{{3.410354495299*^9, 3.41035450169*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ RowBox[{"average", "[", "L_", "]"}], ":=", RowBox[{ RowBox[{"Apply", "[", RowBox[{"Plus", ",", "L"}], "]"}], "/", RowBox[{"Length", "[", "L", "]"}]}]}], ";"}], " "}]], "Input", CellChangeTimes->{{3.4101100158414*^9, 3.4101100647414*^9}, { 3.4101102204424*^9, 3.4101102299104*^9}, {3.410354377158*^9, 3.4103543928310003`*^9}, {3.4103544367019997`*^9, 3.4103544898570004`*^9}}],\ Cell["\<\ Our plan is to first make a function to poke one face, then map it on an \ object. The desired apex of a given poking can be found by starting at the \ center of the face and going in the direction of the normal a distance equal \ to the desired height. There will be n triangles generated from a given face. \ Each comes from two adjacent vertices and the apex. We will take position \ [[i]] and [[i+1]] of the face to get adjacent pairs, but the last pair wraps \ around as [[n]] and [[1]]. So plan ahead for this by appending the first \ vertex to the end of the list of vertices, to make a local variable, face1, \ that includes the wrap-around. Then a table of triples is easily formed:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"pokeFace", "[", RowBox[{"face_", ",", "height_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"apex", ",", "face1"}], "}"}], ",", "\[IndentingNewLine]", " ", RowBox[{ RowBox[{"apex", "=", RowBox[{ RowBox[{"average", "[", "face", "]"}], "+", RowBox[{"height", "*", RowBox[{"unit", "[", RowBox[{"Cross", "[", RowBox[{ RowBox[{ RowBox[{"face", "[", RowBox[{"[", "1", "]"}], "]"}], "-", RowBox[{"face", "[", RowBox[{"[", "2", "]"}], "]"}]}], ",", RowBox[{ RowBox[{"face", "[", RowBox[{"[", "2", "]"}], "]"}], "-", RowBox[{"face", "[", RowBox[{"[", "3", "]"}], "]"}]}]}], "]"}], "]"}]}]}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"face1", "=", RowBox[{"Append", "[", RowBox[{"face", ",", RowBox[{"face", "[", RowBox[{"[", "1", "]"}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", " ", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"face1", "[", RowBox[{"[", "i", "]"}], "]"}], ",", " ", RowBox[{"face1", "[", RowBox[{"[", RowBox[{"i", "+", "1"}], "]"}], "]"}], ",", "apex"}], "}"}], ",", " ", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "face", "]"}]}], "}"}]}], "]"}]}]}], "\[IndentingNewLine]", "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4101100158414*^9, 3.4101100647414*^9}, { 3.4101102204424*^9, 3.4101102299104*^9}, {3.410354377158*^9, 3.4103543928310003`*^9}}], Cell["\<\ An object is a list of faces. So to construct the list of faces for a poked \ object, just poke each face and join the separate lists of triangles into a \ single list of triangles:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"poke", "[", RowBox[{"obj_", ",", "height_"}], "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"pokeFace", "[", RowBox[{"#", ",", "height"}], "]"}], ")"}], "&"}], ",", "obj"}], "]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4101100158414*^9, 3.4101100647414*^9}, { 3.4101102204424*^9, 3.4101102299104*^9}, {3.410354377158*^9, 3.4103543878640003`*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{"cube", ",", ".7"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101101438534*^9, 3.4101101586204*^9}, { 3.4101102401394*^9, 3.4101102730643997`*^9}, {3.4101103630944*^9, 3.4101103671684*^9}, {3.4101104015034*^9, 3.4101104135174*^9}, { 3.4101341363052*^9, 3.4101341575072002`*^9}}], Cell["\<\ Thgis makes a Stella Octangula without any faces intersecting, a single \ triangulated manifold:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550385299997`*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{ RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], ",", " ", ".8"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101136489824*^9, 3.4101136535594*^9}, { 3.4101139964354*^9, 3.4101140925304003`*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{ RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], ",", " ", "height"}], "]"}], "]"}], ",", RowBox[{"{", RowBox[{"height", ",", RowBox[{"-", "1"}], ",", "3"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4101104245114*^9, 3.4101104618374*^9}, { 3.4101161415764*^9, 3.4101161647324*^9}, 3.4101161952164*^9}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"poke", "[", "obj_", "]"}], ":=", RowBox[{"poke", "[", RowBox[{"obj", ",", "1"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"poke", "[", RowBox[{"obj_", ",", "height_", ",", "n_"}], "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Length", "[", "#", "]"}], "\[Equal]", "n"}], ",", RowBox[{"pokeFace", "[", RowBox[{"#", ",", "height"}], "]"}], ",", RowBox[{"{", "#", "}"}]}], "]"}], ")"}], "&"}], ",", "obj"}], "]"}]}], "]"}]}]}], "Input", CellChangeTimes->{{3.4101105063814*^9, 3.4101106041394*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{ RowBox[{"poke", "[", "cube", "]"}], ",", " ", RowBox[{"-", ".15"}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101136926034*^9, 3.4101137044924*^9}, { 3.4101137367164*^9, 3.4101138211224003`*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{ RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], ",", ".8"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101106096464*^9, 3.4101106570264*^9}, { 3.4101107742434*^9, 3.4101108161284*^9}, {3.410347696566*^9, 3.410347736517*^9}}], Cell[BoxData[ RowBox[{"PolyhedronData", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.4101106649414*^9, 3.4101106964594*^9}, { 3.4101107322214003`*^9, 3.4101107531454*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{ RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], ",", "2", ",", "4"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101106096464*^9, 3.4101106570264*^9}, { 3.4101107742434*^9, 3.4101108161284*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"poke", "[", RowBox[{"poke", "[", RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], "]"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101881895783997`*^9, 3.4101882062324*^9}, { 3.4101882591024*^9, 3.4101882919884*^9}, {3.4101883362004004`*^9, 3.4101884430114*^9}, {3.4103477914189997`*^9, 3.4103477917060003`*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["5. Convex hull", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101320823472*^9, 3.4101320831331997`*^9}}], Cell[TextData[{ "This simple, but short and reasonably fast (for a quadratic time \ algorithm). It will fail if given five or more coplanar points to start with. \ But is is usually OK with coplanar points after it reaches a stage with some \ internal volume. There can also be occasional quirks from floating point \ roundoff. Note the search for unmatched edges is fast and easy if we use ", StyleBox["Mathematica's ", FontSlant->"Italic"], "function definition mechanism in effect as a hash table. " }], "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550385299997`*^9}, { 3.4103584610880003`*^9, 3.410358633546*^9}, {3.410359173543*^9, 3.410359265918*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{"To", " ", "find", " ", "unmateched", " ", "edges"}], ",", " ", RowBox[{ "note", " ", "that", " ", "all", " ", "matched", " ", "edges", " ", "show", " ", "up", " ", "twice"}], ",", " ", RowBox[{"once", " ", "in", " ", "each", " ", RowBox[{"order", ".", " ", "This"}], " ", "method"}], ",", " ", RowBox[{"given", " ", "a", " ", "list", " ", "of", " ", "edges"}], ",", " ", RowBox[{ "returns", " ", "edges", " ", "not", " ", "matched", " ", "with", " ", "their", " ", "reverse"}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"unmatchedEdges", "[", "List_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"Clear", "[", "unmatched", "]"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"unmatched", "[", "x_", "]"}], ":=", "True"}], ";", "\[IndentingNewLine]", RowBox[{"Scan", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"unmatched", "[", RowBox[{"Reverse", "[", "#", "]"}], "]"}], "=", "False"}], ")"}], "&"}], ",", "List"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"Select", "[", RowBox[{"List", ",", "unmatched"}], "]"}]}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", CellChangeTimes->{{3.402155558435571*^9, 3.402155796267557*^9}, { 3.4021558964215713`*^9, 3.40215590720708*^9}, {3.402155943909856*^9, 3.4021559724208527`*^9}, {3.402222382296875*^9, 3.402222385484375*^9}, { 3.4023504832563753`*^9, 3.4023505821157503`*^9}, 3.4027678765625*^9}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Utility", " ", "method", " ", "to", " ", "delete", " ", "1", "st", " ", "occurrence", " ", "of", " ", "x", " ", "from", " ", "a", " ", "given", " ", "List"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"remove", "[", RowBox[{ RowBox[{"{", "}"}], ",", "x_"}], "]"}], ":=", RowBox[{"{", "}"}]}], ";"}], " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"remove", "[", RowBox[{"L_", ",", "x_"}], "]"}], ":=", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"First", "[", "L", "]"}], "\[Equal]", "x"}], ",", RowBox[{"Rest", "[", "L", "]"}], ",", RowBox[{"Prepend", "[", RowBox[{ RowBox[{"remove", "[", RowBox[{ RowBox[{"Rest", "[", "L", "]"}], ",", "x"}], "]"}], ",", RowBox[{"First", "[", "L", "]"}]}], "]"}]}], "]"}]}]}]}]], "Input", CellChangeTimes->{{3.4021552698205633`*^9, 3.402155341964301*^9}, { 3.4021553909547453`*^9, 3.402155423501546*^9}, {3.402155460895315*^9, 3.4021555402894783`*^9}, {3.40222198765625*^9, 3.402222046875*^9}, { 3.4023504526470003`*^9, 3.4023504558032503`*^9}, {3.4023523938657503`*^9, 3.4023524066157503`*^9}, {3.4023524819282503`*^9, 3.4023524913970003`*^9}}],\ Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Construct", " ", "the", " ", "three", " ", "edges", " ", "of", " ", "given", " ", "triangle"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"edgesOfTriangle", "[", RowBox[{"{", RowBox[{"v0_", ",", "v1_", ",", "v2_"}], "}"}], "]"}], ":=", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"v0", ",", "v1"}], "}"}], ",", RowBox[{"{", RowBox[{"v1", ",", "v2"}], "}"}], ",", RowBox[{"{", RowBox[{"v2", ",", "v0"}], "}"}]}], "}"}]}]}]], "Input", CellChangeTimes->{{3.4021544372033186`*^9, 3.4021544683781457`*^9}, { 3.4023503588657503`*^9, 3.4023503751782503`*^9}, {3.4023504369438753`*^9, 3.4023504405532503`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "3", "D", " ", "convex", " ", "hull", " ", "of", " ", "list", " ", "of", " ", RowBox[{"points", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"cHull", "[", "L_", "]"}], ":=", " ", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"faces", ",", "keepers", ",", "edges", ",", "newTriangles"}], "}"}], ",", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Length", "[", "L", "]"}], "<", "4"}], ",", RowBox[{ "Print", "[", "\"\\"", "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"faces", "=", RowBox[{"tetra", "[", RowBox[{"Take", "[", RowBox[{"L", ",", "4"}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"For", "[", RowBox[{ RowBox[{"i", "=", "5"}], ",", RowBox[{"i", "<=", RowBox[{"Length", "[", "L", "]"}]}], ",", RowBox[{"i", "++"}], ",", RowBox[{"(", "\[IndentingNewLine]", RowBox[{ RowBox[{"keepers", "=", RowBox[{"Select", "[", RowBox[{"faces", ",", RowBox[{ RowBox[{"(", RowBox[{"!", RowBox[{"above", "[", RowBox[{ RowBox[{"L", "[", RowBox[{"[", "i", "]"}], "]"}], ",", "#"}], "]"}]}], ")"}], "&"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"edges", "=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Map", "[", RowBox[{"edgesOfTriangle", ",", "keepers"}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"newTriangles", "=", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"{", RowBox[{ RowBox[{"#", "[", RowBox[{"[", "2", "]"}], "]"}], ",", RowBox[{"#", "[", RowBox[{"[", "1", "]"}], "]"}], ",", RowBox[{"L", "[", RowBox[{"[", "i", "]"}], "]"}]}], "}"}], ")"}], "&"}], ",", RowBox[{"unmatchedEdges", "[", "edges", "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"faces", "=", RowBox[{"Join", "[", RowBox[{"keepers", ",", "newTriangles"}], "]"}]}], ";"}], "\[IndentingNewLine]", ")"}]}], "]"}], ";", "\[IndentingNewLine]", "faces"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", CellChangeTimes->{{3.40215602988348*^9, 3.4021562651818223`*^9}, { 3.4021563169963284`*^9, 3.4021565441129055`*^9}, {3.4021567011887693`*^9, 3.40215672037636*^9}, {3.402156896529656*^9, 3.402156952289835*^9}, { 3.4021571342314544`*^9, 3.4021571363945646`*^9}, {3.4021571919244127`*^9, 3.4021571946683583`*^9}, 3.402157259371397*^9, {3.4021573281402817`*^9, 3.4021573360015855`*^9}, {3.4021574597595406`*^9, 3.4021574610413837`*^9}, 3.402157712953616*^9, {3.40216228296875*^9, 3.402162300140625*^9}, { 3.402162452734375*^9, 3.4021624579375*^9}, 3.402162524078125*^9, { 3.402181514578125*^9, 3.4021815184375*^9}, {3.402182139140625*^9, 3.402182166015625*^9}, {3.402222455765625*^9, 3.40222245634375*^9}, { 3.402222495265625*^9, 3.402222502046875*^9}, 3.402226963125*^9, { 3.4023506943657503`*^9, 3.4023507447876253`*^9}, {3.4023507780220003`*^9, 3.4023508252876253`*^9}, 3.402767902140625*^9, {3.402768020375*^9, 3.4027680213125*^9}, 3.4101152996443996`*^9, 3.4101354265512*^9}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"cHull", "[", RowBox[{"vertices", "[", RowBox[{"PolyhedronData", "[", "\"\\"", "]"}], "]"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101157377944*^9, 3.4101157826594*^9}}], Cell["\<\ The bottom of this pyramid will be an n-gon divided into n-2 triangles. But \ the division is irrelevant because they are coplanar, so does not affect the \ SFF result:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.410355591086*^9, 3.4103556578929996`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{"n", "-", RowBox[{ "sided", " ", "prism", " ", "with", " ", "base", " ", "inscribed", " ", "in", " ", "unit", " ", "circle", " ", "in", " ", "XY", " ", "plane", " ", "and", " ", "apex", " ", "at", " ", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"pyramid", "[", "n_", "]"}], ":=", RowBox[{"cHull", "[", RowBox[{ RowBox[{"Prepend", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Sin", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", RowBox[{"Cos", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "n"}], "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}], "//", "N"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"pyramid", "[", "15", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.402161168828125*^9, 3.402161310453125*^9}, { 3.402161639203125*^9, 3.402161640484375*^9}, {3.402181537359375*^9, 3.402181537875*^9}, 3.402221738109375*^9, {3.40222255390625*^9, 3.4022225686875*^9}, {3.4023510104126253`*^9, 3.4023511337251253`*^9}, { 3.4023519713188753`*^9, 3.4023519719282503`*^9}, {3.4101152658174*^9, 3.4101153057274*^9}, {3.4101154610724*^9, 3.4101155572084*^9}, { 3.4103556786949997`*^9, 3.410355728465*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Prism", " ", "of", " ", "height", " ", "2", " ", "centered", " ", "on", " ", RowBox[{"origin", ".", " ", "Note"}], " ", "the", " ", "use", " ", "of", " ", "RandomSample", " ", "to", " ", "shuffle", " ", "the", " ", "points", " ", "so", " ", "it", " ", RowBox[{"doesn", "'"}], "t", " ", "start", " ", "with", " ", "many", " ", "in", " ", "one", " ", "plane"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"prism", "[", "n_", "]"}], ":=", RowBox[{"cHull", "[", RowBox[{"RandomSample", "[", RowBox[{ RowBox[{"Join", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Sin", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", RowBox[{"Cos", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "0", ",", RowBox[{"n", "-", "1"}]}], "}"}]}], "]"}], ",", " ", "\[IndentingNewLine]", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Sin", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", RowBox[{"Cos", "[", RowBox[{"2", " ", "Pi", " ", RowBox[{"i", "/", "n"}]}], "]"}], ",", RowBox[{"-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "0", ",", RowBox[{"n", "-", "1"}]}], "}"}]}], "]"}]}], "]"}], "//", "N"}], "]"}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"prism", "[", "17", "]"}], "]"}]}]}]], "Input", CellChangeTimes->{{3.402161168828125*^9, 3.402161310453125*^9}, { 3.402161346171875*^9, 3.402161398109375*^9}, {3.402161521203125*^9, 3.402161524*^9}, {3.40216181978125*^9, 3.40216188090625*^9}, 3.402161936*^9, {3.4021815940625*^9, 3.402181599328125*^9}, { 3.4023510844438753`*^9, 3.4023510955845003`*^9}, {3.4023511423501253`*^9, 3.4023511675845003`*^9}, {3.4023518213345003`*^9, 3.4023518214595003`*^9}, {3.4101155742464*^9, 3.4101156339054003`*^9}, 3.4101263141962*^9, {3.410355745657*^9, 3.410355754755*^9}}], Cell["\<\ The following coordinates were extracted from the 3D model at Mathworld, by \ Eric Weisstein:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.410355591086*^9, 3.4103556578929996`*^9}, { 3.41035577752*^9, 3.410355802135*^9}, {3.410355940052*^9, 3.4103559408199997`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"durerPoints", "=", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "0.70711`"}], ",", RowBox[{"-", "0.40825`"}], ",", RowBox[{"-", "0.44174`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.70711`"}], ",", "0.40825`", ",", "0.44174`"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.43702`"}], ",", RowBox[{"-", "0.25231`"}], ",", RowBox[{"-", "0.7792`"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "0.43702`"}], ",", "0.25231`", ",", "0.7792`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.`", ",", RowBox[{"-", "0.8165`"}], ",", "0.44174`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.`", ",", RowBox[{"-", "0.50462`"}], ",", "0.7792`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.`", ",", "0.50462`", ",", RowBox[{"-", "0.7792`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.`", ",", "0.8165`", ",", RowBox[{"-", "0.44174`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.43702`", ",", RowBox[{"-", "0.25231`"}], ",", RowBox[{"-", "0.7792`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.43702`", ",", "0.25231`", ",", "0.7792`"}], "}"}], ",", RowBox[{"{", RowBox[{"0.70711`", ",", RowBox[{"-", "0.40825`"}], ",", RowBox[{"-", "0.44174`"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0.70711`", ",", "0.40825`", ",", "0.44174`"}], "}"}]}], "}"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"cHull", "[", "durerPoints", "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101153769203997`*^9, 3.4101154043324003`*^9}, 3.4101263183282003`*^9}] }, Open ]], Cell[CellGroupData[{ Cell["6. Edge models", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101320872662*^9, 3.4101320880282*^9}}], Cell[TextData[{ "Note : The volume around each vertex is overlapped. Unfortunately, the \ orientation for different polyhedra in ", StyleBox["Mathematica", FontSlant->"Italic"], "'s data base is not consistent, e.g., a cube and an octahedron do not have \ thewir symmetry axes aligned. So this code does not make symmetric models \ when two different polyhedra are chosen, even if they have identical \ symmetry. Hopefully a future version of ", StyleBox["Mathematica", FontSlant->"Italic"], " will be more sensitive to such uses and aligh all the polyhedra in a \ symmetry-consistent manner. \n\nAlso, note that this code is based on ", StyleBox["Mathematica", FontSlant->"Italic"], "'s GC format, rather than our list-of-faces data format." }], "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"edgeIndicesOfFace", "[", "face_", "]"}], ":=", RowBox[{"Select", "[", RowBox[{ RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{"face", ",", RowBox[{"RotateLeft", "[", "face", "]"}]}], "}"}], "]"}], ",", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"#", "[", RowBox[{"[", "1", "]"}], "]"}], "<", RowBox[{"#", "[", RowBox[{"[", "2", "]"}], "]"}]}], ")"}], "&"}]}], "]"}]}], ";", RowBox[{ RowBox[{"edgeIndices", "[", "gc_", "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", " ", RowBox[{"Map", "[", RowBox[{"edgeIndicesOfFace", ",", " ", RowBox[{"gc", "[", RowBox[{"[", RowBox[{"1", ",", "2", ",", "1"}], "]"}], "]"}]}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"edges", "[", "gc_", "]"}], ":=", " ", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"vertices", "[", "gc", "]"}], "[", RowBox[{"[", "#", "]"}], "]"}], "&"}], ",", " ", RowBox[{"edgeIndices", "[", "gc", "]"}], ",", RowBox[{"{", "2", "}"}]}], "]"}]}], ";"}], " "}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"translateVertices", "[", RowBox[{"name_", ",", "scale_", ",", "xyz_"}], "]"}], ":=", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"xyz", "+", "#"}], ")"}], "&"}], ",", RowBox[{"scale", " ", RowBox[{"vertices", "[", RowBox[{"PolyhedronData", "[", "name", "]"}], "]"}]}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"strut", "[", RowBox[{"name_", ",", "scale_", ",", "edge_"}], "]"}], ":=", " ", RowBox[{"cHull", "[", RowBox[{"Join", "[", RowBox[{ RowBox[{"translateVertices", "[", RowBox[{"name", ",", "scale", ",", RowBox[{"edge", "[", RowBox[{"[", "1", "]"}], "]"}]}], "]"}], ",", RowBox[{"translateVertices", "[", RowBox[{"name", ",", "scale", ",", RowBox[{"edge", "[", RowBox[{"[", "2", "]"}], "]"}]}], "]"}]}], "]"}], "]"}]}], "\n", RowBox[{ RowBox[{"edgeModel", "[", RowBox[{"name_", ",", "nameVertex_", ",", "scale_"}], "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"strut", "[", RowBox[{"nameVertex", ",", "scale", ",", "#"}], "]"}], "&"}], ",", RowBox[{"edges", "[", RowBox[{"PolyhedronData", "[", "name", "]"}], "]"}]}], "]"}]}], "]"}]}]}], "Input", CellChangeTimes->{{3.4101167520453997`*^9, 3.4101167947033997`*^9}, 3.4101168271944*^9, {3.4101169142804003`*^9, 3.4101169158394003`*^9}, { 3.4101169476084003`*^9, 3.4101172259424*^9}, 3.4101177391034*^9, 3.4101178815584*^9}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"edgeModel", "[", RowBox[{"\"\\"", ",", "\"\\"", ",", ".2"}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101175841454*^9, 3.4101176131884003`*^9}, { 3.4101176524404*^9, 3.4101177157914*^9}, {3.4101177563794003`*^9, 3.4101177570624*^9}, {3.4101177954393997`*^9, 3.4101177960524*^9}, { 3.4101179830123997`*^9, 3.4101179887914*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"view", "[", RowBox[{"edgeModel", "[", RowBox[{"big", ",", "small", ",", "scale"}], "]"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"big", ",", RowBox[{"PolyhedronData", "[", "All", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"small", ",", RowBox[{"PolyhedronData", "[", "All", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"scale", ",", "0.001", ",", "1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4101182737614*^9, 3.4101183373644*^9}, { 3.4101368851052*^9, 3.4101368995341997`*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["7. Fractal Tree", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101320912662*^9, 3.4101320920202*^9}}], Cell["\<\ Each branch is a square prismatoid strut which surrounds the line connecting \ the two given points. Taking the Cross product with a \"random\" vector gives \ one direction orthogonal to the line, v1. Then v2 is constructed orthogonal \ to v1 and the line, and they provide a coordinate system for creating the two \ square bases of the strut. \ \>", "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}, {3.4103564643970003`*^9, 3.4103565773900003`*^9}, { 3.410356612066*^9, 3.410356676977*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"branch", "[", RowBox[{"p1_", ",", "p2_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"v1", ",", "v2", ",", RowBox[{"size", "=", RowBox[{"0.08", RowBox[{"Sqrt", "[", RowBox[{ RowBox[{"(", RowBox[{"p1", "-", "p2"}], ")"}], ".", RowBox[{"(", RowBox[{"p1", "-", "p2"}], ")"}]}], "]"}]}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"v1", "=", RowBox[{"size", " ", RowBox[{"unit", "[", RowBox[{"Cross", "[", RowBox[{ RowBox[{"(", RowBox[{"p2", "-", "p1"}], ")"}], ",", RowBox[{"{", RowBox[{"1", ",", "2", ",", "3.4567"}], "}"}]}], "]"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"v2", "=", RowBox[{"size", " ", RowBox[{"unit", "[", RowBox[{"Cross", "[", RowBox[{ RowBox[{"(", RowBox[{"p2", "-", "p1"}], ")"}], ",", "v1"}], "]"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"cHull", "[", RowBox[{"{", RowBox[{ RowBox[{"p1", "+", "v1"}], ",", RowBox[{"p1", "-", "v1"}], ",", RowBox[{"p1", "+", "v2"}], ",", RowBox[{"p1", "-", "v2"}], ",", RowBox[{"p2", "+", "v1"}], ",", RowBox[{"p2", "-", "v1"}], ",", RowBox[{"p2", "+", "v2"}], ",", RowBox[{"p2", "-", "v2"}]}], "}"}], "]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4101189622194*^9, 3.4101190276424*^9}, { 3.4101191906104*^9, 3.4101191932024*^9}, {3.4101192443294*^9, 3.4101195518124*^9}, {3.4101195888234*^9, 3.4101196349584*^9}}], Cell["\<\ Standard recursive tree. Level 1 means just a single branch. The tree extendt \ starting at the given origin, in the \"Z\" direction of the Frenet frame, and \ the trunk has the given size. The three subtrees are rotated relative to the \ trunk by some fairly random angles I chose. Sow[] is used to collect all the \ branches into a set, returned by Reap[] in the main call, below. \ \>", "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}, {3.4103564643970003`*^9, 3.4103565773900003`*^9}, { 3.410356612066*^9, 3.4103569083529997`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"tree", "[", RowBox[{"level_", ",", "origin_", ",", "frenet_", ",", "size_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"top", ",", "M"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"level", "\[Equal]", "0"}], ",", RowBox[{"Return", "[", "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"top", "=", RowBox[{"origin", "+", RowBox[{"size", " ", RowBox[{"frenet", "[", RowBox[{"[", "3", "]"}], "]"}]}]}]}], ";", "\[IndentingNewLine]", RowBox[{"Sow", "[", RowBox[{"branch", "[", RowBox[{"origin", ",", "top"}], "]"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"tree", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "top", ",", RowBox[{ RowBox[{"RotationMatrix", "[", RowBox[{ RowBox[{"Pi", "/", "5"}], ",", RowBox[{"{", RowBox[{"1", ",", "0", ",", "0"}], "}"}]}], "]"}], ".", "frenet"}], ",", RowBox[{".6", " ", "size"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"tree", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "top", ",", RowBox[{ RowBox[{"RotationMatrix", "[", RowBox[{ RowBox[{"Pi", "/", "6"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", ".5"}], ",", ".6", ",", "0"}], "}"}]}], "]"}], ".", "frenet"}], ",", RowBox[{".7", " ", "size"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"tree", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "top", ",", RowBox[{ RowBox[{"RotationMatrix", "[", RowBox[{ RowBox[{"Pi", "/", "7"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", ".5"}], ",", RowBox[{"-", ".6"}], ",", "0"}], "}"}]}], "]"}], ".", "frenet"}], ",", RowBox[{".5", " ", "size"}]}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}]], "Input", CellChangeTimes->{ 3.4101191126074*^9, {3.4101196551864*^9, 3.4101196877934*^9}, { 3.4101197435854*^9, 3.4101197445094*^9}, {3.4101198215204*^9, 3.4101198358714*^9}, {3.4101201008674*^9, 3.4101201041504*^9}, { 3.4101201801694*^9, 3.4101201909644003`*^9}, 3.4101202690214*^9, { 3.4101203572874002`*^9, 3.4101203938473997`*^9}, {3.4101205756744003`*^9, 3.4101206194934*^9}, {3.4101207504804*^9, 3.4101207574164*^9}, { 3.410197924166*^9, 3.4101979529110003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"makeTree", "[", "level_", "]"}], ":=", RowBox[{ RowBox[{"Reap", "[", RowBox[{"tree", "[", RowBox[{"level", ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"IdentityMatrix", "[", "3", "]"}], ",", "1"}], "]"}], "]"}], "[", RowBox[{"[", RowBox[{"2", ",", "1"}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.4101202183494*^9, 3.4101202857424*^9}, { 3.4101203410903997`*^9, 3.4101203511594*^9}, {3.4101206250973997`*^9, 3.4101206293924*^9}, {3.4101206611524*^9, 3.4101206729793997`*^9}}], Cell[BoxData[ RowBox[{"view", "[", RowBox[{"makeTree", "[", "7", "]"}], "]"}]], "Input", CellChangeTimes->{{3.4101196969094*^9, 3.4101197538984003`*^9}, 3.4101198393504*^9, 3.4101198976334*^9, {3.4101200649294*^9, 3.4101200660014*^9}, {3.4101203779214*^9, 3.4101204420973997`*^9}, { 3.4101206450643997`*^9, 3.4101206531734*^9}, {3.4101206921344*^9, 3.4101207220874*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["8. Fractal Polyhedron", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101208521694*^9, 3.4101208537764*^9}, {3.4101320952812*^9, 3.4101320960612*^9}}], Cell[TextData[{ "This is kind of fun, once you understand how the parameters work. It would \ be much better if ", StyleBox["Mathematica'", FontSlant->"Italic"], "s polyhedra were oriented with a consistent view to symmetry. The points[] \ function assembles together {vertices, edge midpoints, and face centers} so \ it is easy to choose one of the three options with a slider. The allSums[] \ function gives all nm possible sums obtained by adding one of the n elements \ of the first list to one of the m elements of the second list. The centers[] \ function applies this rrecursively to give a fractal pattern of points, uses \ as the centers of all the small polyhedra. The translates[] function gives \ many copies of a given object, one centered at each of the points in the \ given list of xyzs. The makeCell[] function optionally pokes (stellates) the \ unit cell." }], "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}, {3.4103564643970003`*^9, 3.4103565773900003`*^9}, {3.410356612066*^9, 3.4103569083529997`*^9}, { 3.410356965233*^9, 3.410357095068*^9}, {3.410357146729*^9, 3.410357263354*^9}, {3.410357299099*^9, 3.410357325131*^9}, { 3.410357356641*^9, 3.41035742506*^9}, 3.410357761799*^9, { 3.410357859453*^9, 3.410357909309*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"points", "[", "name_", "]"}], " ", ":=", " ", RowBox[{"With", "[", RowBox[{ RowBox[{"{", RowBox[{"gc", "=", RowBox[{"PolyhedronData", "[", "name", "]"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{"vertices", "[", "gc", "]"}], ",", " ", RowBox[{"Map", "[", RowBox[{"average", ",", RowBox[{"edges", "[", "gc", "]"}]}], "]"}], ",", " ", RowBox[{"Map", "[", RowBox[{"average", ",", RowBox[{"faces", "[", "gc", "]"}]}], "]"}]}], "}"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"allSums", "[", RowBox[{"L1_", ",", "L2_"}], "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Outer", "[", RowBox[{"Plus", ",", "L1", ",", "L2", ",", "1"}], "]"}]}], "]"}]}], " ", RowBox[{"(*", " ", RowBox[{ RowBox[{"one", " ", "from", " ", "column", " ", "A"}], " ", "+", " ", RowBox[{"one", " ", "from", " ", "column", " ", "B"}]}], " ", "*)"}]}], "\n", RowBox[{ RowBox[{ RowBox[{"centers", "[", RowBox[{"depth_", ",", "type_", ",", "alpha_", ",", "points_"}], "]"}], ":=", " ", RowBox[{"(*", " ", RowBox[{ "recursive", " ", "fn", " ", "constructs", " ", "pattern", " ", "of", " ", "ceners"}], " ", "*)"}], RowBox[{"If", "[", RowBox[{ RowBox[{"depth", "\[Equal]", "0"}], ",", RowBox[{"{", RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}], "}"}], ",", RowBox[{"allSums", "[", RowBox[{ RowBox[{"points", "[", RowBox[{"[", RowBox[{"type", "+", "1"}], "]"}], "]"}], ",", RowBox[{"alpha", " ", RowBox[{"centers", "[", RowBox[{ RowBox[{"depth", "-", "1"}], ",", "type", ",", "alpha", ",", "points"}], "]"}]}]}], "]"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{ RowBox[{"translates", "[", RowBox[{"obj_", ",", "xyzs_"}], "]"}], ":=", RowBox[{"Apply", "[", RowBox[{"Join", ",", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"translate", "[", RowBox[{"obj", ",", "#"}], "]"}], "&"}], ",", "xyzs"}], "]"}]}], "]"}]}], ";"}], " ", RowBox[{"(*", " ", RowBox[{"many", " ", "copies", " ", "of", " ", "obj"}], " ", "*)"}]}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"makeCell", "[", RowBox[{"stell_", ",", "name_"}], "]"}], ":=", RowBox[{"If", "[", RowBox[{"stell", ",", " ", RowBox[{"poke", "[", RowBox[{ RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "name", "]"}], "]"}], ",", "2.83"}], "]"}], ",", RowBox[{"faces", "[", RowBox[{"PolyhedronData", "[", "name", "]"}], "]"}]}], "]"}]}], ";"}]}], "Input", CellChangeTimes->{{3.4020511275994997`*^9, 3.4020511360682497`*^9}, { 3.4020519847244997`*^9, 3.4020520059276247`*^9}, {3.4020520367713747`*^9, 3.4020520377869997`*^9}, {3.4020520781932497`*^9, 3.4020520787401247`*^9}, {3.4020556579276247`*^9, 3.4020556586307497`*^9}, {3.4020785903807497`*^9, 3.4020785935994997`*^9}, {3.4020798816307497`*^9, 3.4020798832557497`*^9}, {3.4020804446307497`*^9, 3.4020804653494997`*^9}, {3.4020839757869997`*^9, 3.4020839781932497`*^9}, {3.402241783484375*^9, 3.40224179203125*^9}, { 3.4022572890380063`*^9, 3.4022572942723813`*^9}, {3.4025352246001253`*^9, 3.4025352259282503`*^9}, {3.4025352572563753`*^9, 3.4025352653188753`*^9}, {3.40258540978125*^9, 3.40258542084375*^9}, { 3.40258546115625*^9, 3.402585467484375*^9}, {3.404834739062277*^9, 3.404834744069769*^9}, {3.407965266345887*^9, 3.407965270425704*^9}, { 3.4079653527925024`*^9, 3.4079654793722916`*^9}, {3.4079655163279343`*^9, 3.4079656772522044`*^9}, {3.407965724554841*^9, 3.4079657535832567`*^9}, { 3.4079657933053236`*^9, 3.407965828698566*^9}, {3.407965876494335*^9, 3.407965914866879*^9}, {3.407965962250565*^9, 3.4079659687237835`*^9}, { 3.40796603332707*^9, 3.407966099062121*^9}, 3.407966709316031*^9, { 3.407968071799139*^9, 3.407968103976767*^9}, {3.40796837475924*^9, 3.4079683780812936`*^9}, {3.4079687376578884`*^9, 3.4079687486444902`*^9}, {3.4079698522137723`*^9, 3.4079698569419856`*^9}, {3.4080388508498974`*^9, 3.408038851528565*^9}, 3.408181496325472*^9, {3.408181529529401*^9, 3.408181729038116*^9}, 3.4081825957111607`*^9, {3.4081827257780313`*^9, 3.408182802984028*^9}, { 3.408183029199041*^9, 3.408183188441778*^9}, {3.4083412642380667`*^9, 3.408341264369894*^9}, {3.4083414044683495`*^9, 3.4083414049536695`*^9}, { 3.4083426798001657`*^9, 3.4083426933715625`*^9}, {3.4083429882459803`*^9, 3.4083429932017183`*^9}, {3.408343056951679*^9, 3.4083430672156706`*^9}, { 3.408343184385076*^9, 3.408343191415876*^9}, {3.4083447171652007`*^9, 3.4083447201903973`*^9}, {3.4083448420566216`*^9, 3.4083448434012613`*^9}, 3.4083449753674245`*^9, {3.4083452850565877`*^9, 3.4083453134610195`*^9}, 3.40834540476433*^9, {3.4083454397894316`*^9, 3.4083454431651917`*^9}, { 3.408345664945919*^9, 3.4083456715851426`*^9}, {3.4083457226541395`*^9, 3.4083457363017035`*^9}, 3.4083458698197203`*^9, {3.408346424154358*^9, 3.408346424350634*^9}, {3.4083464546875596`*^9, 3.408346471124984*^9}, { 3.4101208840104*^9, 3.4101208948254004`*^9}, {3.410357268332*^9, 3.4103572881540003`*^9}, {3.410357529777*^9, 3.410357572101*^9}, { 3.410357607834*^9, 3.4103576096029997`*^9}}], Cell["\<\ To use this, first set the depth to 1. Set the two polyhedra and the VEF \ option. Optionally check the Stellated box f desired Next, adjust beta so the \ cells just barely overlap. Then set the depth to 2 and adjust alpha so te \ groups just barely contact. Then you can set the depth to 3 if desired. \ \>", "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}, {3.4103564643970003`*^9, 3.4103565773900003`*^9}, {3.410356612066*^9, 3.4103569083529997`*^9}, { 3.410356965233*^9, 3.410357095068*^9}, {3.410357146729*^9, 3.410357263354*^9}, {3.410357299099*^9, 3.410357325131*^9}, { 3.410357356641*^9, 3.41035742506*^9}, 3.410357761799*^9, { 3.410357859453*^9, 3.410358155465*^9}}], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Graphics3D", "[", RowBox[{"Map", "[", RowBox[{"Polygon", ",", RowBox[{"translates", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{"beta", " ", RowBox[{"alpha", "^", RowBox[{"(", RowBox[{"depth", "-", "1"}], ")"}]}]}], ")"}], " ", RowBox[{"makeCell", "[", RowBox[{"stellated", ",", "cell"}], "]"}]}], ",", RowBox[{"centers", "[", RowBox[{"depth", ",", "VEF", ",", "alpha", ",", RowBox[{"points", "[", "name", "]"}]}], "]"}]}], "]"}]}], "]"}], " ", "]"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"depth", ",", "0", ",", "3", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"VEF", ",", "0", ",", "2", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"alpha", ",", ".1"}], "}"}], ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"beta", ",", ".1"}], "}"}], ",", "0", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"name", ",", RowBox[{"PolyhedronData", "[", "All", "]"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"cell", ",", RowBox[{"PolyhedronData", "[", "All", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"stellated", ",", RowBox[{"{", RowBox[{"False", ",", "True"}], "}"}]}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4079667177979097`*^9, 3.407966751280142*^9}, { 3.4079671518023586`*^9, 3.407967181899065*^9}, {3.4079672141128235`*^9, 3.4079672405037127`*^9}, {3.407967329241197*^9, 3.4079673653023653`*^9}, { 3.407967631192574*^9, 3.407967808622624*^9}, {3.4079679377325244`*^9, 3.4079679811662683`*^9}, {3.40796822416634*^9, 3.4079682419278984`*^9}, { 3.407968802982809*^9, 3.4079688149068503`*^9}, {3.4081818369833555`*^9, 3.4081818479738626`*^9}, {3.4081820050233817`*^9, 3.4081820409468637`*^9}, {3.4081821658724613`*^9, 3.4081821735360336`*^9}, {3.4081824437540903`*^9, 3.4081824662438617`*^9}, {3.4081825005444*^9, 3.40818251611274*^9}, { 3.4081828370795016`*^9, 3.40818285919625*^9}, {3.408182944007228*^9, 3.408182968597451*^9}, {3.4081830039379625`*^9, 3.4081830173580017`*^9}, { 3.4083418891046796`*^9, 3.4083418947927923`*^9}, 3.4083458237648554`*^9, { 3.4083461448812165`*^9, 3.408346154982133*^9}, 3.4101209475874*^9}, FontVariations->{"Underline"->True}] }, Open ]], Cell[CellGroupData[{ Cell["9. Marching Cubes", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101208521694*^9, 3.4101208537764*^9}, {3.4101210914344*^9, 3.4101210999214*^9}, {3.4101320996612*^9, 3.4101321005182*^9}}], Cell["\<\ This is a very simple version, in which all the boundaries are \ voxel-separating squares. (No triangular corner clipping is used.) So it can \ result in non-manifold boundaries, with four faces meeting at an edge, or two \ sheets meeting at a vertex. But I have not observed any problems with the \ output being sliced on several different SFF machines. Note that the function \ g is defined internally as the intersection of f with the given cuboid, which \ is an indirect example of CSG, as made more explicit below.\ \>", "Text", CellChangeTimes->{{3.4101181545624*^9, 3.4101182098824*^9}, { 3.410356102974*^9, 3.41035633875*^9}, {3.4103563867790003`*^9, 3.4103564048459997`*^9}, {3.4103564643970003`*^9, 3.4103565773900003`*^9}, {3.410356612066*^9, 3.4103569083529997`*^9}, { 3.410356965233*^9, 3.410357095068*^9}, {3.410357146729*^9, 3.410357263354*^9}, {3.410357299099*^9, 3.410357325131*^9}, { 3.410357356641*^9, 3.41035742506*^9}, 3.410357761799*^9, { 3.410357859453*^9, 3.410358155465*^9}, {3.4103581937869997`*^9, 3.4103584327799997`*^9}, {3.410358659087*^9, 3.410358675811*^9}, { 3.410359335367*^9, 3.410359374743*^9}, {3.410359405825*^9, 3.410359426458*^9}, {3.4103594658900003`*^9, 3.410359467356*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"boundary", "[", RowBox[{ "f_", ",", "xmin_", ",", "xmax_", ",", "ymin_", ",", "ymax_", ",", "zmin_", ",", "zmax_", ",", "d_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "g", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"g", "[", RowBox[{"x_", ",", "y_", ",", "z_"}], "]"}], ":=", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ "xmin", " ", "\[LessEqual]", " ", "x", "\[LessEqual]", " ", "xmax"}], " ", "&&", RowBox[{ "ymin", "\[LessEqual]", " ", "y", "\[LessEqual]", " ", "ymax"}], " ", "&&", RowBox[{ "zmin", "\[LessEqual]", " ", "z", "\[LessEqual]", " ", "zmax"}]}], ",", RowBox[{"f", "[", RowBox[{"x", ",", "y", ",", "z"}], "]"}], ",", "False"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"Reap", "[", "\[IndentingNewLine]", RowBox[{"For", "[", RowBox[{ RowBox[{"x", "=", "xmin"}], ",", RowBox[{"x", "\[LessEqual]", "xmax"}], ",", RowBox[{"x", "+=", "d"}], ",", "\[IndentingNewLine]", RowBox[{"For", "[", RowBox[{ RowBox[{"y", "=", "ymin"}], ",", RowBox[{"y", "\[LessEqual]", "ymax"}], ",", RowBox[{"y", "+=", "d"}], ",", "\[IndentingNewLine]", RowBox[{"For", "[", RowBox[{ RowBox[{"z", "=", "zmin"}], ",", RowBox[{"z", "\[LessEqual]", "zmax"}], ",", RowBox[{"z", "+=", "d"}], ",", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"g", "[", RowBox[{"x", ",", "y", ",", "z"}], "]"}], ",", RowBox[{"(", " ", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", "z"}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}]}], "}"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{ RowBox[{"x", "-", "d"}], ",", "y", ",", "z"}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}]}], "}"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", "z"}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}]}], "}"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{"x", ",", RowBox[{"y", "-", "d"}], ",", "z"}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}]}], "}"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{"x", ",", "y", ",", RowBox[{"z", "+", "d"}]}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", RowBox[{"z", "+", "d"}]}], "}"}]}], "}"}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"!", RowBox[{"g", "[", RowBox[{"x", ",", "y", ",", RowBox[{"z", "-", "d"}]}], "]"}]}], ",", RowBox[{"Sow", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", RowBox[{"y", "+", "d"}], ",", "z"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x", "+", "d"}], ",", "y", ",", "z"}], "}"}]}], "}"}], "]"}]}], "]"}], ";"}], "\[IndentingNewLine]", ")"}]}], "]"}]}], "\[IndentingNewLine]", "]"}]}], "]"}]}], "]"}], "]"}], "[", RowBox[{"[", RowBox[{"2", ",", "1"}], "]"}], "]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.400369889921875*^9, 3.400370009984375*^9}, { 3.4003700493125*^9, 3.40037025896875*^9}, {3.400370297296875*^9, 3.400370361796875*^9}, {3.40037039646875*^9, 3.40037055853125*^9}, { 3.40037073971875*^9, 3.40037079484375*^9}, {3.400370877375*^9, 3.40037093221875*^9}, {3.40037096625*^9, 3.40037100225*^9}, { 3.400371047921875*^9, 3.40037112796875*^9}, {3.400371451015625*^9, 3.400371520828125*^9}, {3.400371628953125*^9, 3.400371637625*^9}, { 3.400371689359375*^9, 3.4003717738125*^9}, 3.400371806609375*^9, { 3.40037220959375*^9, 3.40037222640625*^9}, {3.40037232334375*^9, 3.400372391328125*^9}, {3.400373720625*^9, 3.4003737315625*^9}, 3.4003737931875*^9, 3.400538367859375*^9, {3.4009345273138494`*^9, 3.400934577445936*^9}, {3.4011090633589473`*^9, 3.401109084839835*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{"fSphere", "[", RowBox[{"x_", ",", "y_", ",", "z_"}], "]"}], ":=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"x", "^", "2"}], "+", RowBox[{"y", "^", "2"}], "+", RowBox[{"z", "^", "2"}]}], ")"}], "\[LessEqual]", RowBox[{"15", "^", "2"}]}]}], "\n", RowBox[{"view", "[", RowBox[{"boundary", "[", RowBox[{ "fSphere", ",", " ", "0", ",", "20", ",", "0", ",", "20", ",", "0", ",", "20", ",", "1"}], "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4003705738125*^9, 3.40037063878125*^9}, 3.400371154578125*^9, 3.40037253325*^9, {3.40053812734375*^9, 3.4005381448125*^9}, {3.400538277953125*^9, 3.400538282265625*^9}, { 3.400933558881312*^9, 3.400933570528059*^9}, {3.400933609103528*^9, 3.4009336092437296`*^9}, {3.400934586158464*^9, 3.4009346117252274`*^9}, 3.4101217321024*^9, 3.4101217913514*^9, 3.4101218216744003`*^9, 3.4101220209684*^9}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"fWave", "[", RowBox[{"x_", ",", "y_", ",", "z_"}], "]"}], ":=", RowBox[{ RowBox[{"Abs", "[", RowBox[{ RowBox[{"Sin", "[", "x", "]"}], "+", RowBox[{"Sin", "[", "y", "]"}], "-", "z"}], "]"}], "<", "1"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"boundary", "[", RowBox[{"fWave", ",", " ", "0", ",", "20", ",", "0", ",", "20", ",", RowBox[{"-", "3"}], ",", "3", ",", ".5"}], "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101219284844*^9, 3.4101221369174*^9}, { 3.4101223857164*^9, 3.4101224314354*^9}, {3.4101224932444*^9, 3.4101225144314003`*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["10. Menger Sponge", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101208521694*^9, 3.4101208537764*^9}, {3.4101210914344*^9, 3.4101210999214*^9}, {3.4101213258774*^9, 3.4101213287344*^9}, { 3.4101321055962*^9, 3.4101321068952*^9}}], Cell["\<\ If you don't understand this, try cutting off two of your fingers on each \ hand:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550385299997`*^9}, { 3.4103587094709997`*^9, 3.4103587559890003`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"fMenger", "[", RowBox[{"i_", ",", "j_", ",", "k_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"id", "=", RowBox[{"IntegerDigits", "[", RowBox[{"i", ",", "3", ",", "7"}], "]"}]}], ",", RowBox[{"jd", "=", RowBox[{"IntegerDigits", "[", RowBox[{"j", ",", "3", ",", "7"}], "]"}]}], ",", RowBox[{"kd", "=", RowBox[{"IntegerDigits", "[", RowBox[{"k", ",", "3", ",", "7"}], "]"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"For", "[", RowBox[{ RowBox[{"n", "=", "1"}], ",", " ", RowBox[{"n", "\[LessEqual]", "7"}], ",", " ", RowBox[{"n", "++"}], ",", " ", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"id", "[", RowBox[{"[", "n", "]"}], "]"}], "==", RowBox[{"jd", "[", RowBox[{"[", "n", "]"}], "]"}], "==", "1"}], ")"}], " ", "||", " ", RowBox[{"(", RowBox[{ RowBox[{"id", "[", RowBox[{"[", "n", "]"}], "]"}], "==", RowBox[{"kd", "[", RowBox[{"[", "n", "]"}], "]"}], "==", "1"}], ")"}], " ", "||", RowBox[{"(", RowBox[{ RowBox[{"jd", "[", RowBox[{"[", "n", "]"}], "]"}], "==", RowBox[{"kd", "[", RowBox[{"[", "n", "]"}], "]"}], "==", "1"}], ")"}]}], ",", "\[IndentingNewLine]", RowBox[{"Return", " ", "[", "False", "]"}]}], "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"Return", "[", "True", "]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.400418190109375*^9, 3.4004182620625*^9}, { 3.400418311828125*^9, 3.400418558421875*^9}, {3.400538149921875*^9, 3.40053815075*^9}, {3.400538454953125*^9, 3.400538534109375*^9}, { 3.4009344144816046`*^9, 3.400934421551771*^9}}], Cell[BoxData[ RowBox[{"\[IndentingNewLine]", RowBox[{"Table", "[", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"max", "=", RowBox[{ RowBox[{"3", "^", "depth"}], "-", "1"}]}], ";", "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"boundary", "[", RowBox[{ "fMenger", ",", "0", ",", "max", ",", "0", ",", "max", ",", "0", ",", "max", ",", "1"}], "]"}], "]"}]}], ")"}], ",", " ", RowBox[{"{", RowBox[{"depth", ",", "0", ",", "3"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.400370655703125*^9, 3.400370667953125*^9}, { 3.40037070921875*^9, 3.400370713734375*^9}, {3.400371158328125*^9, 3.400371165125*^9}, {3.400371544109375*^9, 3.4003715449375*^9}, 3.40037160809375*^9, 3.400371791109375*^9, 3.40037185071875*^9, 3.400372064515625*^9, {3.400372520078125*^9, 3.400372545109375*^9}, { 3.400373754578125*^9, 3.40037377034375*^9}, 3.400373812671875*^9, { 3.400418619546875*^9, 3.4004186376875*^9}, {3.40053820725*^9, 3.4005382080625*^9}, {3.400538296609375*^9, 3.4005383151875*^9}, { 3.400544315953125*^9, 3.400544332421875*^9}, {3.4006742783125*^9, 3.400674333015625*^9}, {3.400674366*^9, 3.40067441515625*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["11. CSG", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101208521694*^9, 3.4101208537764*^9}, {3.4101210914344*^9, 3.4101210999214*^9}, {3.4101213258774*^9, 3.4101213287344*^9}, { 3.4101214358564*^9, 3.4101214361493998`*^9}, {3.4101321098552*^9, 3.4101321108241997`*^9}}], Cell["\<\ Any solid modeling textbook will explain about constructive solid geometry:\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550385299997`*^9}, { 3.410358924068*^9, 3.4103589458719997`*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"fDiff", "[", RowBox[{"x_", ",", "y_", ",", "z_"}], "]"}], ":=", RowBox[{"And", "[", RowBox[{ RowBox[{"fMenger", "[", RowBox[{"x", ",", "y", ",", "z"}], "]"}], ",", RowBox[{"Not", "[", RowBox[{"fSphere", "[", RowBox[{"x", ",", "y", ",", "z"}], "]"}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{"view", "[", RowBox[{"boundary", "[", RowBox[{ "fDiff", ",", "0", ",", "26", ",", "0", ",", "26", ",", "0", ",", "26", ",", "1"}], "]"}], "]"}]}], "Input", CellChangeTimes->{{3.4101214392384*^9, 3.4101215433004*^9}, { 3.4101216300634003`*^9, 3.4101216359344*^9}, {3.4101216866164*^9, 3.4101217113354*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["12. 3D Hilbert curve", "Subsection", CellChangeTimes->{{3.4101110625214*^9, 3.4101110676694*^9}, { 3.4101111092104*^9, 3.4101111098234*^9}, {3.4101116543414*^9, 3.4101116560494003`*^9}, {3.4101118620824003`*^9, 3.4101118637794*^9}, { 3.4101151678674*^9, 3.4101151709334*^9}, {3.4101160164014*^9, 3.4101160191794*^9}, {3.4101167205654*^9, 3.4101167229964*^9}, 3.4101180121963997`*^9, {3.4101182294474*^9, 3.4101182320764*^9}, { 3.4101208521694*^9, 3.4101208537764*^9}, {3.4101210914344*^9, 3.4101210999214*^9}, {3.4101213258774*^9, 3.4101213287344*^9}, { 3.4101223372743998`*^9, 3.4101223399024*^9}, {3.4101229836404*^9, 3.4101229844434*^9}, {3.4101321134302*^9, 3.4101321142922*^9}}], Cell["\<\ This is fairly routine, but I didn't look up a good source to cite. As \ implemented here, the makeHilbert[] function is used to set the definition of \ a voxel function, f, (defined only on integers) and then we apply Marching \ Cubes on f to get the boundary.\ \>", "Text", CellChangeTimes->{{3.41035441073*^9, 3.410354411139*^9}, {3.4103545256*^9, 3.410354557918*^9}, {3.410354595354*^9, 3.41035462198*^9}, { 3.4103547901400003`*^9, 3.410354797568*^9}, {3.4103548489189997`*^9, 3.410354927421*^9}, {3.4103549800030003`*^9, 3.4103550385299997`*^9}, { 3.4103588430559998`*^9, 3.4103588660690002`*^9}, {3.4103588975690002`*^9, 3.410358906868*^9}, {3.410359076488*^9, 3.410359155257*^9}, { 3.410359481885*^9, 3.410359500135*^9}}], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"hilbert", "[", RowBox[{"level_", ",", "u_", ",", "v_", ",", "w_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"level", "\[Equal]", "0"}], ",", RowBox[{"Return", "[", "]"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "v", ",", "u", ",", "w"}], "]"}], ";", RowBox[{"move", "[", "v", "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "w", ",", "v", ",", "u"}], "]"}], ";", RowBox[{"move", "[", "w", "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "w", ",", "v", ",", "u"}], "]"}], ";", RowBox[{"move", "[", RowBox[{"-", "v"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "u", ",", RowBox[{"-", "v"}], ",", RowBox[{"-", "w"}]}], "]"}], ";", RowBox[{"move", "[", "u", "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", "u", ",", RowBox[{"-", "v"}], ",", RowBox[{"-", "w"}]}], "]"}], ";", RowBox[{"move", "[", "v", "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", RowBox[{"-", "w"}], ",", "v", ",", RowBox[{"-", "u"}]}], "]"}], ";", RowBox[{"move", "[", RowBox[{"-", "w"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", RowBox[{"-", "w"}], ",", "v", ",", RowBox[{"-", "u"}]}], "]"}], ";", RowBox[{"move", "[", RowBox[{"-", "v"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{ RowBox[{"level", "-", "1"}], ",", RowBox[{"-", "v"}], ",", RowBox[{"-", "u"}], ",", "w"}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"move", "[", "delta_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z", ",", " ", RowBox[{"steps", "=", "2"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"For", "[", RowBox[{ RowBox[{"i", "=", "0"}], ",", RowBox[{"i", "<", "steps"}], ",", RowBox[{"i", "++"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"turtle", "+=", "delta"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}], "=", "turtle"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"fHilbert", "[", RowBox[{"x", ",", "y", ",", "z"}], "]"}], "=", "True"}], ";"}]}], "\[IndentingNewLine]", "]"}]}], "]"}]}], ";"}], "\n", RowBox[{ RowBox[{"makeHilbert", "[", "level_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"Clear", "[", "fHilbert", "]"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"fHilbert", "[", RowBox[{"x_", ",", "y_", ",", "z_"}], "]"}], ":=", "False"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"fHilbert", "[", RowBox[{"0", ",", "0", ",", "0"}], "]"}], ":=", "True"}], ";", "\[IndentingNewLine]", RowBox[{"turtle", "=", RowBox[{"{", RowBox[{"0", ",", "0", ",", "0"}], "}"}]}], ";", "\[IndentingNewLine]", RowBox[{"hilbert", "[", RowBox[{"level", ",", RowBox[{"{", RowBox[{"1", ",", "0", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "1", ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "1"}], "}"}]}], "]"}], ";"}]}], "\[IndentingNewLine]", "]"}]}]}], "Input", CellChangeTimes->{ 3.4101191126074*^9, {3.4101196551864*^9, 3.4101196877934*^9}, { 3.4101197435854*^9, 3.4101197445094*^9}, {3.4101198215204*^9, 3.4101198358714*^9}, {3.4101201008674*^9, 3.4101201041504*^9}, { 3.4101201801694*^9, 3.4101201909644003`*^9}, 3.4101202690214*^9, { 3.4101203572874002`*^9, 3.4101203938473997`*^9}, {3.4101205756744003`*^9, 3.4101206194934*^9}, {3.4101207504804*^9, 3.4101207574164*^9}, { 3.4101229342483997`*^9, 3.4101229357594*^9}, {3.4101231825404*^9, 3.4101231959254*^9}, {3.4101233465304003`*^9, 3.4101236196804*^9}, { 3.4101236563024*^9, 3.4101237840994*^9}, 3.4101245368684*^9, 3.4101246099774*^9, 3.4101246971764*^9, {3.4101247582654*^9, 3.4101247596024*^9}, {3.410198713424*^9, 3.410198719916*^9}, { 3.41035951415*^9, 3.4103595237320004`*^9}, {3.410359573776*^9, 3.410359574922*^9}}], Cell[BoxData[ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"makeHilbert", "[", "i", "]"}], ";", "\n", RowBox[{"view", "[", RowBox[{"boundary", "[", RowBox[{ "fHilbert", ",", "0", ",", "35", ",", "0", ",", "35", ",", "0", ",", "35", ",", "1"}], "]"}], "]"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "4"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.4101239041514*^9, 3.4101239225894003`*^9}, 3.4101241651794*^9, {3.4101245221144*^9, 3.4101245746124*^9}, { 3.4101246157524*^9, 3.4101246479684*^9}, {3.4101248853624*^9, 3.4101249446694*^9}, {3.410359530365*^9, 3.4103595316879997`*^9}}] }, Open ]] }, Open ]] }, WindowSize->{840, 1001}, WindowMargins->{{-1675, Automatic}, {-48, Automatic}}, ShowSelection->True, Magnification->1., FrontEndVersion->"6.0 for Microsoft Windows (32-bit) (June 19, 2007)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 342, 4, 71, "Section"], Cell[935, 29, 735, 11, 47, "Text"], Cell[CellGroupData[{ Cell[1695, 44, 249, 5, 36, "Subsection"], Cell[1947, 51, 148, 2, 31, "Input"], Cell[CellGroupData[{ Cell[2120, 57, 266, 5, 31, "Input"], Cell[2389, 64, 181, 3, 30, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[2607, 72, 642, 15, 52, "Input"], Cell[3252, 89, 1149, 34, 50, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[4438, 128, 847, 23, 52, "Input"], Cell[5288, 153, 3267, 103, 126, "Output"] }, Open ]], Cell[8570, 259, 411, 11, 52, "Input"], Cell[CellGroupData[{ Cell[9006, 274, 481, 13, 52, "Input"], Cell[9490, 289, 149, 2, 30, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[9688, 297, 298, 4, 36, "Subsection"], Cell[9989, 303, 1038, 28, 52, "Input"], Cell[11030, 333, 1974, 48, 92, "Input"], Cell[13007, 383, 730, 23, 52, "Input"], Cell[13740, 408, 827, 13, 83, "Text"], Cell[14570, 423, 310, 8, 31, "Input"], Cell[14883, 433, 809, 16, 65, "Text"], Cell[15695, 451, 2467, 72, 132, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[18199, 528, 315, 4, 36, "Subsection"], Cell[18517, 534, 432, 9, 47, "Text"], Cell[18952, 545, 855, 25, 52, "Input"], Cell[19810, 572, 672, 13, 47, "Text"], Cell[20485, 587, 347, 10, 31, "Input"], Cell[20835, 599, 592, 18, 31, "Input"], Cell[21430, 619, 416, 7, 65, "Text"], Cell[21849, 628, 764, 23, 52, "Input"], Cell[22616, 653, 465, 13, 31, "Input"], Cell[23084, 668, 835, 23, 72, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[23956, 696, 185, 3, 36, "Subsection"], Cell[24144, 701, 134, 3, 29, "Text"], Cell[24281, 706, 541, 13, 31, "Input"], Cell[24825, 721, 132, 1, 29, "Text"], Cell[24960, 724, 456, 11, 31, "Input"], Cell[25421, 738, 903, 13, 101, "Text"], Cell[26327, 753, 1818, 51, 112, "Input"], Cell[28148, 806, 440, 8, 47, "Text"], Cell[28591, 816, 520, 15, 31, "Input"], Cell[29114, 833, 363, 7, 31, "Input"], Cell[29480, 842, 405, 7, 29, "Text"], Cell[29888, 851, 329, 8, 31, "Input"], Cell[30220, 861, 507, 13, 31, "Input"], Cell[30730, 876, 793, 23, 52, "Input"], Cell[31526, 901, 286, 7, 31, "Input"], Cell[31815, 910, 373, 9, 31, "Input"], Cell[32191, 921, 212, 4, 31, "Input"], Cell[32406, 927, 344, 8, 31, "Input"], Cell[32753, 937, 431, 9, 31, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[33221, 951, 332, 5, 36, "Subsection"], Cell[33556, 958, 895, 15, 65, "Text"], Cell[34454, 975, 1713, 39, 192, "Input"], Cell[36170, 1016, 1335, 32, 72, "Input"], Cell[37510, 1051, 749, 20, 52, "Input"], Cell[38262, 1073, 3766, 86, 252, "Input"], Cell[42031, 1161, 251, 6, 31, "Input"], Cell[42285, 1169, 473, 8, 47, "Text"], Cell[42761, 1179, 1753, 42, 72, "Input"], Cell[44517, 1223, 2511, 58, 112, "Input"], Cell[47031, 1283, 487, 9, 29, "Text"], Cell[47521, 1294, 1791, 51, 132, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[49349, 1350, 444, 6, 36, "Subsection"], Cell[49796, 1358, 924, 19, 119, "Text"], Cell[50723, 1379, 2884, 83, 172, "Input"], Cell[53610, 1464, 408, 8, 31, "Input"], Cell[54021, 1474, 601, 15, 52, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[54659, 1494, 491, 7, 36, "Subsection"], Cell[55153, 1503, 618, 10, 65, "Text"], Cell[55774, 1515, 1728, 49, 92, "Input"], Cell[57505, 1566, 663, 10, 65, "Text"], Cell[58171, 1578, 2580, 67, 172, "Input"], Cell[60754, 1647, 602, 15, 31, "Input"], Cell[61359, 1664, 390, 7, 31, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[61786, 1676, 543, 8, 36, "Subsection"], Cell[62332, 1686, 1383, 23, 119, "Text"], Cell[63718, 1711, 5565, 126, 172, "Input"], Cell[69286, 1839, 819, 13, 47, "Text"], Cell[70108, 1854, 2496, 56, 112, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[72641, 1915, 581, 8, 36, "Subsection"], Cell[73225, 1925, 1262, 19, 83, "Text"], Cell[74490, 1946, 9424, 214, 312, "Input"], Cell[83917, 2162, 944, 22, 52, "Input"], Cell[84864, 2186, 669, 17, 52, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[85570, 2208, 627, 9, 36, "Subsection"], Cell[86200, 2219, 443, 8, 29, "Text"], Cell[86646, 2229, 2036, 53, 132, "Input"], Cell[88685, 2284, 1244, 26, 72, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[89966, 2315, 671, 10, 36, "Subsection"], Cell[90640, 2327, 432, 7, 29, "Text"], Cell[91075, 2336, 732, 20, 52, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[91844, 2361, 722, 10, 36, "Subsection"], Cell[92569, 2373, 754, 12, 47, "Text"], Cell[93326, 2387, 5045, 125, 492, "Input"], Cell[98374, 2514, 662, 15, 52, "Input"] }, Open ]] }, Open ]] } ] *) (* End of internal cache information *)