Circle-Packings/polyhedra/gluing.nb

669 lines
24 KiB
Mathematica
Raw Normal View History

2021-06-22 06:58:34 -07:00
(* 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]
2022-06-20 11:41:19 -07:00
NotebookDataLength[ 24635, 660]
NotebookOptionsPosition[ 22569, 618]
NotebookOutlinePosition[ 22965, 634]
CellTagsIndexPosition[ 22922, 631]
2021-06-22 06:58:34 -07:00
WindowFrame->Normal*)
(* Beginning of Notebook Content *)
Notebook[{
2022-06-20 11:41:19 -07:00
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"],
2021-06-22 06:58:34 -07:00
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",
2022-06-20 11:41:19 -07:00
CellLabel->"In[2]:=",ExpressionUUID->"484c421f-d2da-424b-8fa0-2015585eec55"],
2021-06-22 06:58:34 -07:00
Cell[BoxData[
RowBox[{
2022-06-20 11:41:19 -07:00
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"]
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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[{
2021-06-22 06:58:34 -07:00
RowBox[{
2022-06-20 11:41:19 -07:00
RowBox[{"G1", "=", "\[NoBreak]", GridBox[{
2021-06-22 06:58:34 -07:00
{"1",
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "1"}], "1",
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}]},
2021-06-22 06:58:34 -07:00
{
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
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]},
2022-06-20 11:41:19 -07:00
Offset[0.2]}}]}], ";"}], "\[IndentingNewLine]",
RowBox[{
RowBox[{"G2", "=", GridBox[{
2021-06-22 06:58:34 -07:00
{"1",
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}],
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}]},
{
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
RowBox[{"-", "1"}], "1",
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}],
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
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]},
2022-06-20 11:41:19 -07:00
Offset[0.2]}}]}], ";"}]}], "Input",
CellChangeTimes->{{3.8646891073122263`*^9, 3.864689126434671*^9}},
CellLabel->"In[4]:=",ExpressionUUID->"085ac427-f46c-4dc2-aee1-130a2c0782ce"],
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
Cell[BoxData[
2022-06-20 11:41:19 -07:00
RowBox[{"PlanarGraph", "[",
RowBox[{"AdjacencyGraph", "[",
RowBox[{
2021-06-22 06:58:34 -07:00
RowBox[{
2022-06-20 11:41:19 -07:00
RowBox[{
2021-06-22 06:58:34 -07:00
RowBox[{
RowBox[{
2022-06-20 11:41:19 -07:00
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"]
2021-06-22 06:58:34 -07:00
}, Open ]],
2022-06-20 11:41:19 -07:00
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"],
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{
2022-06-20 11:41:19 -07:00
RowBox[{"(",
RowBox[{"G3", "=",
RowBox[{"fullGlue", "[",
RowBox[{"G1", ",", "G2", ",", "4"}], "]"}]}], ")"}], "//",
2021-06-22 06:58:34 -07:00
"MatrixForm"}]], "Input",
2022-06-20 11:41:19 -07:00
CellChangeTimes->{{3.864689303254286*^9, 3.864689329123877*^9}},
CellLabel->"In[7]:=",ExpressionUUID->"ff61a8b9-b643-4373-bc78-6712e853ef14"],
2021-06-22 06:58:34 -07:00
Cell[BoxData[
TagBox[
RowBox[{"(", "\[NoBreak]", GridBox[{
{"1",
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}]},
2021-06-22 06:58:34 -07:00
{
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "1"}]},
2021-06-22 06:58:34 -07:00
{
RowBox[{"-", "1"}],
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}],
RowBox[{"-", "1"}]},
{
RowBox[{"-", "1"}],
RowBox[{"-", "1"}],
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
2021-06-22 06:58:34 -07:00
RowBox[{"-", "1"}], "1",
RowBox[{"-", "1"}]},
{
2022-06-20 11:41:19 -07:00
RowBox[{"-", "3"}],
RowBox[{"-", "1"}],
2021-06-22 06:58:34 -07:00
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",
2022-06-20 11:41:19 -07:00
CellChangeTimes->{{3.864689321262847*^9, 3.864689329391946*^9},
3.8646893600631847`*^9},
2021-06-22 06:58:34 -07:00
CellLabel->
2022-06-20 11:41:19 -07:00
"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 ]]
2021-06-22 06:58:34 -07:00
}, Open ]]
},
2022-06-20 11:41:19 -07:00
WindowSize->{665.25, 778.5},
WindowMargins->{{Automatic, 6}, {6, Automatic}},
FrontEndVersion->"13.0 for Linux x86 (64-bit) (February 4, 2022)",
2021-06-22 06:58:34 -07:00
StyleDefinitions->"Default.nb",
ExpressionUUID->"d69326ff-8541-4cab-b66d-cadeed97da21"
]
(* End of Notebook Content *)
(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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"],
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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"]
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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"],
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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"]
2021-06-22 06:58:34 -07:00
}, Open ]],
2022-06-20 11:41:19 -07:00
Cell[16890, 458, 289, 7, 35, "Text",ExpressionUUID->"45891619-6e9a-4992-b24d-dd2f63a07314"],
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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"]
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
2022-06-20 11:41:19 -07:00
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 ]]
2021-06-22 06:58:34 -07:00
}, Open ]]
}
]
*)