wball/Circle-Packings
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
Circle-Packings/polyhedra/polyhedra.nb

1156 lines
50 KiB
Mathematica
Raw Normal View History

cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[ 0, 0]
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
NotebookDataLength[ 50676, 1154]
NotebookOptionsPosition[ 47756, 1095]
NotebookOutlinePosition[ 48249, 1113]
CellTagsIndexPosition[ 48206, 1110]
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
WindowFrame->Normal*)
(* Beginning of Notebook Content *)
Notebook[{
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell["Decomposing Polyhedra", "Title",
CellChangeTimes->{{3.86473186791886*^9,
3.864731879492985*^9}},ExpressionUUID->"59eef3c6-5fc6-4e94-acf1-\
7879fee7b868"],
Cell["\<\
The idea behind this notebook is that computing the gram matrix of a very \
large polyhedron is very difficult, but computing the gram matrix of a \
smaller polyhedron is much easier. Furthermore, as established in the glue.nb \
notebook, we have a method of gluing polyhedra together that satisfy certain \
criteria. So this might help compute the gram matrices of large, complicated \
polyhedra.\
\>", "Text",
CellChangeTimes->{{3.864731888992158*^9, 3.864731977690237*^9}, {
3.8647320723735447`*^9,
3.864732092384449*^9}},ExpressionUUID->"dfb46021-67d3-436d-b196-\
f5ffa766b2ee"],
Cell[CellGroupData[{
Cell["Dependencies", "Section",
CellChangeTimes->{{3.864732115520347*^9,
3.864732116869686*^9}},ExpressionUUID->"252027b5-44d8-4203-8ed4-\
bb03e516299e"],
Cell["\<\
This notebook uses IGraphM for computing the duals of polyhedra, finding \
cycles in a graph, and checking whether graphs are planar and/or 3-connected.\
\
\>", "Text",
CellChangeTimes->{{3.864732124522669*^9, 3.864732160854656*^9}, {
3.864732330944846*^9, 3.8647323346429873`*^9}, {3.86473237983333*^9,
3.86473239902454*^9}},ExpressionUUID->"66badcb1-5f6a-4f6f-874b-\
82012848ed8d"],
Cell[CellGroupData[{
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell[BoxData[
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
RowBox[{
RowBox[{
"Get", "[",
"\"\<https://raw.githubusercontent.com/szhorvat/IGraphM/master/IGInstaller.\
m\>\"", "]"}], ";"}]], "Input",
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
CellChangeTimes->{{3.832151022612398*^9, 3.832151030465872*^9}, {
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
3.8321511379667025`*^9, 3.8321511785398226`*^9}, 3.832151627377406*^9,
3.864732139147682*^9},
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
CellLabel->"In[1]:=",ExpressionUUID->"db347c93-28af-46ae-97e4-0f025565b28b"],
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[CellGroupData[{
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell[BoxData[
InterpretationBox[
RowBox[{"\<\"The currently installed versions of IGraph/M are: \"\>",
"\[InvisibleSpace]",
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
RowBox[{"{", "}"}]}],
SequenceForm["The currently installed versions of IGraph/M are: ", {}],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Editable->False]], "Print",
updates
2021-06-22 06:58:34 -07:00
CellChangeTimes->{3.832337217807197*^9, 3.832358883859474*^9,
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
3.832368244249806*^9, 3.832669858541595*^9, 3.864732709567399*^9},
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
CellLabel->
"During evaluation of \
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
In[1]:=",ExpressionUUID->"ddd01112-487b-41d2-9f0b-885cee6b6470"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell[BoxData[
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
InterpretationBox[
RowBox[{"\<\"Installing IGraph/M is complete: \"\>", "\[InvisibleSpace]",
InterpretationBox[
RowBox[{
TagBox["PacletObject",
"SummaryHead"], "[",
DynamicModuleBox[{Typeset`open$$ = False, Typeset`embedState$$ =
"Ready"},
TemplateBox[{
PaneSelectorBox[{False -> GridBox[{{
PaneBox[
ButtonBox[
DynamicBox[
FEPrivate`FrontEndResource["FEBitmaps", "SummaryBoxOpener"]],
ButtonFunction :> (Typeset`open$$ = True), Appearance ->
None, BaseStyle -> {}, Evaluator -> Automatic, Method ->
"Preemptive"], Alignment -> {Center, Center}, ImageSize ->
Dynamic[{
Automatic,
3.5 (CurrentValue["FontCapHeight"]/AbsoluteCurrentValue[
Magnification])}]],
GraphicsBox[
TagBox[
RasterBox[CompressedData["
1:eJzFmAdQG1cax5m7ubnMzZXM+O4myTnJ2U4mmUm55HJOgn2xg00cF+KCu42x
g2OwMW6iRQZswKaEGmODwPReDKJJdCEQRTQZjEAIiSoJ1ECoSyut9rulnCtu
TLj7j7Qjrd5732//33v7vtUqpwv2zr+ysrJyfwU/2H/vbUMgfE/c+yr+Zf95
9zMu50/9sO28xymXU4QvnX6Nn/x44T37Gf4roVDIYDAoc6Ius+aj1NfX83g8
eFQ1NTUBAQHu7u7+/v6BgYEBy6zAOXl5efn4+BQUFOh0uvsYBAIhLi6OxWKN
jY0JBIKxl9H4nF62Cx6FzWZnZmZ6eHjgR7PZPDIycvny5YSEBKVSCf9zoSia
n5+P56Kjo6OsrMzb23toaGjJo5nMJq1Ws+TuuANhYWGJiYnJyckxMTF6vX5p
48hEoxvWr1u1ek33vbtLhsFtmYchkUgGg2EpQ6g5t4NcrebkRNhlBMGSSSIj
I3FPYmNj78/el1D3bVHR+cCK6o32pzau3ZX2U24FJ4hjLlgCSW5ublRU1BJI
MJ0Cai8jKVtjy0vcGvpvcmGwCKsKu5eXcCd75HjDVKTe9HKTf2kkFkGnJf8E
JP+bUpFxsnbMkTYtxs9qoTZEVuo/SC7OypEdLBnzFGl7l5UE7Ug1peyElPX3
KJFOTSq7Wl3NhHn+pwkWUu2rrA2WlrfE5U0dzBl06ZYXLgcJphSZK3yR+G8h
3Xaq5rpLi2prHRbLtiwQmhH8yC431/oaGZEK2nBMvsQxnXOiThilQsS/IImF
RzPlHTeSbCBzD/RnBnJgdz0QWy1GTHtvtOabLVs++vif7GYymNQNySjFH1iZ
MICUFQrPpHIcSoY9R1WtvwAJajK33ESStpvjbYF8CZT8IhnsomkO1Qtyh7LH
4JpnyhYrq99YWf3Wf//70EtQF0d0XSul+wmFzaAABVUSks5zzB506pCko5h5
ySQWORctvgjxdpB2HGtIACOPphPY0bttaZ2Xe25Rx77Lk52h9/q5btmxc63N
SNIpjLwXstbrIr4dcz8x4B0KnUwTKmTM5GdIfJNHz1QIr08ZhpdC0kOBFEdI
tlcXHeF2XO3QZZWIQ3bSc9fV1Tq0pNOEnt2yRL6+C5OOQzgJIkggHrOMNVla
b5jL3cREO5Gz9cTFzVB0CZi3eR1+FQNnMwTnMsS+PdqmlyExYrURijTb0ZLN
bU12JcMXMiVe5cIjrp1Zm2isg409/TM9APKFtmKl6kqo+kooKlP910oNwm3k
+scMXTyrDLGD7E2Q4oDkHB4s/4bevLWg92C9PPW5JCq1Ojz0VnH0Hk7DB7VN
nxb2bEoe/SFP4MmW+8VzqHvr5PtqZB2PLgV0UqLwC1X4haCTj/wwxoHKK6K2
a43SXBI0XYRMB4jbOk16byT9LW7lO7dTDwRHxqlV6idJ5vcdfHfGd5AVr63I
o79XL9pHmYzumi42wSjewa0Ndpepk/of3yifRjKXXiSfaGaQcJcAdFysIx3K
fJDCdfzoP73+6mw96e5OmG+Zl5f3GEl4RCTe4J2VnxZklatgBAUUZndbjUNE
7q7K6cCeJzP8LBJcgiwVlTgRfKlgXD53CagZlH1J5JK/vvsZHigiIvJJkvvz
xDWo5NCeljQfQOemOV4trFtvjff68tC+NqQFBemLk8gxqOaDzdcnZ7uv/2q+
8OhBYUcxfODG9Llcer/lojOWaoTjfppAp2FGtMxiBAOi/cens8X3dw5r6PrT
5eNejIlbg8p6JTKxMIpEq7oapvMLAdnk/AmhFq0SGMK71a4tqmNsbLW9E979
o08+M+u1Ggxcm2c+jx4/ekVjeMjhRUn6EfRY7ZTnxfE7XhPcwtnlUJPa67Y9
rKops0kbnD14KoVzIJ17lDzs0TBxo1/TYBBz4Keb5qgksURbLjSFsNTODMWO
CvmWctn+arl3P6TTG6MdP+SRr85mfxDZVizbHiKqDBJbBMizSTALRuRpjmRK
MrwmWq9LBF06aTvc/QkUd8GEGgSark5ZVsV4QC7PBUfKkp6k9BFdv96wxXrz
DyUDe5jIFor0YM2UF3MmmaNlihEtflsdKwPyNuiPLBZgB5rVdnnSuKsTIykK
FHuOJ7iy+Do7piIoQdoWKGm8IW8hyauDJkeaHzQwY0aB9m6XNI8FSQFJu62s
/oz7v97VJ1QGKQPadglifCgMxi6GhC+Gq6KPtsABpjLwtrTLV8yreaTufRpJ
r9x0mDF9ljVTHS9vDZblnxFV+E2Ody6yHWA68WjGnu1r//7hqo9IP3Ya1E82
wedopiltezCtE3fMs36GFSNnXJPIhpGHmzyNxGwB79YZe6aCOqDjJ0ynHBpL
3jcy0btIyY1VBELebqhxa48XtwYDO3tmERJOJjk/4mTVkBtb29OsbfeXMBLk
2MO5eea+k87V2pbKEsUGLd+YeWj0Z2vePfLjUdDuPCThGyTZDpB+jQIqAyYp
PpP8xscfN1i8Pu+iCldqD0MJ01QNmTDBqX7cu2eQsGTI/popN+YMHr7pmjT6
C17ReZFRa3nghqQPSd2NJNiieC0yJx5dQ/WZrAyUTI89cF6oB4/awYtkWvHd
NlAZm24oKv0lMp7xxUkQFPNondlZJWeqTfIqDWnrcPYJAStXgS+tWQyjzlTo
gpBszNQfH+7VnjpdTpxgxMhNhlnz8bbETsOxytEbxQUYJ0rF1pX5TDWRplDT
I6l5NgkufBnaUmQJfJ2MrikliArPi6qDxDy6aTYEI8JI2mTKPoqpH7mv6hQo
LUyKw/STZ2v7/FH9jir92QbRRP5paCd2UdAST2kfVQVP6NkkHVJkf+3UhS5l
Q7aiI1pGj5HRwuXtJEDaG6DWHpK2wnDDk2NO9iKUAMXgz1gLE1z5sIsBZXXl
cGeDriyEHqevCJBLBh5PzXNJdGbsEnPmEGM6PV7WeV0q6jGImzDi/tvrVq/M
d7cGbuqTA85rgm4JOpy2+u11X15OjFQAcAsh9ytZamhlsI4RpzAbH0/Nc0lw
xQ9odtZNR0RLmnzEyrkn+JVvrMRvYmveeT9i0JQjRO9NmR7kHNVbJrqhPwMa
r7+7ejXe7LU33pyeJauDjA2imyGlfhp2uXZR+OeStEqRffRp75BJitekpBN3
FYv6OXzVm3/bRCTtYoFtHRymG33bVSUj8sEBhpnqAVnbIOFzKN0ee8Fm5Zur
YqLnNn1emTlh43BISFmAWsRevKh+LonGjF3onDnlL0w9J5B1LFwODoQ/h5fw
laEN/Z40/umq/tN36L4F5PjSvCpKYh8l3HA3B2AcwLQwCr9IG76RQwyqv6Uz
PuUB4kWeMmIGNcf8ZDfO6qXsue/4ypwegJ50qCZAgYM816U1NyCtiupfx3ak
CvbSkONt4M2GzHHg6mHh+seLIMiGSwjuKkYX53gxkma15eiVydP7GmW1rTAQ
byo5Z06zx+JsIWk35H0P1d7ATgM1n6eDEgEEdxucG/X7a83fVeqP1s14tiiT
RdDb19LpbN1PuC7hPg3khUiUJpP1twde+cNfrhxYbU5bIYt/W5T1GY+yrZN5
nD5IrJYl0NS5jbLYdmnUgCKqTRyWNxQZwU6/1Fl5uKXzGzr7667xtWd/XPG7
3++12Y4YkEVD3CdJSkqKi4t72n9KerX6vTWv4wvB+l9/HKd/SGvaXNh/JF1w
LnmSkDrumsF3yuA6ZAw6ZnAd07iO2bzjpaNHq8YPFo8cu809d6U36Az/zlvr
PsG7v/HuGo1m0a16VvN1LE5yv6JeVBQK1dnZhdlVIoH+PpQzYGANqZkjqhb8
NbzYa0jVOqpukejqZ/RVSmijsWpcnF0oFMpTcwNQUFAQHh5eVFTk5+cnEome
0XJZhSDIzZs3cTf6+vo8PT1zcnL+XyRVVVUEAqG+vh7DMDxNHh4e+HF4eFg3
J+3yC5+ZeCKoVCqRSMQ9wc/gVHho3BMvL6+rV6/iLuETOHaZFTenoKAg3AES
iSSXyx92qaenh0wm4xM4efmFR0lMTMSz0NbWZjIt3I3/A4ILMJU=
"], {{0, 46.}, {46., 0}}, {0, 255}, ColorFunction ->
RGBColor, ImageResolution -> {72, 72}],
BoxForm`ImageTag[
"Byte", ColorSpace -> "RGB", Interleaving -> True,
MetaInformation -> <|
"XMP" -> <|
"XMPBasicSchema" -> <|
"CreatorTool" -> "Adobe Photoshop CC 2017 (Macintosh)",
"CreateDate" -> "2017-12-01T16:38:15+01:00", "ModifyDate" ->
"2017-12-04T22:09:04+01:00", "MetadataDate" ->
"2017-12-04T22:09:04+01:00"|>,
"DublinCoreSchema" -> <|"Format" -> "image/png"|>,
"PhotoshopSchema" -> <|"ColorMode" -> 3|>,
"XMPMediaManagementSchema" -> <|
"InstanceID" ->
"xmp.iid:a23149e2-a0d1-4081-bab4-71ed4683843a",
"DocumentID" ->
"xmp.did:a23149e2-a0d1-4081-bab4-71ed4683843a",
"OriginalDocumentID" ->
"xmp.did:a23149e2-a0d1-4081-bab4-71ed4683843a",
"History[1]" -> <|
"Event" -> <|
"Action" -> "created", "InstanceID" ->
"xmp.iid:a23149e2-a0d1-4081-bab4-71ed4683843a", "When" ->
"2017-12-01T16:38:15+01:00", "SoftwareAgent" ->
"Adobe Photoshop CC 2017 (Macintosh)"|>|>|>|>|>],
Selectable -> False], DefaultBaseStyle -> "ImageGraphics",
ImageSizeRaw -> {46., 46.}, PlotRange -> {{0, 46.}, {0, 46.}}],
GridBox[{{
RowBox[{
TagBox["\"Name: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox["\"IGraphM\"", "SummaryItem"]}]}, {
RowBox[{
TagBox["\"Version: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox["\"0.5.1\"", "SummaryItem"]}]}},
GridBoxAlignment -> {
"Columns" -> {{Left}}, "Rows" -> {{Automatic}}}, AutoDelete ->
False, GridBoxItemSize -> {
"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}},
GridBoxSpacings -> {
"Columns" -> {{2}}, "Rows" -> {{Automatic}}},
BaseStyle -> {
ShowStringCharacters -> False, NumberMarks -> False,
PrintPrecision -> 3, ShowSyntaxStyles -> False}]}},
GridBoxAlignment -> {"Columns" -> {{Left}}, "Rows" -> {{Top}}},
AutoDelete -> False,
GridBoxItemSize -> {
"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}},
BaselinePosition -> {1, 1}], True -> GridBox[{{
PaneBox[
ButtonBox[
DynamicBox[
FEPrivate`FrontEndResource["FEBitmaps", "SummaryBoxCloser"]],
ButtonFunction :> (Typeset`open$$ = False), Appearance ->
None, BaseStyle -> {}, Evaluator -> Automatic, Method ->
"Preemptive"], Alignment -> {Center, Center}, ImageSize ->
Dynamic[{
Automatic,
3.5 (CurrentValue["FontCapHeight"]/AbsoluteCurrentValue[
Magnification])}]],
GraphicsBox[
TagBox[
RasterBox[CompressedData["
1:eJzFmAdQG1cax5m7ubnMzZXM+O4myTnJ2U4mmUm55HJOgn2xg00cF+KCu42x
g2OwMW6iRQZswKaEGmODwPReDKJJdCEQRTQZjEAIiSoJ1ECoSyut9rulnCtu
TLj7j7Qjrd5732//33v7vtUqpwv2zr+ysrJyfwU/2H/vbUMgfE/c+yr+Zf95
9zMu50/9sO28xymXU4QvnX6Nn/x44T37Gf4roVDIYDAoc6Ius+aj1NfX83g8
eFQ1NTUBAQHu7u7+/v6BgYEBy6zAOXl5efn4+BQUFOh0uvsYBAIhLi6OxWKN
jY0JBIKxl9H4nF62Cx6FzWZnZmZ6eHjgR7PZPDIycvny5YSEBKVSCf9zoSia
n5+P56Kjo6OsrMzb23toaGjJo5nMJq1Ws+TuuANhYWGJiYnJyckxMTF6vX5p
48hEoxvWr1u1ek33vbtLhsFtmYchkUgGg2EpQ6g5t4NcrebkRNhlBMGSSSIj
I3FPYmNj78/el1D3bVHR+cCK6o32pzau3ZX2U24FJ4hjLlgCSW5ublRU1BJI
MJ0Cai8jKVtjy0vcGvpvcmGwCKsKu5eXcCd75HjDVKTe9HKTf2kkFkGnJf8E
JP+bUpFxsnbMkTYtxs9qoTZEVuo/SC7OypEdLBnzFGl7l5UE7Ug1peyElPX3
KJFOTSq7Wl3NhHn+pwkWUu2rrA2WlrfE5U0dzBl06ZYXLgcJphSZK3yR+G8h
3Xaq5rpLi2prHRbLtiwQmhH8yC431/oaGZEK2nBMvsQxnXOiThilQsS/IImF
RzPlHTeSbCBzD/RnBnJgdz0QWy1GTHtvtOabLVs++vif7GYymNQNySjFH1iZ
MICUFQrPpHIcSoY9R1WtvwAJajK33ESStpvjbYF8CZT8IhnsomkO1Qtyh7LH
4JpnyhYrq99YWf3Wf//70EtQF0d0XSul+wmFzaAABVUSks5zzB506pCko5h5
ySQWORctvgjxdpB2HGtIACOPphPY0bttaZ2Xe25Rx77Lk52h9/q5btmxc63N
SNIpjLwXstbrIr4dcz8x4B0KnUwTKmTM5GdIfJNHz1QIr08ZhpdC0kOBFEdI
tlcXHeF2XO3QZZWIQ3bSc9fV1Tq0pNOEnt2yRL6+C5OOQzgJIkggHrOMNVla
b5jL3cREO5Gz9cTFzVB0CZi3eR1+FQNnMwTnMsS+PdqmlyExYrURijTb0ZLN
bU12JcMXMiVe5cIjrp1Zm2isg409/TM9APKFtmKl6kqo+kooKlP910oNwm3k
+scMXTyrDLGD7E2Q4oDkHB4s/4bevLWg92C9PPW5JCq1Ojz0VnH0Hk7DB7VN
nxb2bEoe/SFP4MmW+8VzqHvr5PtqZB2PLgV0UqLwC1X4haCTj/wwxoHKK6K2
a43SXBI0XYRMB4jbOk16byT9LW7lO7dTDwRHxqlV6idJ5vcdfHfGd5AVr63I
o79XL9pHmYzumi42wSjewa0Ndpepk/of3yifRjKXXiSfaGaQcJcAdFysIx3K
fJDCdfzoP73+6mw96e5OmG+Zl5f3GEl4RCTe4J2VnxZklatgBAUUZndbjUNE
7q7K6cCeJzP8LBJcgiwVlTgRfKlgXD53CagZlH1J5JK/vvsZHigiIvJJkvvz
xDWo5NCeljQfQOemOV4trFtvjff68tC+NqQFBemLk8gxqOaDzdcnZ7uv/2q+
8OhBYUcxfODG9Llcer/lojOWaoTjfppAp2FGtMxiBAOi/cens8X3dw5r6PrT
5eNejIlbg8p6JTKxMIpEq7oapvMLAdnk/AmhFq0SGMK71a4tqmNsbLW9E979
o08+M+u1Ggxcm2c+jx4/ekVjeMjhRUn6EfRY7ZTnxfE7XhPcwtnlUJPa67Y9
rKops0kbnD14KoVzIJ17lDzs0TBxo1/TYBBz4Keb5qgksURbLjSFsNTODMWO
CvmWctn+arl3P6TTG6MdP+SRr85mfxDZVizbHiKqDBJbBMizSTALRuRpjmRK
MrwmWq9LBF06aTvc/QkUd8GEGgSark5ZVsV4QC7PBUfKkp6k9BFdv96wxXrz
DyUDe5jIFor0YM2UF3MmmaNlihEtflsdKwPyNuiPLBZgB5rVdnnSuKsTIykK
FHuOJ7iy+Do7piIoQdoWKGm8IW8hyauDJkeaHzQwY0aB9m6XNI8FSQFJu62s
/oz7v97VJ1QGKQPadglifCgMxi6GhC+Gq6KPtsABpjLwtrTLV8yreaTufRpJ
r9x0mDF9ljVTHS9vDZblnxFV+E2Ody6yHWA68WjGnu1r//7hqo9IP3Ya1E82
wedopiltezCtE3fMs36GFSNnXJPIhpGHmzyNxGwB79YZe6aCOqDjJ0ynHBpL
3jcy0btIyY1VBELebqhxa48XtwYDO3tmERJOJjk/4mTVkBtb29OsbfeXMBLk
2MO5eea+k87V2pbKEsUGLd+YeWj0Z2vePfLjUdDuPCThGyTZDpB+jQIqAyYp
PpP8xscfN1i8Pu+iCldqD0MJ01QNmTDBqX7cu2eQsGTI/popN+YMHr7pmjT6
C17ReZFRa3nghqQPSd2NJNiieC0yJx5dQ/WZrAyUTI89cF6oB4/awYtkWvHd
NlAZm24oKv0lMp7xxUkQFPNondlZJWeqTfIqDWnrcPYJAStXgS+tWQyjzlTo
gpBszNQfH+7VnjpdTpxgxMhNhlnz8bbETsOxytEbxQUYJ0rF1pX5TDWRplDT
I6l5NgkufBnaUmQJfJ2MrikliArPi6qDxDy6aTYEI8JI2mTKPoqpH7mv6hQo
LUyKw/STZ2v7/FH9jir92QbRRP5paCd2UdAST2kfVQVP6NkkHVJkf+3UhS5l
Q7aiI1pGj5HRwuXtJEDaG6DWHpK2wnDDk2NO9iKUAMXgz1gLE1z5sIsBZXXl
cGeDriyEHqevCJBLBh5PzXNJdGbsEnPmEGM6PV7WeV0q6jGImzDi/tvrVq/M
d7cGbuqTA85rgm4JOpy2+u11X15OjFQAcAsh9ytZamhlsI4RpzAbH0/Nc0lw
xQ9odtZNR0RLmnzEyrkn+JVvrMRvYmveeT9i0JQjRO9NmR7kHNVbJrqhPwMa
r7+7ejXe7LU33pyeJauDjA2imyGlfhp2uXZR+OeStEqRffRp75BJitekpBN3
FYv6OXzVm3/bRCTtYoFtHRymG33bVSUj8sEBhpnqAVnbIOFzKN0ee8Fm5Zur
YqLnNn1emTlh43BISFmAWsRevKh+LonGjF3onDnlL0w9J5B1LFwODoQ/h5fw
laEN/Z40/umq/tN36L4F5PjSvCpKYh8l3HA3B2AcwLQwCr9IG76RQwyqv6Uz
PuUB4kWeMmIGNcf8ZDfO6qXsue/4ypwegJ50qCZAgYM816U1NyCtiupfx3ak
CvbSkONt4M2GzHHg6mHh+seLIMiGSwjuKkYX53gxkma15eiVydP7GmW1rTAQ
byo5Z06zx+JsIWk35H0P1d7ATgM1n6eDEgEEdxucG/X7a83fVeqP1s14tiiT
RdDb19LpbN1PuC7hPg3khUiUJpP1twde+cNfrhxYbU5bIYt/W5T1GY+yrZN5
nD5IrJYl0NS5jbLYdmnUgCKqTRyWNxQZwU6/1Fl5uKXzGzr7667xtWd/XPG7
3++12Y4YkEVD3CdJSkqKi4t72n9KerX6vTWv4wvB+l9/HKd/SGvaXNh/JF1w
LnmSkDrumsF3yuA6ZAw6ZnAd07iO2bzjpaNHq8YPFo8cu809d6U36Az/zlvr
PsG7v/HuGo1m0a16VvN1LE5yv6JeVBQK1dnZhdlVIoH+PpQzYGANqZkjqhb8
NbzYa0jVOqpukejqZ/RVSmijsWpcnF0oFMpTcwNQUFAQHh5eVFTk5+cnEome
0XJZhSDIzZs3cTf6+vo8PT1zcnL+XyRVVVUEAqG+vh7DMDxNHh4e+HF4eFg3
J+3yC5+ZeCKoVCqRSMQ9wc/gVHho3BMvL6+rV6/iLuETOHaZFTenoKAg3AES
iSSXyx92qaenh0wm4xM4efmFR0lMTMSz0NbWZjIt3I3/A4ILMJU=
"], {{0, 46.}, {46., 0}}, {0, 255}, ColorFunction ->
RGBColor, ImageResolution -> {72, 72}],
BoxForm`ImageTag[
"Byte", ColorSpace -> "RGB", Interleaving -> True,
MetaInformation -> <|
"XMP" -> <|
"XMPBasicSchema" -> <|
"CreatorTool" -> "Adobe Photoshop CC 2017 (Macintosh)",
"CreateDate" -> "2017-12-01T16:38:15+01:00", "ModifyDate" ->
"2017-12-04T22:09:04+01:00", "MetadataDate" ->
"2017-12-04T22:09:04+01:00"|>,
"DublinCoreSchema" -> <|"Format" -> "image/png"|>,
"PhotoshopSchema" -> <|"ColorMode" -> 3|>,
"XMPMediaManagementSchema" -> <|
"InstanceID" ->
"xmp.iid:a23149e2-a0d1-4081-bab4-71ed4683843a",
"DocumentID" ->
"xmp.did:a23149e2-a0d1-4081-bab4-71ed4683843a",
"OriginalDocumentID" ->
"xmp.did:a23149e2-a0d1-4081-bab4-71ed4683843a",
"History[1]" -> <|
"Event" -> <|
"Action" -> "created", "InstanceID" ->
"xmp.iid:a23149e2-a0d1-4081-bab4-71ed4683843a", "When" ->
"2017-12-01T16:38:15+01:00", "SoftwareAgent" ->
"Adobe Photoshop CC 2017 (Macintosh)"|>|>|>|>|>],
Selectable -> False], DefaultBaseStyle -> "ImageGraphics",
ImageSizeRaw -> {46., 46.}, PlotRange -> {{0, 46.}, {0, 46.}}],
GridBox[{{
RowBox[{
TagBox["\"Name: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox["\"IGraphM\"", "SummaryItem"]}]}, {
RowBox[{
TagBox["\"Version: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox["\"0.5.1\"", "SummaryItem"]}]}, {
RowBox[{
TagBox["\"Location: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox[
"\"/home/wball/.Mathematica/Paclets/Repository/IGraphM-0.5.\
1\"", "SummaryItem"]}]}, {
RowBox[{
TagBox["\"Description: \"", "SummaryItemAnnotation"],
"\[InvisibleSpace]",
TagBox[
TagBox[
"\"IGraph/M \[Dash] the igraph interface for Mathematica.\
\"", Short], "SummaryItem"]}]}},
GridBoxAlignment -> {
"Columns" -> {{Left}}, "Rows" -> {{Automatic}}}, AutoDelete ->
False, GridBoxItemSize -> {
"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}},
GridBoxSpacings -> {
"Columns" -> {{2}}, "Rows" -> {{Automatic}}},
BaseStyle -> {
ShowStringCharacters -> False, NumberMarks -> False,
PrintPrecision -> 3, ShowSyntaxStyles -> False}]}},
GridBoxAlignment -> {"Columns" -> {{Left}}, "Rows" -> {{Top}}},
AutoDelete -> False,
GridBoxItemSize -> {
"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}},
BaselinePosition -> {1, 1}]},
Dynamic[Typeset`open$$], ImageSize -> Automatic]},
"SummaryPanel"],
DynamicModuleValues:>{}], "]"}],
PacletObject[<|
"Name" -> "IGraphM", "Version" -> "0.5.1", "MathematicaVersion" ->
"10.0+", "Description" ->
"IGraph/M \[Dash] the igraph interface for Mathematica.", "Creator" ->
"Szabolcs Horv\[AAcute]t <szhorvat@gmail.com>", "URL" ->
"http://szhorvat.net/mathematica/IGraphM", "Thumbnail" -> "Logo.png",
"Icon" -> "Logo.png",
"Keywords" -> {"igraph", "graph theory", "network analysis"},
"SystemID" -> {
"MacOSX-x86-64", "Windows-x86-64", "Linux-x86-64", "Linux-ARM"},
"Extensions" -> {{"Kernel", "Root" -> ".", "Context" -> "IGraphM`"}, {
"LibraryLink"}, {
"Documentation", "MainPage" -> "Tutorials/IGDocumentation"}},
"Location" ->
"/home/wball/.Mathematica/Paclets/Repository/IGraphM-0.5.1"|>],
Editable->False,
SelectWithContents->True,
Selectable->False], "\[InvisibleSpace]", "\<\".\"\>"}],
SequenceForm["Installing IGraph/M is complete: ",
PacletObject[<|
"Name" -> "IGraphM", "Version" -> "0.5.1", "MathematicaVersion" ->
"10.0+", "Description" ->
"IGraph/M \[Dash] the igraph interface for Mathematica.", "Creator" ->
"Szabolcs Horv\[AAcute]t <szhorvat@gmail.com>", "URL" ->
"http://szhorvat.net/mathematica/IGraphM", "Thumbnail" -> "Logo.png",
"Icon" -> "Logo.png",
"Keywords" -> {"igraph", "graph theory", "network analysis"},
"SystemID" -> {
"MacOSX-x86-64", "Windows-x86-64", "Linux-x86-64", "Linux-ARM"},
"Extensions" -> {{"Kernel", "Root" -> ".", "Context" -> "IGraphM`"}, {
"LibraryLink"}, {
"Documentation", "MainPage" -> "Tutorials/IGDocumentation"}},
"Location" ->
"/home/wball/.Mathematica/Paclets/Repository/IGraphM-0.5.1"|>], "."],
Editable->False]], "Print",
CellChangeTimes->{3.832337217807197*^9, 3.832358883859474*^9,
3.832368244249806*^9, 3.832669858541595*^9, 3.864732718075603*^9},
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
CellLabel->
"During evaluation of \
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
In[1]:=",ExpressionUUID->"f3c1e407-fe5a-42d8-96d5-bd1c9cd5099c"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell[BoxData[
InterpretationBox[
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
RowBox[{"\<\"It can now be loaded using the command \"\>",
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
"\[InvisibleSpace]",
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
ButtonBox[
RowBox[{"<<", "\<\"IGraphM`\"\>"}],
Appearance->None,
BaseStyle->"Link",
ButtonFunction:>(FrontEndExecute[{
FrontEnd`SelectionMove[
FrontEnd`EvaluationCell[], After, CellGroup],
FrontEnd`NotebookWrite[
FrontEnd`EvaluationNotebook[], #, All],
FrontEnd`SelectionEvaluateCreateCell[
FrontEnd`EvaluationNotebook[]]}]& ),
Evaluator->None,
Method->"Preemptive"]}],
SequenceForm["It can now be loaded using the command ",
Button[
Defer[
Get["IGraphM`"]], FrontEndExecute[{
FrontEnd`SelectionMove[
FrontEnd`EvaluationCell[], After, CellGroup],
FrontEnd`NotebookWrite[
FrontEnd`EvaluationNotebook[], #, All],
FrontEnd`SelectionEvaluateCreateCell[
FrontEnd`EvaluationNotebook[]]}]& , Evaluator -> None, Appearance ->
None, BaseStyle -> "Link"]],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Editable->False]], "Print",
updates
2021-06-22 06:58:34 -07:00
CellChangeTimes->{3.832337217807197*^9, 3.832358883859474*^9,
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
3.832368244249806*^9, 3.832669858541595*^9, 3.864732718158339*^9},
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
CellLabel->
"During evaluation of \
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
In[1]:=",ExpressionUUID->"871ff450-762e-4ceb-b980-847aca12b375"]
}, Open ]]
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
}, Open ]],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"<<", "IGraphM`"}]], "Input",
CellChangeTimes->{{3.8321516420783434`*^9, 3.832151645302351*^9}},
CellLabel->"In[2]:=",ExpressionUUID->"8cc401a5-7736-45db-b864-33aa0faea5b6"],
Cell[BoxData[
TagBox[GridBox[{
{"\<\"IGraph/M 0.5.1 (October 12, 2020)\"\>"},
{"\<\"Evaluate \\!\\(\\*ButtonBox[\\\"IGDocumentation[]\\\",BaseStyle->\\\
\"Link\\\",ButtonData->\\\"paclet:IGraphM\\\"]\\) to get started.\"\>"}
},
DefaultBaseStyle->"Column",
GridBoxAlignment->{"Columns" -> {{Left}}},
GridBoxItemSize->{"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}],
"Column"]], "Output",
updates
2021-06-22 06:58:34 -07:00
CellChangeTimes->{3.832337477452114*^9, 3.832358888188767*^9,
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
3.832368249132185*^9, 3.832669863650465*^9, 3.864732719426708*^9},
CellLabel->"Out[2]=",ExpressionUUID->"a8376a7b-ede1-4b76-906c-5ba8a5545969"]
}, Open ]]
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
}, Open ]],
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[CellGroupData[{
Cell["Import Polyhedra", "Section",
CellChangeTimes->{{3.86473218472358*^9,
3.8647321903474703`*^9}},ExpressionUUID->"ebf114c1-39fc-40ae-b9dd-\
3068b7a4fc97"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell["\<\
Function to convert some representation of a graph to mathematica\
\[CloseCurlyQuote]s representation. You can give it the option \
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
`format->graph6` if in graph6 format.\
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
\>", "Text",
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellChangeTimes->{{3.832358495397357*^9, 3.8323585393912582`*^9},
3.864732404686041*^9},ExpressionUUID->"b79ac481-66e7-4669-b8f4-\
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
0cea700ed78c"],
Cell[BoxData[{
RowBox[{
RowBox[{"Clear", "[",
RowBox[{"format", ",", "edgeList", ",", "graph6"}], "]"}],
";"}], "\[IndentingNewLine]",
RowBox[{
RowBox[{
RowBox[{"Options", "[", "graphFromPlantri", "]"}], "=",
RowBox[{"{",
RowBox[{"format", "\[Rule]", "edgeList"}], "}"}]}],
";"}], "\[IndentingNewLine]",
RowBox[{
RowBox[{"graphFromPlantri", "[",
RowBox[{"data_", ",",
RowBox[{"OptionsPattern", "[", "]"}]}], "]"}], ":=",
RowBox[{"If", "[",
RowBox[{
RowBox[{"format", "===", "edgeList"}], ",",
RowBox[{"PlanarGraph", "[",
RowBox[{
RowBox[{"Graph", "[",
RowBox[{
RowBox[{"Partition", "[",
RowBox[{
RowBox[{"ToExpression", "[",
RowBox[{"StringCases", "[",
RowBox[{"data", ",",
RowBox[{"DigitCharacter", ".."}]}], "]"}], "]"}], ",", "2"}],
"]"}], "/.",
RowBox[{
RowBox[{"{",
RowBox[{"x_", ",", "y_"}], "}"}], "\[Rule]",
RowBox[{"(",
RowBox[{"x", "\[UndirectedEdge]", "y"}], ")"}]}]}], "]"}], ",",
RowBox[{"VertexLabels", "\[Rule]", "\"\<Name\>\""}]}], "]"}], ",",
"\[IndentingNewLine]",
RowBox[{"PlanarGraph", "[",
RowBox[{
RowBox[{"ImportString", "[",
RowBox[{"data", ",", "\"\<Graph6\>\""}], "]"}], ",",
RowBox[{"VertexLabels", "\[Rule]", "\"\<Name\>\""}]}], "]"}]}],
"]"}]}]}], "Input",
CellChangeTimes->{{3.832336494011004*^9, 3.832336534340336*^9}, {
3.8323517999289827`*^9, 3.832351947441263*^9}, {3.8323520237090063`*^9,
3.8323520406687717`*^9}, {3.8323532427822723`*^9, 3.832353249640938*^9}},
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellLabel->"In[3]:=",ExpressionUUID->"0491d7dc-7152-49be-9137-070980e44ae7"]
}, Open ]],
Cell[CellGroupData[{
Cell["Polyhedra Decomposition", "Section",
CellChangeTimes->{{3.8647322788211317`*^9,
3.86473228272716*^9}},ExpressionUUID->"2e5d31b9-09d1-455d-9b0f-\
6af51112842a"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell["\<\
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Heads up: I think these functions are quite a bit buggy, but it\
\[CloseCurlyQuote]s hard to tell for sure. It\[CloseCurlyQuote]s not super \
useful anyway, since we can\[CloseCurlyQuote]t verify that the faces are \
compatible just from the graph alone.\
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
\>", "Text",
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellChangeTimes->{{3.864734244978354*^9,
3.864734304257506*^9}},ExpressionUUID->"f4d61d60-fb66-403c-a5a7-\
fc30fbb1ff48"],
Cell[TextData[{
"Function to tell if a polyhedron is prime, i.e. cannot be decomposed. About \
",
Cell[BoxData[
FormBox[
TemplateBox[<|"boxes" -> FormBox[
RowBox[{
StyleBox["O", "TI"], "(",
SuperscriptBox["2",
StyleBox["n", "TI"]], ")"}], TraditionalForm], "errors" -> {},
"input" -> "O(2^n)", "state" -> "Boxes"|>,
"TeXAssistantTemplate"], TraditionalForm]],ExpressionUUID->
"6d317853-b9dc-4f40-a831-0339e5fd5a0d"],
" and not likely able to improve. There are about ",
Cell[BoxData[
FormBox[
TemplateBox[<|"boxes" -> FormBox[
RowBox[{
StyleBox["O", "TI"], "(",
SuperscriptBox["2",
StyleBox["n", "TI"]], ")"}], TraditionalForm], "errors" -> {},
"input" -> "O(2^n)", "state" -> "Boxes"|>,
"TeXAssistantTemplate"], TraditionalForm]],ExpressionUUID->
"42af4f74-334b-4f07-bd7d-d82a896ebb50"],
" possible cycles (it\[CloseCurlyQuote]s been rigorously proven to be P-hard \
to count the number of cycles), and I don\[CloseCurlyQuote]t see a way of \
getting around that. This algorithm basically works by checking if any cycle \
splits the polyhedron into two polyhedra (i.e. 3-connected planar graphs). If \
so, it is not prime."
}], "Text",
CellChangeTimes->{{3.83235854587254*^9, 3.832358618254396*^9}, {
3.8647322851060266`*^9, 3.864732374153657*^9}, {3.8647324102931347`*^9,
3.864732413182369*^9}},ExpressionUUID->"83ebdaf9-e7b9-4912-83aa-\
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
66018e3b4210"],
Cell[BoxData[
RowBox[{
RowBox[{"primePolyhedronQ", "[", "graph_", "]"}], ":=",
RowBox[{"Block", "[",
RowBox[{
RowBox[{"{",
RowBox[{
"cycles", ",", "valid", ",", "faceDecomposable", ",",
"vertexDecomposable", ",", "dualGraph"}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"graph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"faceDecomposable", "=",
RowBox[{"AnyTrue", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}], "&&",
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}]}]}], "]"}], "&"}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"If", "[",
RowBox[{"faceDecomposable", ",",
RowBox[{"Return", "[", "False", "]"}]}], "]"}], ";",
"\[IndentingNewLine]",
RowBox[{"dualGraph", "=",
RowBox[{"IGDualGraph", "[", "graph", "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"dualGraph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"Not", "[",
RowBox[{"AnyTrue", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}], "&&",
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}]}]}], "]"}], "&"}]}], "]"}], "]"}]}]}],
"\[IndentingNewLine]", "]"}]}]], "Input",
CellChangeTimes->{{3.8323514934530973`*^9, 3.832351646852213*^9}, {
3.8323516804671373`*^9, 3.83235168336065*^9}},
CellLabel->"In[6]:=",ExpressionUUID->"1445a032-9806-4ee7-8079-9849d6ac9896"],
Cell["\<\
Function to find the possible decompositions of a graph. Returns a list where \
the first element of the list is the number of possible face decompositions \
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
and the second is the number of possible vertex decompositions. This \
corresponds to face gluing (the kind of gluing we\[CloseCurlyQuote]ve been \
working with) and vertex gluing (like in Kontorovich\[CloseCurlyQuote]s \
students\[CloseCurlyQuote] paper). Should be easy to modify to actually \
return the decompositions. I wonder if we could extend this recursively to \
\[OpenCurlyDoubleQuote]prime factorize\[CloseCurlyDoubleQuote] polyhedra? \
Such a \[OpenCurlyDoubleQuote]factorization\[CloseCurlyDoubleQuote] clearly \
won\[CloseCurlyQuote]t be unique, however. Note that these decompositions \
might not actually work for the purposes of glue.nb, as the faces might not \
be \[OpenCurlyDoubleQuote]compatible,\[CloseCurlyDoubleQuote] e.g. a square \
face glued onto a rhombus.\
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
\>", "Text",
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellChangeTimes->{{3.832358623451818*^9, 3.832358720650798*^9}, {
3.8647324570755157`*^9, 3.864732470920993*^9}, {3.864732526429549*^9,
3.8647325948108*^9}},ExpressionUUID->"a601bc96-4656-4520-9aeb-158895d9368a"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell[BoxData[
RowBox[{
RowBox[{"decomposable", "[", "graph_", "]"}], ":=",
RowBox[{"Block", "[",
RowBox[{
RowBox[{"{",
RowBox[{
"cycles", ",", "valid", ",", "faceDecomposable", ",",
"vertexDecomposable", ",", "dualGraph"}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"graph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"faceDecomposable", "=",
RowBox[{"Length", "[",
RowBox[{"Select", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}],
updates
2021-06-22 06:58:34 -07:00
",", "3"}], "]"}], "||",
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}],
",", "3"}], "]"}]}]}], "]"}], "&"}]}], "]"}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"dualGraph", "=",
RowBox[{"IGDualGraph", "[", "graph", "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"dualGraph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"vertexDecomposable", "=",
RowBox[{"Length", "[",
RowBox[{"Select", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}],
updates
2021-06-22 06:58:34 -07:00
",", "3"}], "]"}], "||",
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}],
",", "3"}], "]"}]}]}], "]"}], "&"}]}], "]"}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"{",
RowBox[{"faceDecomposable", ",", "vertexDecomposable"}], "}"}]}]}],
"\[IndentingNewLine]", "]"}]}]], "Input",
CellChangeTimes->{{3.832340233432548*^9, 3.832340427782093*^9}, {
3.8323404633434258`*^9, 3.832340465470111*^9}, {3.832341064134386*^9,
3.832341105249135*^9}, {3.832341215107959*^9, 3.832341309459516*^9}, {
updates
2021-06-22 06:58:34 -07:00
3.83234151306717*^9, 3.8323415312540283`*^9}, {3.832669981679708*^9,
3.832669985443377*^9}},
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellLabel->"In[7]:=",ExpressionUUID->"58712807-a428-4b89-8b30-be4ce33480f8"],
Cell["\<\
Slight modification of the above function to actually return the possible \
decompositions.\
\>", "Text",
CellChangeTimes->{{3.864732653155387*^9,
3.8647326727432947`*^9}},ExpressionUUID->"ee82fb00-28d7-47ed-a673-\
df51089e1ee8"],
Cell[BoxData[
RowBox[{
RowBox[{"decompositions", "[", "graph_", "]"}], ":=",
RowBox[{"Block", "[",
RowBox[{
RowBox[{"{",
RowBox[{
"cycles", ",", "valid", ",", "faceDecomposable", ",",
"vertexDecomposable", ",", "dualGraph", ",", "faceDecompositions", ",",
"vertexDecompositions"}], "}"}], ",", "\[IndentingNewLine]",
RowBox[{
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"graph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"faceDecomposable", "=",
RowBox[{"Select", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}], "&&",
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}]}]}], "]"}], "&"}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"faceDecompositions", "=",
RowBox[{"Table", "[",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"graph", ",", "cycle"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{"{",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{"components", "[",
RowBox[{"[", "1", "]"}], "]"}], ",", "cycle"}], "]"}]}],
"]"}], ",",
RowBox[{"Subgraph", "[",
RowBox[{"graph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{"components", "[",
RowBox[{"[", "2", "]"}], "]"}], ",", "cycle"}], "]"}]}],
"]"}]}], "}"}]}], "]"}], ",",
RowBox[{"{",
RowBox[{"cycle", ",", "faceDecomposable"}], "}"}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"dualGraph", "=",
RowBox[{"IGDualGraph", "[", "graph", "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"cycles", "=",
RowBox[{
RowBox[{"FindCycle", "[",
RowBox[{"dualGraph", ",", "Infinity", ",", "All"}], "]"}], "/.",
RowBox[{
RowBox[{"(",
RowBox[{"x_", "\[UndirectedEdge]", "y_"}], ")"}], "\[Rule]",
"x"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"valid", "=",
RowBox[{"Select", "[",
RowBox[{"cycles", ",",
RowBox[{
RowBox[{"Not", "[",
RowBox[{"IGConnectedQ", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}], "]"}], "&"}]}],
"]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"vertexDecomposable", "=",
RowBox[{"Select", "[",
RowBox[{"valid", ",",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "#"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "1",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}], "&&",
RowBox[{"KVertexConnectedGraphQ", "[",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{
"components", "\[LeftDoubleBracket]", "2",
"\[RightDoubleBracket]"}], ",", "#"}], "]"}]}], "]"}], ",",
"3"}], "]"}]}]}], "]"}], "&"}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"vertexDecompositions", "=",
RowBox[{"Table", "[",
RowBox[{
RowBox[{"With", "[",
RowBox[{
RowBox[{"{",
RowBox[{"components", "=",
RowBox[{"ConnectedComponents", "[",
RowBox[{"VertexDelete", "[",
RowBox[{"dualGraph", ",", "cycle"}], "]"}], "]"}]}], "}"}], ",",
"\[IndentingNewLine]",
RowBox[{"{",
RowBox[{
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{"components", "[",
RowBox[{"[", "1", "]"}], "]"}], ",", "cycle"}], "]"}]}],
"]"}], ",",
RowBox[{"Subgraph", "[",
RowBox[{"dualGraph", ",",
RowBox[{"Join", "[",
RowBox[{
RowBox[{"components", "[",
RowBox[{"[", "2", "]"}], "]"}], ",", "cycle"}], "]"}]}],
"]"}]}], "}"}]}], "]"}], ",",
RowBox[{"{",
RowBox[{"cycle", ",", "vertexDecomposable"}], "}"}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"{",
RowBox[{"faceDecompositions", ",", "vertexDecompositions"}], "}"}]}]}],
"\[IndentingNewLine]", "]"}]}]], "Input",
CellChangeTimes->{{3.8647326153441*^9, 3.8647326444836693`*^9},
3.864732844047669*^9, {3.864733238055559*^9, 3.8647335152257757`*^9}, {
3.8647339366234503`*^9, 3.864733941013648*^9}},
CellLabel->"In[37]:=",ExpressionUUID->"db03a86c-7097-420e-ac0e-36c935d21813"],
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
Cell["\<\
Function to read data from a file and convert it into a list of graphs. The \
easiest way to use this is to download a massive list from plantri (in graph6 \
format if it is very large, to keep the file small), and give that filename \
here. I highly recommend you put a semicolon at the end of that line to \
suppress the output; it tends to be pretty massive.\
\>", "Text",
CellChangeTimes->{{3.832358728187701*^9, 3.832358787855624*^9}, {
3.832358819591075*^9,
3.8323588520926237`*^9}},ExpressionUUID->"ab257888-085b-4fde-8617-\
8abd299bbd66"],
Cell[BoxData[
RowBox[{
RowBox[{"readData", "[", "filename_", "]"}], ":=",
RowBox[{
RowBox[{
RowBox[{"graphFromPlantri", "[",
RowBox[{"#", ",",
RowBox[{"format", "\[Rule]", "graph6"}]}], "]"}], "&"}], "/@",
RowBox[{
RowBox[{"Flatten", "[",
RowBox[{"StringSplit", "[",
RowBox[{
RowBox[{"ReadList", "[",
RowBox[{
RowBox[{"FileNameJoin", "[",
RowBox[{"{",
RowBox[{
RowBox[{"NotebookDirectory", "[", "]"}], ",", "filename"}], "}"}],
"]"}], ",", "String"}], "]"}], ",", "\"\<: \>\""}], "]"}], "]"}],
"\[LeftDoubleBracket]",
RowBox[{"2", ";;",
RowBox[{"-", "1"}], ";;", "2"}], "\[RightDoubleBracket]"}]}]}]], "Input",\
CellChangeTimes->{{3.8323510610419703`*^9, 3.832351096305499*^9}, {
3.832351132436808*^9, 3.832351163544671*^9}, {3.8323520703052*^9,
3.832352099080572*^9}, 3.832353009185463*^9, {3.832353208418548*^9,
3.832353211320695*^9}, {3.8323532635110197`*^9, 3.832353268104516*^9},
3.832358834504381*^9},
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
CellLabel->"In[9]:=",ExpressionUUID->"c0281df0-ade3-4fd2-99f7-1a53b1d66fa0"]
}, Open ]]
}, Open ]]
updates
2021-06-22 06:58:34 -07:00
},
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
WindowSize->{1437., 787.5},
WindowMargins->{{1.5, Automatic}, {1.5, Automatic}},
updates
2021-06-22 06:58:34 -07:00
TaggingRules->{
"WelcomeScreenSettings" -> {"FEStarting" -> False}, "TryRealOnly" -> False},
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
FrontEndVersion->"13.0 for Linux x86 (64-bit) (February 4, 2022)",
updates
2021-06-22 06:58:34 -07:00
StyleDefinitions->"Default.nb",
ExpressionUUID->"d3395cd3-c66a-48cf-b7c9-b2503d6f719a"
]
(* End of Notebook Content *)
(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[422, 15, 163, 3, 98, "Title",ExpressionUUID->"59eef3c6-5fc6-4e94-acf1-7879fee7b868"],
Cell[588, 20, 598, 11, 58, "Text",ExpressionUUID->"dfb46021-67d3-436d-b196-f5ffa766b2ee"],
updates
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[1211, 35, 157, 3, 68, "Section",ExpressionUUID->"252027b5-44d8-4203-8ed4-bb03e516299e"],
Cell[1371, 40, 399, 8, 35, "Text",ExpressionUUID->"66badcb1-5f6a-4f6f-874b-82012848ed8d"],
updates
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[1795, 52, 407, 9, 29, "Input",ExpressionUUID->"db347c93-28af-46ae-97e4-0f025565b28b"],
updates
2021-06-22 06:58:34 -07:00
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[2227, 65, 497, 11, 23, "Print",ExpressionUUID->"ddd01112-487b-41d2-9f0b-885cee6b6470"],
Cell[2727, 78, 18224, 332, 74, "Print",ExpressionUUID->"f3c1e407-fe5a-42d8-96d5-bd1c9cd5099c"],
Cell[20954, 412, 1269, 33, 25, "Print",ExpressionUUID->"871ff450-762e-4ceb-b980-847aca12b375"]
}, Open ]]
updates
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[22272, 451, 198, 3, 29, "Input",ExpressionUUID->"8cc401a5-7736-45db-b864-33aa0faea5b6"],
Cell[22473, 456, 627, 12, 54, "Output",ExpressionUUID->"a8376a7b-ede1-4b76-906c-5ba8a5545969"]
}, Open ]]
updates
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[23149, 474, 162, 3, 68, "Section",ExpressionUUID->"ebf114c1-39fc-40ae-b9dd-3068b7a4fc97"],
Cell[23314, 479, 344, 7, 35, "Text",ExpressionUUID->"b79ac481-66e7-4669-b8f4-0cea700ed78c"],
Cell[23661, 488, 1734, 45, 113, "Input",ExpressionUUID->"0491d7dc-7152-49be-9137-070980e44ae7"]
updates
2021-06-22 06:58:34 -07:00
}, Open ]],
Cell[CellGroupData[{
cleaning up, documenting stuff
2022-06-20 11:41:19 -07:00
Cell[25432, 538, 169, 3, 68, "Section",ExpressionUUID->"2e5d31b9-09d1-455d-9b0f-6af51112842a"],
Cell[25604, 543, 404, 8, 35, "Text",ExpressionUUID->"f4d61d60-fb66-403c-a5a7-fc30fbb1ff48"],
Cell[26011, 553, 1473, 33, 82, "Text",ExpressionUUID->"83ebdaf9-e7b9-4912-83aa-66018e3b4210"],
Cell[27487, 588, 4790, 122, 257, "Input",ExpressionUUID->"1445a032-9806-4ee7-8079-9849d6ac9896"],
Cell[32280, 712, 1186, 17, 104, "Text",ExpressionUUID->"a601bc96-4656-4520-9aeb-158895d9368a"],
Cell[33469, 731, 5094, 126, 257, "Input",ExpressionUUID->"58712807-a428-4b89-8b30-be4ce33480f8"],
Cell[38566, 859, 243, 6, 35, "Text",ExpressionUUID->"ee82fb00-28d7-47ed-a673-df51089e1ee8"],
Cell[38812, 867, 7212, 182, 339, "Input",ExpressionUUID->"db03a86c-7097-420e-ac0e-36c935d21813"],
Cell[46027, 1051, 562, 10, 58, "Text",ExpressionUUID->"ab257888-085b-4fde-8617-8abd299bbd66"],
Cell[46592, 1063, 1136, 28, 29, "Input",ExpressionUUID->"c0281df0-ade3-4fd2-99f7-1a53b1d66fa0"]
}, Open ]]
}, Open ]]
cleaning up and added polyhedral stuff
2021-06-10 17:34:36 -07:00
}
]
*)
Reference in a new issue Copy permalink