668 lines
24 KiB
Mathematica
668 lines
24 KiB
Mathematica
(* Content-type: application/vnd.wolfram.mathematica *)
|
|
|
|
(*** Wolfram Notebook File ***)
|
|
(* http://www.wolfram.com/nb *)
|
|
|
|
(* CreatedBy='Mathematica 12.2' *)
|
|
|
|
(*CacheID: 234*)
|
|
(* Internal cache information:
|
|
NotebookFileLineBreakTest
|
|
NotebookFileLineBreakTest
|
|
NotebookDataPosition[ 158, 7]
|
|
NotebookDataLength[ 24635, 660]
|
|
NotebookOptionsPosition[ 22569, 618]
|
|
NotebookOutlinePosition[ 22965, 634]
|
|
CellTagsIndexPosition[ 22922, 631]
|
|
WindowFrame->Normal*)
|
|
|
|
(* Beginning of Notebook Content *)
|
|
Notebook[{
|
|
|
|
Cell[CellGroupData[{
|
|
Cell["Polyhedral Gluing", "Title",
|
|
CellChangeTimes->{{3.8646851013555*^9,
|
|
3.8646851042932177`*^9}},ExpressionUUID->"c6976cd9-3620-46ab-9d1d-\
|
|
41139264d06c"],
|
|
|
|
Cell["\<\
|
|
If two polyhedra have a \[OpenCurlyDoubleQuote]compatible\
|
|
\[CloseCurlyDoubleQuote] face, meaning that the faces are the same polygon \
|
|
and have the same bilinear forms between each circle on the face, then a new \
|
|
polyhedron can be formed by gluing those two polyhedra together along that \
|
|
face. For example, two square pyramids can be glued along their square base \
|
|
resulting in an octahedron. Koebe-Andreev-Thurston then suggests that the \
|
|
same process can be done to packings. The gram matrix of the result can be \
|
|
computed in terms of the gram matrices of the two polyhedra being glued \
|
|
together, which is the point of this code.\
|
|
\>", "Text",
|
|
CellChangeTimes->{{3.8646851216008253`*^9, 3.864685203225716*^9}, {
|
|
3.864685249833454*^9, 3.864685394551296*^9}, {3.864685425661797*^9,
|
|
3.864685443377795*^9}},ExpressionUUID->"69f0dc3e-3370-4694-8ecf-\
|
|
6a022a4f5748"],
|
|
|
|
Cell[CellGroupData[{
|
|
|
|
Cell["Code", "Section",
|
|
CellChangeTimes->{{3.8646890911830273`*^9,
|
|
3.864689092234721*^9}},ExpressionUUID->"8cc30de0-2341-4e1e-884d-\
|
|
b38111d69159"],
|
|
|
|
Cell["\<\
|
|
fullGlue is the most useful function here. It takes two gram matrices and the \
|
|
number of vertices in the shared face. Importantly, the gram matrices should \
|
|
be organized so that the minor corresponding to the shared face is in the \
|
|
bottom left of the first gram matrix and top right of the second gram matrix.\
|
|
\
|
|
\>", "Text",
|
|
CellChangeTimes->{{3.864686062280192*^9, 3.864686067946493*^9}, {
|
|
3.8646890088746853`*^9, 3.864689070448163*^9}, {3.864689146741778*^9,
|
|
3.8646891552110786`*^9}},ExpressionUUID->"66dfbbac-8c73-460a-a03c-\
|
|
484d0f1ef4b6"],
|
|
|
|
Cell[BoxData[
|
|
RowBox[{
|
|
RowBox[{"glue", "[",
|
|
RowBox[{"G_", ",", "n_", ",", "m_", ",", "p_"}], "]"}], ":=",
|
|
RowBox[{"Block", "[",
|
|
RowBox[{
|
|
RowBox[{"{",
|
|
RowBox[{
|
|
"horizontal", ",", "vertical", ",", "eqs", ",", "solution", ",",
|
|
"indices"}], "}"}], ",", "\[IndentingNewLine]",
|
|
RowBox[{
|
|
RowBox[{"horizontal", "=",
|
|
RowBox[{"Inverse", "[",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"n", "-", "2"}], ";;",
|
|
RowBox[{"n", "+", "1"}]}], ",",
|
|
RowBox[{
|
|
RowBox[{"n", "-", "2"}], ";;",
|
|
RowBox[{"n", "+", "1"}]}]}], "\[RightDoubleBracket]"}], "]"}]}],
|
|
";", "\[IndentingNewLine]",
|
|
RowBox[{"vertical", "=",
|
|
RowBox[{"Inverse", "[",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"n", "-", "p"}], ";;",
|
|
RowBox[{"n", "-", "p", "+", "3"}]}], ",",
|
|
RowBox[{
|
|
RowBox[{"n", "-", "p"}], ";;",
|
|
RowBox[{"n", "-", "p", "+", "3"}]}]}], "\[RightDoubleBracket]"}],
|
|
"]"}]}], ";", "\[IndentingNewLine]",
|
|
RowBox[{"eqs", "=",
|
|
RowBox[{"Table", "[",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"j", ",",
|
|
RowBox[{"n", "+", "1", "+", "i"}]}], "\[RightDoubleBracket]"}],
|
|
"\[Equal]",
|
|
RowBox[{"horizontal", ".",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"n", "-", "2"}], ";;",
|
|
RowBox[{"n", "+", "1"}]}], ",",
|
|
RowBox[{"n", "+", "1", "+", "i"}]}], "\[RightDoubleBracket]"}],
|
|
".",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"j", ",",
|
|
RowBox[{
|
|
RowBox[{"n", "-", "2"}], ";;",
|
|
RowBox[{"n", "+", "1"}]}]}], "\[RightDoubleBracket]"}]}]}], ",",
|
|
|
|
RowBox[{"{",
|
|
RowBox[{"i", ",",
|
|
RowBox[{"m", "-", "1", "-", "p"}]}], "}"}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"j", ",",
|
|
RowBox[{"n", "-", "p"}]}], "}"}]}], "]"}]}], ";",
|
|
"\[IndentingNewLine]",
|
|
RowBox[{"eqs", "=",
|
|
RowBox[{"Flatten", "[",
|
|
RowBox[{"AppendTo", "[",
|
|
RowBox[{"eqs", ",",
|
|
RowBox[{"Table", "[",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"i", ",",
|
|
RowBox[{"n", "+", "1", "+", "j"}]}], "\[RightDoubleBracket]"}],
|
|
"\[Equal]",
|
|
RowBox[{"vertical", ".",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"i", ",",
|
|
RowBox[{
|
|
RowBox[{"n", "-", "p"}], ";;",
|
|
RowBox[{"n", "-", "p", "+", "3"}]}]}],
|
|
"\[RightDoubleBracket]"}], ".",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"n", "-", "p"}], ";;",
|
|
RowBox[{"n", "-", "p", "+", "3"}]}], ",",
|
|
RowBox[{"n", "+", "1", "+", "j"}]}],
|
|
"\[RightDoubleBracket]"}]}]}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"i", ",",
|
|
RowBox[{"n", "-", "p"}]}], "}"}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"j", ",",
|
|
RowBox[{"m", "-", "1", "-", "p"}]}], "}"}]}], "]"}]}], "]"}],
|
|
"]"}]}], ";", "\[IndentingNewLine]",
|
|
RowBox[{"indices", "=",
|
|
RowBox[{"Join", "[",
|
|
RowBox[{
|
|
RowBox[{"{", "1", "}"}], ",",
|
|
RowBox[{"Range", "[",
|
|
RowBox[{
|
|
RowBox[{"n", "-", "p", "+", "1"}], ",",
|
|
RowBox[{"n", "-", "p", "+", "3"}]}], "]"}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"n", "+", "m", "-", "p"}], "}"}]}], "]"}]}], ";",
|
|
"\[IndentingNewLine]",
|
|
RowBox[{"solution", "=",
|
|
RowBox[{
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"1", ",",
|
|
RowBox[{"n", "+", "m", "-", "p"}]}], "\[RightDoubleBracket]"}],
|
|
"\[Rule]",
|
|
RowBox[{"Min", "[",
|
|
RowBox[{
|
|
RowBox[{"Solve", "[",
|
|
RowBox[{
|
|
RowBox[{"Det", "[",
|
|
RowBox[{"G", "\[LeftDoubleBracket]",
|
|
RowBox[{"indices", ",", "indices"}], "\[RightDoubleBracket]"}],
|
|
"]"}], "\[Equal]", "0"}], "]"}], "/.",
|
|
RowBox[{
|
|
RowBox[{"{",
|
|
RowBox[{
|
|
SubscriptBox["x",
|
|
RowBox[{"_", ",", "_"}]], "\[Rule]", "y_"}], "}"}], "\[Rule]",
|
|
"y"}]}], "]"}]}]}], ";", "\[IndentingNewLine]",
|
|
RowBox[{"G", "/.",
|
|
RowBox[{"Flatten", "[",
|
|
RowBox[{"Join", "[",
|
|
RowBox[{
|
|
RowBox[{"Solve", "[",
|
|
RowBox[{"eqs", "/.", "solution"}], "]"}], ",",
|
|
RowBox[{"{", "solution", "}"}]}], "]"}], "]"}]}]}]}],
|
|
"\[IndentingNewLine]", "]"}]}]], "Input",
|
|
CellChangeTimes->CompressedData["
|
|
1:eJwdz1soQwEAxvGT1bJyeaJcSmto2lGWZsJW9rTy5NKpyS0ZRiPK5YGGyCXU
|
|
2lwTYhFtIxPngRQjhJZh7hI2hz1IRFLsOw9fv8evP7+4OkvtRxBElG+w+duP
|
|
s9nnTQ+1BLHmLeiHt3xGU5Oj8EPhHIclTOUklBZKZmHdc4YZpon1q3Bm728N
|
|
mj+dB5BUCh1QHKM6gaJvzimk3a5z6ErkMrCdGvljf7oTOHafSxfrgVCkWQyG
|
|
XVcrIbDhYC4ULtw+hcNxzUQEHJDK+JDoSBLAJvONEFati0nYL1PlQOrBqIJc
|
|
nbYUhkRWlMHM9kYtpFvuaiBZ+6WDPMlKK5QfunuhPz3dBwP2KQN8z1cYYTYj
|
|
mICescYp2O2Qz8PfHYsFDqZSNqiQExuwXhNnhyerhjO4m0tfQmPPG2tRm+ce
|
|
RianPLKdJvIV2k3HP/DIKwzb9jkn0MTB+M7yBHht9RZA5ZBVDcNjX3TQxqMY
|
|
uBxBs/4DTu0aTA==
|
|
"],
|
|
CellLabel->"In[1]:=",ExpressionUUID->"f999f2c9-b767-4605-ad2f-66ff04e65410"],
|
|
|
|
Cell[BoxData[
|
|
RowBox[{
|
|
RowBox[{"glueGramMatrix", "[",
|
|
RowBox[{"G1_", ",", "G2_", ",", "p_"}], "]"}], ":=",
|
|
RowBox[{"With", "[",
|
|
RowBox[{
|
|
RowBox[{"{",
|
|
RowBox[{
|
|
RowBox[{"n", "=",
|
|
RowBox[{"Length", "[", "G1", "]"}]}], ",",
|
|
RowBox[{"m", "=",
|
|
RowBox[{"Length", "[", "G2", "]"}]}]}], "}"}], ",",
|
|
"\[IndentingNewLine]",
|
|
RowBox[{"Table", "[",
|
|
RowBox[{
|
|
RowBox[{"Which", "[",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"i", "\[LessEqual]", "n"}], "&&",
|
|
RowBox[{"j", "\[LessEqual]", "n"}]}], ",",
|
|
RowBox[{"G1", "\[LeftDoubleBracket]",
|
|
RowBox[{"i", ",", "j"}], "\[RightDoubleBracket]"}], ",",
|
|
RowBox[{
|
|
RowBox[{"i", ">", "n"}], "&&",
|
|
RowBox[{"j", "\[LessEqual]",
|
|
RowBox[{"n", "-", "p"}]}]}], ",",
|
|
SubscriptBox["x",
|
|
RowBox[{"j", ",", "i"}]], ",",
|
|
RowBox[{
|
|
RowBox[{"j", ">", "n"}], "&&",
|
|
RowBox[{"i", "\[LessEqual]",
|
|
RowBox[{"n", "-", "p"}]}]}], ",",
|
|
SubscriptBox["x",
|
|
RowBox[{"i", ",", "j"}]], ",", "True", ",",
|
|
RowBox[{"G2", "\[LeftDoubleBracket]",
|
|
RowBox[{
|
|
RowBox[{"i", "-", "n", "+", "p"}], ",",
|
|
RowBox[{"j", "-", "n", "+", "p"}]}], "\[RightDoubleBracket]"}]}],
|
|
"]"}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"i", ",",
|
|
RowBox[{"n", "+", "m", "-", "p"}]}], "}"}], ",",
|
|
RowBox[{"{",
|
|
RowBox[{"j", ",",
|
|
RowBox[{"n", "+", "m", "-", "p"}]}], "}"}]}], "]"}]}],
|
|
"]"}]}]], "Input",
|
|
CellLabel->"In[2]:=",ExpressionUUID->"484c421f-d2da-424b-8fa0-2015585eec55"],
|
|
|
|
Cell[BoxData[
|
|
RowBox[{
|
|
RowBox[{"fullGlue", "[",
|
|
RowBox[{"G1_", ",", "G2_", ",", "p_"}], "]"}], ":=",
|
|
RowBox[{"glue", "[",
|
|
RowBox[{
|
|
RowBox[{"glueGramMatrix", "[",
|
|
RowBox[{"G1", ",", "G2", ",", "p"}], "]"}], ",",
|
|
RowBox[{"Length", "[", "G1", "]"}], ",",
|
|
RowBox[{"Length", "[", "G2", "]"}], ",", "p"}], "]"}]}]], "Input",
|
|
CellChangeTimes->{
|
|
3.832424922982353*^9, {3.832427829577507*^9, 3.8324278572062473`*^9}},
|
|
CellLabel->"In[3]:=",ExpressionUUID->"615a355b-596d-472f-94cd-927b8299d0e7"]
|
|
}, Open ]],
|
|
|
|
Cell[CellGroupData[{
|
|
|
|
Cell["Example", "Section",
|
|
CellChangeTimes->{{3.864689099589196*^9,
|
|
3.8646891002501593`*^9}},ExpressionUUID->"53df6ed4-fea9-4d4d-9058-\
|
|
34629f2222bd"],
|
|
|
|
Cell[TextData[{
|
|
Cell[BoxData[
|
|
FormBox[
|
|
TemplateBox[<|"boxes" -> FormBox[
|
|
SubscriptBox[
|
|
StyleBox["G", "TI"], "1"], TraditionalForm], "errors" -> {}, "input" ->
|
|
"G_1", "state" -> "Boxes"|>,
|
|
"TeXAssistantTemplate"], TraditionalForm]],ExpressionUUID->
|
|
"78d41863-8b3f-440c-b080-85e2f79cd5bc"],
|
|
" and ",
|
|
Cell[BoxData[
|
|
FormBox[
|
|
TemplateBox[<|"boxes" -> FormBox[
|
|
SubscriptBox[
|
|
StyleBox["G", "TI"], "2"], TraditionalForm], "errors" -> {}, "input" ->
|
|
"G_2", "state" -> "Boxes"|>,
|
|
"TeXAssistantTemplate"], TraditionalForm]],ExpressionUUID->
|
|
"9bae3839-a0cd-48f4-8ad0-cb15a054d42e"],
|
|
" are both gram matrices for the square pyramid, except with the square face \
|
|
in different locations to facilitate gluing."
|
|
}], "Text",
|
|
CellChangeTimes->{{3.864689372055653*^9,
|
|
3.8646894286541452`*^9}},ExpressionUUID->"fa0628e5-1dec-4f35-ab9d-\
|
|
99f5ac6c30b6"],
|
|
|
|
Cell[BoxData[{
|
|
RowBox[{
|
|
RowBox[{"G1", "=", "\[NoBreak]", GridBox[{
|
|
{"1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1"}
|
|
},
|
|
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
|
|
GridBoxSpacings->{"Columns" -> {
|
|
Offset[0.27999999999999997`], {
|
|
Offset[0.7]},
|
|
Offset[0.27999999999999997`]}, "Rows" -> {
|
|
Offset[0.2], {
|
|
Offset[0.4]},
|
|
Offset[0.2]}}]}], ";"}], "\[IndentingNewLine]",
|
|
RowBox[{
|
|
RowBox[{"G2", "=", GridBox[{
|
|
{"1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}], "1"}
|
|
},
|
|
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
|
|
GridBoxSpacings->{"Columns" -> {
|
|
Offset[0.27999999999999997`], {
|
|
Offset[0.7]},
|
|
Offset[0.27999999999999997`]}, "Rows" -> {
|
|
Offset[0.2], {
|
|
Offset[0.4]},
|
|
Offset[0.2]}}]}], ";"}]}], "Input",
|
|
CellChangeTimes->{{3.8646891073122263`*^9, 3.864689126434671*^9}},
|
|
CellLabel->"In[4]:=",ExpressionUUID->"085ac427-f46c-4dc2-aee1-130a2c0782ce"],
|
|
|
|
Cell[CellGroupData[{
|
|
|
|
Cell[BoxData[
|
|
RowBox[{"PlanarGraph", "[",
|
|
RowBox[{"AdjacencyGraph", "[",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"If", "[",
|
|
RowBox[{
|
|
RowBox[{"#", "==",
|
|
RowBox[{"-", "1"}]}], ",", "1", ",", "0"}], "]"}], "&"}], "/@",
|
|
"#"}], "&"}], "/@", "G1"}], ",",
|
|
RowBox[{"VertexLabels", "\[Rule]", "\"\<Name\>\""}]}], "]"}],
|
|
"]"}]], "Input",
|
|
CellChangeTimes->{{3.864689212064592*^9, 3.8646892935804453`*^9}},
|
|
CellLabel->"In[6]:=",ExpressionUUID->"4bd78a12-c716-4d29-bdc5-407e1f12cb5f"],
|
|
|
|
Cell[BoxData[
|
|
GraphicsBox[
|
|
NamespaceBox["NetworkGraphics",
|
|
DynamicModuleBox[{Typeset`graph = HoldComplete[
|
|
Graph[{1, 2, 3, 4, 5}, {Null,
|
|
SparseArray[
|
|
Automatic, {5, 5}, 0, {
|
|
1, {{0, 4, 7, 10, 13, 16}, {{2}, {3}, {4}, {5}, {1}, {3}, {5}, {1}, {
|
|
2}, {4}, {1}, {3}, {5}, {1}, {2}, {4}}}, Pattern}]}, {
|
|
GraphLayout -> "TutteEmbedding", VertexLabels -> {"Name"}}]]},
|
|
TagBox[GraphicsGroupBox[{
|
|
{Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.],
|
|
ArrowBox[{{{-5.551115123125783*^-17, -2.4894981252573997`*^-17}, \
|
|
{-1.8369701987210297`*^-16,
|
|
1.}}, {{-5.551115123125783*^-17, -2.4894981252573997`*^-17}, {1.,
|
|
1.2246467991473532`*^-16}}, {{-5.551115123125783*^-17, \
|
|
-2.4894981252573997`*^-17}, {
|
|
6.123233995736766*^-17, -1.}}, {{-5.551115123125783*^-17, \
|
|
-2.4894981252573997`*^-17}, {-1., -2.4492935982947064`*^-16}}, \
|
|
{{-1.8369701987210297`*^-16, 1.}, {1.,
|
|
1.2246467991473532`*^-16}}, {{-1.8369701987210297`*^-16,
|
|
1.}, {-1., -2.4492935982947064`*^-16}}, {{1.,
|
|
1.2246467991473532`*^-16}, {6.123233995736766*^-17, -1.}}, {{
|
|
6.123233995736766*^-17, -1.}, {-1., -2.4492935982947064`*^-16}}},
|
|
0.02261146496815286]},
|
|
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[
|
|
0.7]}], {
|
|
DiskBox[{-5.551115123125783*^-17, -2.4894981252573997*^-17},
|
|
0.02261146496815286],
|
|
InsetBox["1", {0.02238420829616007, 0.02238420829616011},
|
|
ImageScaled[{-0.030330085889910707, -0.030330085889910596}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{-1.8369701987210297*^-16, 1.}, 0.02261146496815286],
|
|
InsetBox["2", {-1.734723475976807*^-16, 1.031656050955414},
|
|
ImageScaled[{0.49999999999999967, -0.25}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{1., 1.2246467991473532*^-16}, 0.02261146496815286],
|
|
InsetBox["3", {1.031656050955414, 1.1449174941446927*^-16},
|
|
ImageScaled[{-0.25, 0.5000000000000002}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{6.123233995736766*^-17, -1.}, 0.02261146496815286],
|
|
InsetBox["4", {5.898059818321144*^-17, -1.031656050955414},
|
|
ImageScaled[{0.5000000000000002, 1.25}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{-1., -2.4492935982947064*^-16}, 0.02261146496815286],
|
|
InsetBox["5", {-1.031656050955414, -2.42861286636753*^-16},
|
|
ImageScaled[{1.25, 0.49999999999999983}],
|
|
BaseStyle->"Graphics"]}}}],
|
|
MouseAppearanceTag["NetworkGraphics"]],
|
|
AllowKernelInitialization->False]],
|
|
DefaultBaseStyle->{
|
|
"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
|
|
FormatType->TraditionalForm,
|
|
FrameTicks->None]], "Output",
|
|
CellChangeTimes->{{3.8646892585004997`*^9, 3.864689263798737*^9},
|
|
3.864689294022208*^9, 3.864689360006239*^9},
|
|
CellLabel->"Out[6]=",ExpressionUUID->"2ca3a7d6-f41e-4da7-8ceb-a84cbc2967c6"]
|
|
}, Open ]],
|
|
|
|
Cell["\<\
|
|
Gluing them together, we get the gram matrix for the octahedron, like we \
|
|
would expect.\
|
|
\>", "Text",
|
|
CellChangeTimes->{{3.864690266162278*^9, 3.864690275342745*^9}, {
|
|
3.864690395967308*^9,
|
|
3.8646903992567663`*^9}},ExpressionUUID->"45891619-6e9a-4992-b24d-\
|
|
dd2f63a07314"],
|
|
|
|
Cell[CellGroupData[{
|
|
|
|
Cell[BoxData[
|
|
RowBox[{
|
|
RowBox[{"(",
|
|
RowBox[{"G3", "=",
|
|
RowBox[{"fullGlue", "[",
|
|
RowBox[{"G1", ",", "G2", ",", "4"}], "]"}]}], ")"}], "//",
|
|
"MatrixForm"}]], "Input",
|
|
CellChangeTimes->{{3.864689303254286*^9, 3.864689329123877*^9}},
|
|
CellLabel->"In[7]:=",ExpressionUUID->"ff61a8b9-b643-4373-bc78-6712e853ef14"],
|
|
|
|
Cell[BoxData[
|
|
TagBox[
|
|
RowBox[{"(", "\[NoBreak]", GridBox[{
|
|
{"1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}]},
|
|
{
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}], "1",
|
|
RowBox[{"-", "1"}]},
|
|
{
|
|
RowBox[{"-", "3"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}],
|
|
RowBox[{"-", "1"}], "1"}
|
|
},
|
|
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
|
|
GridBoxSpacings->{"Columns" -> {
|
|
Offset[0.27999999999999997`], {
|
|
Offset[0.7]},
|
|
Offset[0.27999999999999997`]}, "Rows" -> {
|
|
Offset[0.2], {
|
|
Offset[0.4]},
|
|
Offset[0.2]}}], "\[NoBreak]", ")"}],
|
|
Function[BoxForm`e$,
|
|
MatrixForm[BoxForm`e$]]]], "Output",
|
|
CellChangeTimes->{{3.864689321262847*^9, 3.864689329391946*^9},
|
|
3.8646893600631847`*^9},
|
|
CellLabel->
|
|
"Out[7]//MatrixForm=",ExpressionUUID->"7eede2f5-b773-401c-a9b3-\
|
|
3a682dd52044"]
|
|
}, Open ]],
|
|
|
|
Cell[CellGroupData[{
|
|
|
|
Cell[BoxData[
|
|
RowBox[{"PlanarGraph", "[",
|
|
RowBox[{"AdjacencyGraph", "[",
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{
|
|
RowBox[{"If", "[",
|
|
RowBox[{
|
|
RowBox[{"#", "==",
|
|
RowBox[{"-", "1"}]}], ",", "1", ",", "0"}], "]"}], "&"}], "/@",
|
|
"#"}], "&"}], "/@", "G3"}], ",",
|
|
RowBox[{"VertexLabels", "\[Rule]", "\"\<Name\>\""}]}], "]"}],
|
|
"]"}]], "Input",
|
|
CellChangeTimes->{{3.8646893442132673`*^9, 3.864689344315606*^9}},
|
|
CellLabel->"In[8]:=",ExpressionUUID->"9f641d60-4d75-4401-888a-965f981ffe02"],
|
|
|
|
Cell[BoxData[
|
|
GraphicsBox[
|
|
NamespaceBox["NetworkGraphics",
|
|
DynamicModuleBox[{Typeset`graph = HoldComplete[
|
|
Graph[{1, 2, 3, 4, 5, 6}, {Null,
|
|
SparseArray[
|
|
Automatic, {6, 6}, 0, {
|
|
1, {{0, 4, 8, 12, 16, 20, 24}, {{2}, {3}, {4}, {5}, {1}, {3}, {5}, {
|
|
6}, {1}, {2}, {4}, {6}, {1}, {3}, {5}, {6}, {1}, {2}, {4}, {6}, {
|
|
2}, {3}, {4}, {5}}}, Pattern}]}, {
|
|
GraphLayout -> "TutteEmbedding", VertexLabels -> {"Name"}}]]},
|
|
TagBox[GraphicsGroupBox[{
|
|
{Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.],
|
|
ArrowBox[CompressedData["
|
|
1:eJxTTMoPSmVmYGDgAWImKObqmudjWblqDwMYfLBf7RPxomrba/vf/0Hg/n50
|
|
ee5wnR8rtI/Zs66Q0fk2c6c9uvzfTTzCndrH9v8wTHl4BYv8Soj5+1nA/Af7
|
|
0e1DNx9dnpB+BgaJJfJP19sdeuI/r23mSQzz0N2HLo+uH109uv3o8uj60dWj
|
|
ywMAx/u+mQ==
|
|
"], 0.020399597244776385`]},
|
|
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[
|
|
0.7]}], {
|
|
DiskBox[{-1.8369701987210297*^-16, 1.}, 0.020399597244776385],
|
|
InsetBox["1", {-1.734723475976807*^-16, 1.0285594361426869},
|
|
ImageScaled[{0.49999999999999967, -0.25}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{0.8660254037844387, -0.4999999999999997},
|
|
0.020399597244776385],
|
|
InsetBox["2", {0.8907586010017651, -0.5142797180713432},
|
|
ImageScaled[{-0.14951905283832911, 0.8749999999999998}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{0.1732073985846728, 0.10000551773978834},
|
|
0.020399597244776385],
|
|
InsetBox["3", {0.19794061426128717, 0.11428520383865937},
|
|
ImageScaled[{-0.14951953759811054, 0.12500083962982445}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{-0.17320359640270758, 0.1000035333892767},
|
|
0.020399597244776385],
|
|
InsetBox["4", {-0.19793681301073188, 0.11428321787489347},
|
|
ImageScaled[{1.1495195620578873, 0.12500088199553017}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{-0.8660254037844385, -0.5000000000000004},
|
|
0.020399597244776385],
|
|
InsetBox["5", {-0.8907586010017648, -0.5142797180713439},
|
|
ImageScaled[{1.149519052838329, 0.875}],
|
|
BaseStyle->"Graphics"]}, {
|
|
DiskBox[{9.505454913738554*^-7, -0.19999773721773378},
|
|
0.020399597244776385],
|
|
InsetBox["6", {9.408500613247717*^-7, -0.22855717336041909},
|
|
ImageScaled[{0.5000002546119084, 1.249999999999957}],
|
|
BaseStyle->"Graphics"]}}}],
|
|
MouseAppearanceTag["NetworkGraphics"]],
|
|
AllowKernelInitialization->False]],
|
|
DefaultBaseStyle->{
|
|
"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
|
|
FormatType->TraditionalForm,
|
|
FrameTicks->None]], "Output",
|
|
CellChangeTimes->{{3.8646893447350082`*^9, 3.864689360090755*^9}},
|
|
CellLabel->"Out[8]=",ExpressionUUID->"ff3acec1-17e1-4e23-ad7a-170fe8ca3a4a"]
|
|
}, Open ]]
|
|
}, Open ]]
|
|
}, Open ]]
|
|
},
|
|
WindowSize->{665.25, 778.5},
|
|
WindowMargins->{{Automatic, 6}, {6, Automatic}},
|
|
FrontEndVersion->"13.0 for Linux x86 (64-bit) (February 4, 2022)",
|
|
StyleDefinitions->"Default.nb",
|
|
ExpressionUUID->"d69326ff-8541-4cab-b66d-cadeed97da21"
|
|
]
|
|
(* End of Notebook Content *)
|
|
|
|
(* Internal cache information *)
|
|
(*CellTagsOutline
|
|
CellTagsIndex->{}
|
|
*)
|
|
(*CellTagsIndex
|
|
CellTagsIndex->{}
|
|
*)
|
|
(*NotebookFileOutline
|
|
Notebook[{
|
|
Cell[CellGroupData[{
|
|
Cell[580, 22, 160, 3, 98, "Title",ExpressionUUID->"c6976cd9-3620-46ab-9d1d-41139264d06c"],
|
|
Cell[743, 27, 886, 14, 173, "Text",ExpressionUUID->"69f0dc3e-3370-4694-8ecf-6a022a4f5748"],
|
|
Cell[CellGroupData[{
|
|
Cell[1654, 45, 151, 3, 68, "Section",ExpressionUUID->"8cc30de0-2341-4e1e-884d-b38111d69159"],
|
|
Cell[1808, 50, 563, 10, 104, "Text",ExpressionUUID->"66dfbbac-8c73-460a-a03c-484d0f1ef4b6"],
|
|
Cell[2374, 62, 5528, 144, 381, "Input",ExpressionUUID->"f999f2c9-b767-4605-ad2f-66ff04e65410"],
|
|
Cell[7905, 208, 1653, 46, 93, "Input",ExpressionUUID->"484c421f-d2da-424b-8fa0-2015585eec55"],
|
|
Cell[9561, 256, 523, 12, 51, "Input",ExpressionUUID->"615a355b-596d-472f-94cd-927b8299d0e7"]
|
|
}, Open ]],
|
|
Cell[CellGroupData[{
|
|
Cell[10121, 273, 154, 3, 68, "Section",ExpressionUUID->"53df6ed4-fea9-4d4d-9058-34629f2222bd"],
|
|
Cell[10278, 278, 903, 23, 59, "Text",ExpressionUUID->"fa0628e5-1dec-4f35-ab9d-99f5ac6c30b6"],
|
|
Cell[11184, 303, 2113, 74, 196, "Input",ExpressionUUID->"085ac427-f46c-4dc2-aee1-130a2c0782ce"],
|
|
Cell[CellGroupData[{
|
|
Cell[13322, 381, 572, 16, 51, "Input",ExpressionUUID->"4bd78a12-c716-4d29-bdc5-407e1f12cb5f"],
|
|
Cell[13897, 399, 2978, 56, 393, "Output",ExpressionUUID->"2ca3a7d6-f41e-4da7-8ceb-a84cbc2967c6"]
|
|
}, Open ]],
|
|
Cell[16890, 458, 289, 7, 35, "Text",ExpressionUUID->"45891619-6e9a-4992-b24d-dd2f63a07314"],
|
|
Cell[CellGroupData[{
|
|
Cell[17204, 469, 329, 8, 29, "Input",ExpressionUUID->"ff61a8b9-b643-4373-bc78-6712e853ef14"],
|
|
Cell[17536, 479, 1519, 54, 130, "Output",ExpressionUUID->"7eede2f5-b773-401c-a9b3-3a682dd52044"]
|
|
}, Open ]],
|
|
Cell[CellGroupData[{
|
|
Cell[19092, 538, 572, 16, 51, "Input",ExpressionUUID->"9f641d60-4d75-4401-888a-965f981ffe02"],
|
|
Cell[19667, 556, 2862, 57, 343, "Output",ExpressionUUID->"ff3acec1-17e1-4e23-ad7a-170fe8ca3a4a"]
|
|
}, Open ]]
|
|
}, Open ]]
|
|
}, Open ]]
|
|
}
|
|
]
|
|
*)
|
|
|