(* 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[ 37091, 924] NotebookOptionsPosition[ 32922, 863] NotebookOutlinePosition[ 33321, 879] CellTagsIndexPosition[ 33278, 876] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Early Attempt at Finding Gram Matrices", "Title", CellChangeTimes->{{3.864735481164455*^9, 3.864735489248959*^9}},ExpressionUUID->"c51c1c8b-2540-4a63-92f6-\ 4e7d3d5f9d76"], Cell["\<\ The goal here was to use a formula found by Dylan to construct a massive \ system of equations and attempt to chuck it into \ Mathematica\[CloseCurlyQuote]s Solve function in hopes of getting the gram \ matrix out the other end, but this code at least didn\[CloseCurlyQuote]t end \ up working particularly well. There is no guarantee that these equations are \ solvable, which is unfortunate, and I think there are some mistakes or \ something in this implementation, because it should work with some polyhedra.\ \ \>", "Text", CellChangeTimes->{{3.864735500116888*^9, 3.8647356437317877`*^9}},ExpressionUUID->"c3406f07-a0d8-4f8a-a2e4-\ 1d424c3c89ef"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Get", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.832151022612398*^9, 3.832151030465872*^9}, { 3.8321511379667025`*^9, 3.8321511785398226`*^9}, 3.832151627377406*^9}, CellLabel->"In[1]:=",ExpressionUUID->"414a3c9b-c835-4353-8314-610b387cd4fe"], Cell[BoxData[ InterpretationBox[ RowBox[{"\<\"The currently installed versions of IGraph/M are: \"\>", "\[InvisibleSpace]", RowBox[{"{", "\<\"0.5.1\"\>", "}"}]}], SequenceForm[ "The currently installed versions of IGraph/M are: ", {"0.5.1"}], Editable->False]], "Print", CellChangeTimes->{3.8321516294929905`*^9, 3.8321792446538467`*^9, 3.8321888483607073`*^9, 3.83223375355267*^9, 3.864734398606039*^9}, CellLabel-> "During evaluation of \ In[1]:=",ExpressionUUID->"9a0f644e-76e7-49b2-bf2e-a5a0439d2bff"], Cell[BoxData[ TemplateBox[{ "System`PacletInstall", "samevers", "\"A paclet named \\!\\(\\*RowBox[{\\\"\\\\\\\"IGraphM\\\\\\\"\\\"}]\\) \ with the same version number \ (\\!\\(\\*RowBox[{\\\"\\\\\\\"0.5.1\\\\\\\"\\\"}]\\)) is already installed. \ Use PacletUninstall to remove the existing version first, or call \ PacletInstall with ForceVersionInstall -> True.\"", 2, 1, 1, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{3.83217924731254*^9, 3.832188855090274*^9, 3.832233757585519*^9, 3.864734407033389*^9}, CellLabel-> "During evaluation of \ In[1]:=",ExpressionUUID->"1c5f7cf6-0738-487e-8e29-494d036393b4"], Cell[BoxData[ InterpretationBox[ RowBox[{"\<\"Installation failed. Please install IGraph/M manually. \"\>", "\[InvisibleSpace]", TemplateBox[{ "\"https://github.com/szhorvat/IGraphM#installation\"", "https://github.com/szhorvat/IGraphM#installation"}, "HyperlinkURL"]}], SequenceForm["Installation failed. Please install IGraph/M manually. ", Hyperlink["https://github.com/szhorvat/IGraphM#installation"]], Editable->False]], "Print", CellChangeTimes->{3.8321516294929905`*^9, 3.8321792446538467`*^9, 3.8321888483607073`*^9, 3.83223375355267*^9, 3.864734407044916*^9}, CellLabel-> "During evaluation of \ In[1]:=",ExpressionUUID->"f93216f6-8658-427f-a66d-a212aa30c39f"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"<<", "IGraphM`"}]], "Input", CellChangeTimes->{{3.8321516420783434`*^9, 3.832151645302351*^9}}, CellLabel->"In[2]:=",ExpressionUUID->"f02af3bb-ed9d-4fb8-9ab5-418e5d718cf5"], 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", CellChangeTimes->{3.8321516533863616`*^9, 3.832179248194338*^9, 3.832188856442923*^9, 3.832233758550943*^9, 3.864734408212185*^9}, CellLabel->"Out[2]=",ExpressionUUID->"31c0c59f-a2fa-4297-b979-9547b625ff8b"] }, Open ]], Cell["Takes adjacency matrix and spits out graph", "Text", CellChangeTimes->{{3.832168668844531*^9, 3.832168674438282*^9}},ExpressionUUID->"9fb785ee-e560-44c5-a5b3-\ 5327bd61a726"], Cell[BoxData[ RowBox[{ RowBox[{"pgraph", "[", "adjmat_", "]"}], ":=", RowBox[{"PlanarGraph", "[", RowBox[{"AdjacencyGraph", "[", RowBox[{"adjmat", ",", RowBox[{"VertexLabels", "\[Rule]", "\"\\""}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.832157015635466*^9, 3.832157026317275*^9}, { 3.8321570768087626`*^9, 3.832157187087782*^9}, {3.832157260817*^9, 3.832157281243805*^9}, {3.83215738072911*^9, 3.832157439845132*^9}, { 3.8321578106356897`*^9, 3.8321578374593196`*^9}, {3.8321581875796967`*^9, 3.832158191258052*^9}}, CellLabel->"In[3]:=",ExpressionUUID->"7e4471aa-3419-4361-9954-ca85e8fdbcea"], Cell["Takes adjacency matrix and spits out dual graph", "Text", CellChangeTimes->{{3.832168678589355*^9, 3.8321686862740602`*^9}},ExpressionUUID->"9974cf68-13cb-4621-b559-\ 180b9188b28d"], Cell[BoxData[ RowBox[{ RowBox[{"dgraph", "[", "adjmat_", "]"}], ":=", RowBox[{"PlanarGraph", "[", RowBox[{"IGDualGraph", "[", RowBox[{ RowBox[{"pgraph", "[", "adjmat", "]"}], ",", RowBox[{"VertexLabels", "\[Rule]", "\"\\""}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.832157448820382*^9, 3.832157476669551*^9}, { 3.832157847353641*^9, 3.832157909605048*^9}, {3.83215819890162*^9, 3.832158204194887*^9}}, CellLabel->"In[4]:=",ExpressionUUID->"64960a86-3c40-410a-a0bf-67dc0dda7253"], Cell["Takes adjacency matrix and spits out dual adjacency matrix", "Text", CellChangeTimes->{{3.832168708906446*^9, 3.8321687487149277`*^9}},ExpressionUUID->"368224c4-3094-4b81-8a24-\ 52920579e0af"], Cell[BoxData[ RowBox[{ RowBox[{"dadjmat", "[", "adjmat_", "]"}], ":=", RowBox[{"Normal", "[", RowBox[{"AdjacencyMatrix", "[", RowBox[{"dgraph", "[", "adjmat", "]"}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.8321574651675024`*^9, 3.8321575207418165`*^9}, { 3.832157919355533*^9, 3.832157942375414*^9}}, CellLabel->"In[5]:=",ExpressionUUID->"2df0273a-68b0-4420-a181-5533de3142ef"], Cell["\<\ Takes adjacency matrix, graph, dual adjacency matrix, and dual graph and \ spits out extended gram matrix\ \>", "Text", CellChangeTimes->{{3.83216876403542*^9, 3.8321687827716303`*^9}},ExpressionUUID->"d7357423-e955-4cba-b0ba-\ acc9d2b7e0e5"], Cell[BoxData[ RowBox[{ RowBox[{"exGmat", "[", RowBox[{"adjmat_", ",", "adjmatg_", ",", "adjmatd_", ",", "adjmatdg_"}], "]"}], ":=", RowBox[{"ArrayFlatten", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"i", "==", "j"}], ",", "1", ",", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"adjmat", "[", RowBox[{"[", RowBox[{"i", ",", "j"}], "]"}], "]"}], "==", "1"}], ",", RowBox[{"-", "1"}], ",", RowBox[{"If", "[", RowBox[{ RowBox[{"i", ">", "j"}], ",", SubscriptBox["b", RowBox[{"j", ",", "i"}]], ",", SubscriptBox["b", RowBox[{"i", ",", "j"}]]}], "]"}]}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"MemberQ", "[", RowBox[{ RowBox[{ RowBox[{"IGFaces", "[", "adjmatg", "]"}], "[", RowBox[{"[", "j", "]"}], "]"}], ",", "i"}], "]"}], ",", "0", ",", SubscriptBox["b", RowBox[{"i", ",", RowBox[{"j", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}]}]]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", RowBox[{"VertexCount", "[", "adjmatdg", "]"}]}], "}"}]}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Transpose", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"MemberQ", "[", RowBox[{ RowBox[{ RowBox[{"IGFaces", "[", "adjmatg", "]"}], "[", RowBox[{"[", "j", "]"}], "]"}], ",", "i"}], "]"}], ",", "0", ",", SubscriptBox["b", RowBox[{"i", ",", RowBox[{"j", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}]}]]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", RowBox[{"VertexCount", "[", "adjmatdg", "]"}]}], "}"}]}], "]"}], "]"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"i", "==", "j"}], ",", "1", ",", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"adjmatd", "[", RowBox[{"[", RowBox[{"i", ",", "j"}], "]"}], "]"}], "==", "1"}], ",", RowBox[{"-", "1"}], ",", RowBox[{"If", "[", RowBox[{ RowBox[{"i", ">", "j"}], ",", SubscriptBox["b", RowBox[{ RowBox[{"j", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], ",", RowBox[{"i", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}]}]], ",", SubscriptBox["b", RowBox[{ RowBox[{"i", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}], ",", RowBox[{"j", "+", RowBox[{"VertexCount", "[", "adjmatg", "]"}]}]}]]}], "]"}]}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"VertexCount", "[", "adjmatdg", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{"VertexCount", "[", "adjmatdg", "]"}]}], "}"}]}], "]"}]}], "}"}]}], "}"}], "]"}]}]], "Input", CellChangeTimes->{{3.8321575269876523`*^9, 3.8321576763644238`*^9}, { 3.832159927387419*^9, 3.8321599288063574`*^9}, {3.832178568505596*^9, 3.8321785886368113`*^9}}, CellLabel->"In[6]:=",ExpressionUUID->"466eedf4-1501-4c34-b467-6afcd6ee9c2b"], Cell["\<\ Computes entire extended gram matrix just given adjacency graph\ \>", "Text", CellChangeTimes->{{3.8321688139423647`*^9, 3.832168826282061*^9}},ExpressionUUID->"4ea56a77-27f9-4776-93c6-\ 8db6873f4f90"], Cell[BoxData[ RowBox[{ RowBox[{"fullExGmat", "[", "adjmat_", "]"}], ":=", RowBox[{"exGmat", "[", RowBox[{"adjmat", ",", RowBox[{"pgraph", "[", "adjmat", "]"}], ",", RowBox[{"dadjmat", "[", "adjmat", "]"}], ",", RowBox[{"dgraph", "[", "adjmat", "]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.832159893936446*^9, 3.832159919205484*^9}, 3.832159950380535*^9, {3.832168786146203*^9, 3.832168807346489*^9}}, CellLabel->"In[7]:=",ExpressionUUID->"07904a6d-75de-42b6-bd6e-25258c9dfc13"], Cell[TextData[{ "Dylan\[CloseCurlyQuote]s formula: computes ", Cell[BoxData[ FormBox[ SubscriptBox["\[Alpha]", RowBox[{"i", ",", "j"}]], TraditionalForm]],ExpressionUUID-> "b3c7d5f4-d091-4a74-aebc-91ee5194a0e1"], " given all bilinear forms between two tangent circles, c1 and c2, and their \ shared dual circle d" }], "Text", CellChangeTimes->{{3.832178377907075*^9, 3.832178410699369*^9}, { 3.832178594854447*^9, 3.8321785952028008`*^9}, {3.83217891353088*^9, 3.832178922038512*^9}, {3.832178990238923*^9, 3.83217902018289*^9}},ExpressionUUID->"551f2841-8783-4e7e-8126-\ fa2d7423c031"], Cell[BoxData[ RowBox[{ RowBox[{"dylanFormula", "[", RowBox[{"i_", ",", "j_", ",", "c1_", ",", "c2_", ",", "d_"}], "]"}], ":=", RowBox[{ RowBox[{ RowBox[{"d", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], RowBox[{"d", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}]}], "+", RowBox[{ RowBox[{"c2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], RowBox[{"c2", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}]}], "-", RowBox[{ FractionBox["1", "2"], RowBox[{"(", RowBox[{ RowBox[{ FractionBox[ RowBox[{ SuperscriptBox[ RowBox[{"d", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "2"], "+", SuperscriptBox[ RowBox[{ "c2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "2"], "-", "1"}], RowBox[{ RowBox[{"c1", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "+", RowBox[{ "c2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}]], RowBox[{"(", RowBox[{ RowBox[{"c1", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}], "+", RowBox[{ "c2", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}]}], ")"}]}], "+", RowBox[{ FractionBox[ RowBox[{ SuperscriptBox[ RowBox[{"d", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}], "2"], "+", SuperscriptBox[ RowBox[{ "c2", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}], "2"], "-", "1"}], RowBox[{ RowBox[{"c1", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}], "+", RowBox[{ "c2", "\[LeftDoubleBracket]", "j", "\[RightDoubleBracket]"}]}]], RowBox[{"(", RowBox[{ RowBox[{"c1", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}], "+", RowBox[{ "c2", "\[LeftDoubleBracket]", "i", "\[RightDoubleBracket]"}]}], ")"}]}]}], ")"}]}]}]}]], "Input", CellChangeTimes->{{3.8321784141799994`*^9, 3.832178465721493*^9}, { 3.83217860325821*^9, 3.832178655554688*^9}, {3.83217875635993*^9, 3.832178873607215*^9}}, CellLabel->"In[8]:=",ExpressionUUID->"bf8ef1f1-47be-4283-b703-c185b6f0b640"], Cell["\<\ Uses Dylan\[CloseCurlyQuote]s formula and the extended gram matrix to create \ the equations\ \>", "Text", CellChangeTimes->{{3.832188658163759*^9, 3.832188667687117*^9}},ExpressionUUID->"40d5a3ff-8fe6-48ac-bfbe-\ 6a97c5e28c14"], Cell[BoxData[ RowBox[{ RowBox[{"eqs", "[", RowBox[{"i_", ",", "j_", ",", "c1_", ",", "c2_", ",", "d_", ",", "Gext_"}], "]"}], ":=", RowBox[{ RowBox[{"dylanFormula", "[", RowBox[{"i", ",", "j", ",", "c1", ",", "c2", ",", "d"}], "]"}], "\[Equal]", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"i", ",", "j"}], "\[RightDoubleBracket]"}]}]}]], "Input", CellChangeTimes->{{3.832179077629673*^9, 3.832179079427682*^9}, { 3.8321791928839073`*^9, 3.832179236666037*^9}}, CellLabel->"In[9]:=",ExpressionUUID->"420e0d3e-8926-42c8-bf5b-90e13c9517d3"], Cell["Creates a list of all relevant variables", "Text", CellChangeTimes->{{3.832188674746522*^9, 3.832188679399398*^9}},ExpressionUUID->"48590ebf-9c87-4ec4-bfbf-\ 27e74718b29f"], Cell[BoxData[ RowBox[{ RowBox[{"allVars", "[", RowBox[{"n_", ",", "m_"}], "]"}], ":=", RowBox[{"Flatten", "[", RowBox[{"Table", "[", RowBox[{ SubscriptBox["b", RowBox[{"i", ",", "j"}]], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"n", "+", "m"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", RowBox[{"i", "+", "1"}], ",", RowBox[{"n", "+", "m"}]}], "}"}]}], "]"}], "]"}]}]], "Input", CellChangeTimes->{{3.832180251879418*^9, 3.832180286404707*^9}, { 3.83218032560913*^9, 3.832180334849931*^9}}, CellLabel->"In[10]:=",ExpressionUUID->"6be67f5a-9ae0-4ab1-a49b-076a5355b7fb"], Cell["\<\ Given the adjacency matrix and which three rows/columns to pick (I\ \[CloseCurlyQuote]d like to eventually automate this; should be pretty easy), \ gives the extended Gram matrix. Ignore the warnings, everything actually works. Also we still have the \ problem with that one other face, but should be fairly easy to fix tomorrow.\ \>", "Text", CellChangeTimes->{{3.832188684680435*^9, 3.832188781650333*^9}},ExpressionUUID->"5352eb21-29c8-493a-98a4-\ 6ede330dc961"], Cell[BoxData[ RowBox[{ RowBox[{"findGextGivenAdjacency", "[", RowBox[{"adjmat_", ",", "c1_", ",", "c2_", ",", "d_"}], "]"}], ":=", RowBox[{"Block", "[", RowBox[{ RowBox[{"{", RowBox[{ "Gext", ",", "c1s", ",", "c2s", ",", "ds", ",", "n", ",", "m", ",", "rules", ",", "assumptions", ",", "temp"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"n", "=", RowBox[{"Length", "[", "adjmat", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"m", "=", RowBox[{"Length", "[", RowBox[{"dadjmat", "[", "adjmat", "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Gext", "=", RowBox[{"fullExGmat", "[", "adjmat", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c1s", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "c1"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c2s", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "c2"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"ds", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "d"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"assumptions", "=", RowBox[{ RowBox[{ RowBox[{"#", "\[LessEqual]", "0"}], "&"}], "/@", RowBox[{"allVars", "[", RowBox[{"n", ",", "m"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"rules", "=", RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"Flatten", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"SameQ", "[", RowBox[{ RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"i", ",", "j"}], "\[RightDoubleBracket]"}], ",", RowBox[{"-", "1"}]}], "]"}], "||", RowBox[{"SameQ", "[", RowBox[{ RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"i", ",", "j"}], "\[RightDoubleBracket]"}], ",", "0"}], "]"}]}], ",", RowBox[{"eqs", "[", RowBox[{ "i", ",", "j", ",", "c1s", ",", "c2s", ",", "ds", ",", "Gext"}], "]"}], ",", "True"}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"n", "+", "m"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", RowBox[{"n", "+", "m"}]}], "}"}]}], "]"}], "]"}], "//", RowBox[{"DeleteCases", "[", RowBox[{"Indeterminate", "\[Equal]", "__"}], "]"}]}], "//", RowBox[{"DeleteCases", "[", "False", "]"}]}], "//", "Simplify"}], "//", RowBox[{"DeleteCases", "[", "True", "]"}]}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"temp", "=", RowBox[{"Gext", "/.", "rules"}]}], ";", "\[IndentingNewLine]", RowBox[{"temp", "/.", RowBox[{ RowBox[{"Solve", "[", RowBox[{ RowBox[{"Det", "[", "temp", "]"}], "==", "0"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.832179291894788*^9, 3.832179514217531*^9}, { 3.83217965960777*^9, 3.8321797806519737`*^9}, {3.832182725009789*^9, 3.832182755832143*^9}, {3.83218306930501*^9, 3.832183092163796*^9}, { 3.8321832829376574`*^9, 3.832183288927372*^9}, {3.832183458386508*^9, 3.832183458902268*^9}, {3.8321835024578123`*^9, 3.832183505021721*^9}, { 3.8321835733949423`*^9, 3.832183603990161*^9}, {3.832184046631289*^9, 3.832184063346572*^9}, 3.832184140028371*^9, {3.8321842002796173`*^9, 3.832184205781186*^9}, 3.832184290558262*^9, 3.832185122942072*^9, { 3.8321858451050043`*^9, 3.832185942387307*^9}, {3.832186018520791*^9, 3.832186052360086*^9}, {3.832186094120708*^9, 3.8321861420031347`*^9}, { 3.832186175260569*^9, 3.832186201772645*^9}, {3.832186235325078*^9, 3.8321862618199997`*^9}, {3.8321863613697853`*^9, 3.8321863669835577`*^9}, {3.832186452371193*^9, 3.832186456250992*^9}, { 3.832236951287407*^9, 3.8322369831425056`*^9}, {3.832237035633595*^9, 3.832237063324972*^9}, {3.86473485530978*^9, 3.8647348676504307`*^9}, { 3.864735093226548*^9, 3.864735157772408*^9}, {3.864735190139861*^9, 3.8647352196850433`*^9}, {3.864735266280509*^9, 3.8647353129208384`*^9}, 3.864735346875978*^9, {3.8647360522199173`*^9, 3.864736100541009*^9}}, CellLabel->"In[88]:=",ExpressionUUID->"f4f2f39c-a979-492f-a025-beb69389c674"], Cell["Same as above, but numerically approximates it.", "Text", CellChangeTimes->{{3.832188787533435*^9, 3.832188795439991*^9}},ExpressionUUID->"d96df70c-f12c-4947-8ff1-\ cf67a6e8d5f1"], Cell[BoxData[ RowBox[{ RowBox[{"findGextGivenAdjacencyN", "[", RowBox[{"adjmat_", ",", "c1_", ",", "c2_", ",", "d_"}], "]"}], ":=", RowBox[{"Block", "[", RowBox[{ RowBox[{"{", RowBox[{ "Gext", ",", "c1s", ",", "c2s", ",", "ds", ",", "n", ",", "m", ",", "rules", ",", "assumptions"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"n", "=", RowBox[{"Length", "[", "adjmat", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"m", "=", RowBox[{"Length", "[", RowBox[{"dadjmat", "[", "adjmat", "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Gext", "=", RowBox[{"fullExGmat", "[", "adjmat", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c1s", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "c1"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c2s", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "c2"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"ds", "=", RowBox[{"Gext", "\[LeftDoubleBracket]", RowBox[{"All", ",", "d"}], "\[RightDoubleBracket]"}]}], ";", "\[IndentingNewLine]", RowBox[{"assumptions", "=", RowBox[{ RowBox[{ RowBox[{"#", "\[LessEqual]", "0"}], "&"}], "/@", RowBox[{"allVars", "[", RowBox[{"n", ",", "m"}], "]"}]}]}], ";", "\[IndentingNewLine]", RowBox[{"rules", "=", RowBox[{"NSolve", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"Flatten", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"eqs", "[", RowBox[{ "i", ",", "j", ",", "c1s", ",", "c2s", ",", "ds", ",", "Gext"}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"n", "+", "m"}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", RowBox[{"n", "+", "m"}]}], "}"}]}], "]"}], "]"}], "//", RowBox[{"DeleteCases", "[", RowBox[{"Indeterminate", "\[Equal]", "__"}], "]"}]}], "//", "Simplify"}], "//", RowBox[{"DeleteCases", "[", "True", "]"}]}], ",", "Reals"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"Select", "[", RowBox[{ RowBox[{"Gext", "/.", "rules"}], ",", RowBox[{ RowBox[{"AllTrue", "[", RowBox[{"#", ",", RowBox[{ RowBox[{ RowBox[{"#", "\[LessEqual]", "0"}], "||", RowBox[{"#", "\[Equal]", "1"}], "||", RowBox[{"SameQ", "[", RowBox[{ RowBox[{"Head", "[", "#", "]"}], ",", "Subscript"}], "]"}]}], "&"}], ",", "2"}], "]"}], "&"}]}], "]"}], "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.8321863796375513`*^9, 3.832186447086238*^9}, { 3.832186612097026*^9, 3.832186638550942*^9}, {3.832186914043337*^9, 3.832186922217325*^9}, {3.832187020117702*^9, 3.832187021912196*^9}, { 3.8321871707702923`*^9, 3.8321871736438*^9}, {3.8321877632435617`*^9, 3.832187771381138*^9}, {3.83218786469829*^9, 3.832187868963749*^9}, { 3.8322340786657343`*^9, 3.8322341092778482`*^9}}, CellLabel->"In[12]:=",ExpressionUUID->"e9aabedc-e11e-4cce-a76e-c710d3384ca9"], Cell["It almost works with the tetrahedron.", "Text", CellChangeTimes->{{3.864739016815413*^9, 3.8647390212370787`*^9}},ExpressionUUID->"253b2ba5-d3d8-487f-ae0b-\ 3c5567445616"], Cell[BoxData[ RowBox[{ RowBox[{"tetradj", "=", RowBox[{ RowBox[{"PolyhedronData", "[", RowBox[{"\"\\"", ",", "\"\\""}], "]"}], "//", "AdjacencyMatrix"}]}], ";"}]], "Input", CellChangeTimes->{{3.864735715391293*^9, 3.864735755599956*^9}, { 3.864736030861405*^9, 3.864736034053837*^9}}, CellLabel->"In[83]:=",ExpressionUUID->"7ae018a2-0992-4320-92df-75ee8f9717e1"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"findGextGivenAdjacency", "[", RowBox[{"tetradj", ",", "1", ",", "2", ",", "5"}], "]"}], "//", "MatrixForm"}]], "Input", CellChangeTimes->{{3.8647359788048897`*^9, 3.864735984616076*^9}, { 3.8647360377017927`*^9, 3.8647360448476257`*^9}, {3.864736109557313*^9, 3.8647361135524054`*^9}}, CellLabel->"In[91]:=",ExpressionUUID->"29c4fd45-69f8-4308-84f3-0c9572c9bb55"], Cell[BoxData[ TemplateBox[{ "Power", "infy", "\"Infinite expression \\!\\(\\*FractionBox[\\\"1\\\", \\\"0\\\"]\\) \ encountered.\"", 2, 91, 252, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.8647361139153233`*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"069ce30e-51da-464a-9286-8ce88168184b"], Cell[BoxData[ TemplateBox[{ "Infinity", "indet", "\"Indeterminate expression \\!\\(\\*RowBox[{\\\"0\\\", \\\" \\\", \ \\\"ComplexInfinity\\\"}]\\) encountered.\"", 2, 91, 253, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.864736113926489*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"11f99cbe-866b-4da5-846c-40c55dd85cc9"], Cell[BoxData[ TemplateBox[{ "Power", "infy", "\"Infinite expression \\!\\(\\*FractionBox[\\\"1\\\", \\\"0\\\"]\\) \ encountered.\"", 2, 91, 254, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.864736113934101*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"6c511ac6-894a-42d0-85ca-2f409b91ffb4"], Cell[BoxData[ TemplateBox[{ "Infinity", "indet", "\"Indeterminate expression \\!\\(\\*RowBox[{\\\"0\\\", \\\" \\\", \ \\\"ComplexInfinity\\\"}]\\) encountered.\"", 2, 91, 255, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.864736113941854*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"ea03061f-1629-49a1-8e21-d5adb3b3c4a0"], Cell[BoxData[ TemplateBox[{ "Power", "infy", "\"Infinite expression \\!\\(\\*FractionBox[\\\"1\\\", \\\"0\\\"]\\) \ encountered.\"", 2, 91, 256, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.8647361139498653`*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"effee00e-250a-4dbb-a7e5-dfe6fb7defea"], Cell[BoxData[ TemplateBox[{ "General", "stop", "\"Further output of \\!\\(\\*StyleBox[RowBox[{\\\"Power\\\", \\\"::\\\", \ \\\"infy\\\"}], \\\"MessageName\\\"]\\) will be suppressed during this \ calculation.\"", 2, 91, 257, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.8647361139582453`*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"37d53405-8bca-435f-b2c7-8cda8da73049"], Cell[BoxData[ TemplateBox[{ "Infinity", "indet", "\"Indeterminate expression \\!\\(\\*RowBox[{\\\"0\\\", \\\" \\\", \ \\\"ComplexInfinity\\\"}]\\) encountered.\"", 2, 91, 258, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.8647361139676113`*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"89f114b0-9675-4ca6-9014-56c6286806a8"], Cell[BoxData[ TemplateBox[{ "General", "stop", "\"Further output of \\!\\(\\*StyleBox[RowBox[{\\\"Infinity\\\", \ \\\"::\\\", \\\"indet\\\"}], \\\"MessageName\\\"]\\) will be suppressed \ during this calculation.\"", 2, 91, 259, 18949302130080748064, "Local"}, "MessageTemplate"]], "Message", "MSG", CellChangeTimes->{ 3.8647359857098017`*^9, {3.86473604066442*^9, 3.864736055281802*^9}, { 3.864736105160235*^9, 3.864736113976234*^9}}, CellLabel-> "During evaluation of \ In[91]:=",ExpressionUUID->"0412eea0-47cc-4bde-a051-03a82090edc2"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", RowBox[{"-", "1"}], RowBox[{"-", "1"}], RowBox[{"-", "1"}], "0", "0", "0", RowBox[{"-", "2"}]}, { RowBox[{"-", "1"}], "1", RowBox[{"-", "1"}], RowBox[{"-", "1"}], "0", RowBox[{"-", "2"}], "0", "0"}, { RowBox[{"-", "1"}], RowBox[{"-", "1"}], "1", RowBox[{"-", "1"}], "0", "0", SubscriptBox["b", RowBox[{"3", ",", "7"}]], "0"}, { RowBox[{"-", "1"}], RowBox[{"-", "1"}], RowBox[{"-", "1"}], "1", RowBox[{"-", "2"}], "0", "0", "0"}, {"0", "0", "0", RowBox[{"-", "2"}], "1", RowBox[{"-", "1"}], RowBox[{"-", "1"}], RowBox[{"-", "1"}]}, {"0", RowBox[{"-", "2"}], "0", "0", RowBox[{"-", "1"}], "1", RowBox[{"-", "1"}], RowBox[{"-", "1"}]}, {"0", "0", SubscriptBox["b", RowBox[{"3", ",", "7"}]], "0", RowBox[{"-", "1"}], RowBox[{"-", "1"}], "1", RowBox[{"-", "1"}]}, { RowBox[{"-", "2"}], "0", "0", "0", 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.864736017812807*^9, 3.864736055348247*^9}, { 3.864736105228671*^9, 3.864736113985414*^9}}, CellLabel-> "Out[91]//MatrixForm=",ExpressionUUID->"81437b0a-8664-4d33-b2b9-\ fd25f7260eef"] }, Open ]] }, Open ]] }, WindowSize->{1437., 787.5}, WindowMargins->{{1.5, Automatic}, {1.5, Automatic}}, FrontEndVersion->"13.0 for Linux x86 (64-bit) (February 4, 2022)", StyleDefinitions->"Default.nb", ExpressionUUID->"8df4a218-f4b3-4aa1-ac74-2935a02f7ddc" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[580, 22, 181, 3, 98, "Title",ExpressionUUID->"c51c1c8b-2540-4a63-92f6-4e7d3d5f9d76"], Cell[764, 27, 665, 12, 81, "Text",ExpressionUUID->"c3406f07-a0d8-4f8a-a2e4-1d424c3c89ef"], Cell[CellGroupData[{ Cell[1454, 43, 359, 6, 29, "Input",ExpressionUUID->"414a3c9b-c835-4353-8314-610b387cd4fe"], Cell[1816, 51, 529, 12, 23, "Print",ExpressionUUID->"9a0f644e-76e7-49b2-bf2e-a5a0439d2bff"], Cell[2348, 65, 673, 14, 28, "Message",ExpressionUUID->"1c5f7cf6-0738-487e-8e29-494d036393b4"], Cell[3024, 81, 709, 15, 25, "Print",ExpressionUUID->"f93216f6-8658-427f-a66d-a212aa30c39f"] }, Open ]], Cell[CellGroupData[{ Cell[3770, 101, 198, 3, 29, "Input",ExpressionUUID->"f02af3bb-ed9d-4fb8-9ab5-418e5d718cf5"], Cell[3971, 106, 629, 12, 54, "Output",ExpressionUUID->"31c0c59f-a2fa-4297-b979-9547b625ff8b"] }, Open ]], Cell[4615, 121, 184, 3, 35, "Text",ExpressionUUID->"9fb785ee-e560-44c5-a5b3-5327bd61a726"], Cell[4802, 126, 647, 13, 29, "Input",ExpressionUUID->"7e4471aa-3419-4361-9954-ca85e8fdbcea"], Cell[5452, 141, 191, 3, 35, "Text",ExpressionUUID->"9974cf68-13cb-4621-b559-180b9188b28d"], Cell[5646, 146, 531, 12, 29, "Input",ExpressionUUID->"64960a86-3c40-410a-a0bf-67dc0dda7253"], Cell[6180, 160, 202, 3, 35, "Text",ExpressionUUID->"368224c4-3094-4b81-8a24-52920579e0af"], Cell[6385, 165, 403, 8, 29, "Input",ExpressionUUID->"2df0273a-68b0-4420-a181-5533de3142ef"], Cell[6791, 175, 256, 6, 35, "Text",ExpressionUUID->"d7357423-e955-4cba-b0ba-acc9d2b7e0e5"], Cell[7050, 183, 4540, 120, 135, "Input",ExpressionUUID->"466eedf4-1501-4c34-b467-6afcd6ee9c2b"], Cell[11593, 305, 215, 5, 35, "Text",ExpressionUUID->"4ea56a77-27f9-4776-93c6-8db6873f4f90"], Cell[11811, 312, 512, 10, 29, "Input",ExpressionUUID->"07904a6d-75de-42b6-bd6e-25258c9dfc13"], Cell[12326, 324, 610, 14, 36, "Text",ExpressionUUID->"551f2841-8783-4e7e-8126-fa2d7423c031"], Cell[12939, 340, 2379, 65, 50, "Input",ExpressionUUID->"bf8ef1f1-47be-4283-b703-c185b6f0b640"], Cell[15321, 407, 242, 6, 35, "Text",ExpressionUUID->"40d5a3ff-8fe6-48ac-bfbe-6a97c5e28c14"], Cell[15566, 415, 581, 13, 29, "Input",ExpressionUUID->"420e0d3e-8926-42c8-bf5b-90e13c9517d3"], Cell[16150, 430, 182, 3, 35, "Text",ExpressionUUID->"48590ebf-9c87-4ec4-bfbf-27e74718b29f"], Cell[16335, 435, 657, 18, 30, "Input",ExpressionUUID->"6be67f5a-9ae0-4ab1-a49b-076a5355b7fb"], Cell[16995, 455, 479, 9, 58, "Text",ExpressionUUID->"5352eb21-29c8-493a-98a4-6ede330dc961"], Cell[17477, 466, 4836, 103, 278, "Input",ExpressionUUID->"f4f2f39c-a979-492f-a025-beb69389c674"], Cell[22316, 571, 189, 3, 35, "Text",ExpressionUUID->"d96df70c-f12c-4947-8ff1-cf67a6e8d5f1"], Cell[22508, 576, 3474, 84, 216, "Input",ExpressionUUID->"e9aabedc-e11e-4cce-a76e-c710d3384ca9"], Cell[25985, 662, 181, 3, 35, "Text",ExpressionUUID->"253b2ba5-d3d8-487f-ae0b-3c5567445616"], Cell[26169, 667, 413, 9, 29, "Input",ExpressionUUID->"7ae018a2-0992-4320-92df-75ee8f9717e1"], Cell[CellGroupData[{ Cell[26607, 680, 412, 8, 29, "Input",ExpressionUUID->"29c4fd45-69f8-4308-84f3-0c9572c9bb55"], Cell[27022, 690, 473, 11, 39, "Message",ExpressionUUID->"069ce30e-51da-464a-9286-8ce88168184b"], Cell[27498, 703, 506, 12, 28, "Message",ExpressionUUID->"11f99cbe-866b-4da5-846c-40c55dd85cc9"], Cell[28007, 717, 471, 11, 39, "Message",ExpressionUUID->"6c511ac6-894a-42d0-85ca-2f409b91ffb4"], Cell[28481, 730, 506, 12, 28, "Message",ExpressionUUID->"ea03061f-1629-49a1-8e21-d5adb3b3c4a0"], Cell[28990, 744, 473, 11, 39, "Message",ExpressionUUID->"effee00e-250a-4dbb-a7e5-dfe6fb7defea"], Cell[29466, 757, 553, 12, 28, "Message",ExpressionUUID->"37d53405-8bca-435f-b2c7-8cda8da73049"], Cell[30022, 771, 508, 12, 28, "Message",ExpressionUUID->"89f114b0-9675-4ca6-9014-56c6286806a8"], Cell[30533, 785, 555, 12, 28, "Message",ExpressionUUID->"0412eea0-47cc-4bde-a051-03a82090edc2"], Cell[31091, 799, 1803, 60, 168, "Output",ExpressionUUID->"81437b0a-8664-4d33-b2b9-fd25f7260eef"] }, Open ]] }, Open ]] } ] *)