(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 16410, 387] NotebookOptionsPosition[ 15698, 359] NotebookOutlinePosition[ 16038, 374] CellTagsIndexPosition[ 15995, 371] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{ "g_GradedBigraph", ",", "AtDepth_Integer", ",", " ", "WithinDepth_Integer"}], "]"}], "/;", RowBox[{"1", "\[LessEqual]", "WithinDepth", "\[LessEqual]", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}]}], ":=", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"AtDepth", "+", "1"}], ",", RowBox[{ RowBox[{"2", "WithinDepth"}], "-", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}]}], "}"}]}]], "Input", CellChangeTimes->{{3.450708127954625*^9, 3.450708298463188*^9}, { 3.450708652989149*^9, 3.450708657706757*^9}, {3.450708717857815*^9, 3.4507087361411467`*^9}, {3.450708854301813*^9, 3.4507088677860928`*^9}, { 3.450709522879641*^9, 3.450709523205056*^9}, {3.450709591838722*^9, 3.4507096609125957`*^9}, {3.450709726053699*^9, 3.45070974256462*^9}, { 3.4507105988297987`*^9, 3.450710611163541*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"DisplayBigraph", "[", "g_GradedBigraph", "]"}], ":=", RowBox[{"Show", "[", RowBox[{ RowBox[{"Graphics", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"Point", "[", RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinDepth"}], "]"}], "]"}], ",", RowBox[{"{", RowBox[{"AtDepth", ",", "0", ",", RowBox[{"GraphDepth", "[", "g", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinDepth", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}], "}"}]}], "]"}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"g", "\[LeftDoubleBracket]", RowBox[{"AtDepth", "+", "1"}], "\[RightDoubleBracket]"}], "\[LeftDoubleBracket]", RowBox[{"WithinEnd", ",", "WithinStart"}], "\[RightDoubleBracket]"}], "\[NotEqual]", "0"}], ",", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinStart"}], "]"}], ",", RowBox[{"VertexLocation", "[", RowBox[{"g", ",", RowBox[{"AtDepth", "+", "1"}], ",", "WithinEnd"}], "]"}]}], "}"}], "]"}], ",", RowBox[{"{", "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"AtDepth", ",", "0", ",", RowBox[{ RowBox[{"GraphDepth", "[", "g", "]"}], "-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinStart", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinEnd", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", RowBox[{"AtDepth", "+", "1"}]}], "]"}]}], "}"}]}], "]"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Graphics", "[", RowBox[{"Table", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"g", "\[LeftDoubleBracket]", RowBox[{"AtDepth", "+", "1"}], "\[RightDoubleBracket]"}], "\[LeftDoubleBracket]", RowBox[{"WithinEnd", ",", "WithinStart"}], "\[RightDoubleBracket]"}], ">", "1"}], ",", " ", RowBox[{"Text", "[", RowBox[{ RowBox[{"g", "\[LeftDoubleBracket]", RowBox[{"AtDepth", "+", "1"}], "\[RightDoubleBracket]"}], "\[LeftDoubleBracket]", RowBox[{"WithinEnd", ",", "WithinStart"}], "\[RightDoubleBracket]"}], "]"}], ",", RowBox[{"{", "}"}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{"AtDepth", ",", "0", ",", RowBox[{ RowBox[{"GraphDepth", "[", "g", "]"}], "-", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinStart", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinEnd", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", RowBox[{"AtDepth", "+", "1"}]}], "]"}]}], "}"}]}], "]"}], "]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.450709843686408*^9, 3.450709914956334*^9}, { 3.450710177939045*^9, 3.450710188546095*^9}, {3.450710225834991*^9, 3.450710227544095*^9}, {3.450710577204624*^9, 3.450710659020379*^9}, { 3.4507107014994373`*^9, 3.4507107017145023`*^9}, {3.45071077156923*^9, 3.450711017221794*^9}, {3.4507110494036503`*^9, 3.4507110712421827`*^9}, { 3.4507111019933662`*^9, 3.450711118200471*^9}, {3.450711151619339*^9, 3.450711264674069*^9}, {3.4507114045666447`*^9, 3.4507115147900763`*^9}, { 3.462499761205577*^9, 3.4624998115531282`*^9}, 3.4624999986768*^9}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DisplayBigraph", "[", "HaagerupBigraph", "]"}]], "Input", CellChangeTimes->{{3.450710665176553*^9, 3.450710673836433*^9}, 3.462500000880494*^9}], Cell[BoxData[ GraphicsBox[{{PointBox[{1, 1}], PointBox[{2, 1}], LineBox[{{1, 1}, {2, 1}}], {}}, {PointBox[{2, 1}], PointBox[{3, 1}], LineBox[{{2, 1}, {3, 1}}], {}}, {PointBox[{3, 1}], PointBox[{4, 1}], LineBox[{{3, 1}, {4, 1}}], {}}, {{PointBox[{4, 1}], PointBox[{5, 0}], LineBox[{{4, 1}, {5, 0}}], {}}, {PointBox[{4, 1}], PointBox[{5, 2}], LineBox[{{4, 1}, {5, 2}}], {}}}, {{{PointBox[{5, 0}], PointBox[{6, 0}], LineBox[{{5, 0}, {6, 0}}], {}}, {PointBox[{5, 0}], PointBox[{6, 2}], {}, {}}}, {{PointBox[{5, 2}], PointBox[{6, 0}], {}, {}}, {PointBox[{5, 2}], PointBox[{6, 2}], LineBox[{{5, 2}, {6, 2}}], {}}}}, {{{PointBox[{6, 0}], PointBox[{7, 0}], LineBox[{{6, 0}, {7, 0}}], {}}, {PointBox[{6, 0}], PointBox[{7, 2}], {}, {}}}, {{PointBox[{6, 2}], PointBox[{7, 0}], {}, {}}, {PointBox[{6, 2}], PointBox[{7, 2}], LineBox[{{6, 2}, {7, 2}}], {}}}}}]], "Output", CellChangeTimes->{{3.4507106745841846`*^9, 3.450710704379601*^9}, { 3.450710773560668*^9, 3.450710792009368*^9}, 3.450710991445074*^9, 3.450711074773888*^9, {3.4507111059604588`*^9, 3.450711120188731*^9}, { 3.450711228814521*^9, 3.450711265908849*^9}, {3.450711491035664*^9, 3.450711516990429*^9}, 3.450877220232984*^9, 3.450888320216795*^9, 3.4624992302372017`*^9, {3.462499779446782*^9, 3.4624998147447033`*^9}, 3.462499930128673*^9, 3.4625000161618443`*^9}] }, Open ]], Cell[BoxData[ RowBox[{ RowBox[{"DualWithinDepth", "[", RowBox[{"d_DualData", ",", RowBox[{"AtDepth_", "?", "EvenQ"}], ",", "WithinDepth_"}], "]"}], ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"DualDataIndex", "=", RowBox[{"1", "+", RowBox[{"AtDepth", "/", "2"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"d", "\[LeftDoubleBracket]", RowBox[{"DualDataIndex", ",", "WithinDepth"}], "\[RightDoubleBracket]"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.450711979752689*^9, 3.450712084664424*^9}, { 3.450712136117854*^9, 3.450712202258338*^9}, {3.450712243825624*^9, 3.450712245312426*^9}}], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"DisplayBigraph", "[", "gd_BigraphWithDuals", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"g", "=", RowBox[{ "gd", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], ",", RowBox[{"d", "=", RowBox[{ "gd", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}]}], "}"}], ",", RowBox[{"Show", "[", RowBox[{ RowBox[{"NewDisplayBigraph", "[", "g", "]"}], ",", "\[IndentingNewLine]", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"Table", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"EvenQ", "[", "AtDepth", "]"}], ",", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"DualWithinDepth", "[", RowBox[{"d", ",", "AtDepth", ",", "WithinDepth"}], "]"}], "\[Equal]", "WithinDepth"}], ",", "\[IndentingNewLine]", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinDepth"}], "]"}], ",", RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinDepth"}], "]"}], "+", RowBox[{"{", RowBox[{"0", ",", ".5"}], "}"}]}]}], "}"}], "]"}], ",", "\[IndentingNewLine]", RowBox[{"Line", "[", RowBox[{"{", RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinDepth"}], "]"}], ",", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", "WithinDepth"}], "]"}], "+", RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", RowBox[{"DualWithinDepth", "[", RowBox[{"d", ",", "AtDepth", ",", "WithinDepth"}], "]"}]}], "]"}]}], ")"}], "/", "2"}], "+", RowBox[{"{", RowBox[{".2", ",", "0"}], "}"}]}], ",", RowBox[{"VertexLocation", "[", RowBox[{"g", ",", "AtDepth", ",", RowBox[{"DualWithinDepth", "[", RowBox[{"d", ",", "AtDepth", ",", "WithinDepth"}], "]"}]}], "]"}]}], "}"}], "]"}]}], "]"}], ",", RowBox[{"{", "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"AtDepth", ",", "0", ",", RowBox[{"GraphDepth", "[", "g", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"WithinDepth", ",", "1", ",", RowBox[{"RankAtDepth", "[", RowBox[{"g", ",", "AtDepth"}], "]"}]}], "}"}]}], "]"}]}], "}"}], "]"}]}], "\[IndentingNewLine]", "]"}]}], "]"}]}], "\[IndentingNewLine]"}]], "Input", CellChangeTimes->{{3.4507113016176043`*^9, 3.450711319941723*^9}, { 3.450711360282118*^9, 3.450711374334605*^9}, {3.4507115499750834`*^9, 3.450711555776949*^9}, {3.450711611676108*^9, 3.450711653874691*^9}, { 3.450711706977667*^9, 3.450711977633996*^9}, {3.45071210161686*^9, 3.450712126968213*^9}, {3.450712269642044*^9, 3.4507122998872013`*^9}, { 3.450712335861353*^9, 3.450712365563381*^9}, {3.4507124076659193`*^9, 3.45071246648726*^9}, {3.450712509524308*^9, 3.4507125101370583`*^9}, { 3.450712619728154*^9, 3.450712659843091*^9}, {3.45071270143531*^9, 3.450712703112941*^9}, {3.450712733745776*^9, 3.450712911529955*^9}, { 3.450712942372657*^9, 3.450712942523819*^9}, {3.450713017178907*^9, 3.45071302966089*^9}, {3.462499513503829*^9, 3.462499605293501*^9}, { 3.4624996525276747`*^9, 3.462499676225909*^9}, {3.46249985911837*^9, 3.4624998679422207`*^9}, 3.462500005313431*^9}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DisplayBigraph", "[", "HaagerupWithDuals", "]"}]], "Input", CellChangeTimes->{{3.450712374436363*^9, 3.4507123984315968`*^9}, { 3.450713084532885*^9, 3.450713085356409*^9}, 3.4507131243259583`*^9, 3.462500008504591*^9}], Cell[BoxData[ GraphicsBox[{{{PointBox[{1, 1}], PointBox[{2, 1}], PointBox[{3, 1}], PointBox[{4, 1}], {PointBox[{5, 0}], PointBox[{5, 2}]}, { PointBox[{6, 0}], PointBox[{6, 2}]}, {PointBox[{7, 0}], PointBox[{7, 2}]}}, {LineBox[{{1, 1}, {2, 1}}], LineBox[{{2, 1}, {3, 1}}], LineBox[{{3, 1}, {4, 1}}], {LineBox[{{4, 1}, {5, 0}}], LineBox[{{4, 1}, {5, 2}}]}, {{LineBox[{{5, 0}, {6, 0}}], {}}, {{}, LineBox[{{5, 2}, {6, 2}}]}}, {{LineBox[{{6, 0}, {7, 0}}], {}}, {{}, LineBox[{{6, 2}, {7, 2}}]}}}, {{}, {}, {}, {{}, {}}, {{{}, {}}, {{}, {}}}, {{{}, {}}, {{}, \ {}}}}}, {RGBColor[1, 0, 0], LineBox[{{1, 1}, {1, 1.5}}], {}, LineBox[{{3, 1}, {3, 1.5}}], {}, {LineBox[{{5, 0}, {5, 0.5}}], LineBox[{{5, 2}, {5, 2.5}}]}, {{}, {}}, { LineBox[{{7, 0}, {7.2, 1}, {7, 2}}], LineBox[{{7, 2}, {7.2, 1}, {7, 0}}]}}}]], "Output", CellChangeTimes->{ 3.4507123989699593`*^9, {3.450712443169338*^9, 3.4507124684888783`*^9}, 3.450712603201187*^9, {3.4507126419884644`*^9, 3.4507126524234447`*^9}, { 3.450712745601033*^9, 3.450712771147827*^9}, {3.450712806682022*^9, 3.4507128515835257`*^9}, {3.45071290599522*^9, 3.450712943719308*^9}, 3.450713085889349*^9, 3.450713124940468*^9, 3.45087722582187*^9, 3.4508883203325653`*^9, 3.462499230371113*^9, 3.46249988096916*^9, 3.462499934446487*^9, 3.462500020483529*^9}] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DisplayBigraph", "[", "HaagerupAsaedaWithDuals", "]"}]], "Input", CellChangeTimes->{{3.450712926561028*^9, 3.450712935189291*^9}, 3.462500011679728*^9}], Cell[BoxData[ GraphicsBox[{{{PointBox[{1, 1}], PointBox[{2, 1}], PointBox[{3, 1}], PointBox[{4, 1}], PointBox[{5, 1}], PointBox[{6, 1}], {PointBox[{7, 0}], PointBox[{7, 2}]}, { PointBox[{8, 0}], PointBox[{8, 2}]}, {PointBox[{9, -1}], PointBox[{9, 1}], PointBox[{9, 3}]}, PointBox[{10, 1}], PointBox[{11, 1}]}, {LineBox[{{1, 1}, {2, 1}}], LineBox[{{2, 1}, {3, 1}}], LineBox[{{3, 1}, {4, 1}}], LineBox[{{4, 1}, {5, 1}}], LineBox[{{5, 1}, {6, 1}}], {LineBox[{{6, 1}, {7, 0}}], LineBox[{{6, 1}, {7, 2}}]}, {{LineBox[{{7, 0}, {8, 0}}], {}}, {{}, LineBox[{{7, 2}, {8, 2}}]}}, {{ LineBox[{{8, 0}, {9, -1}}], {}, {}}, {{}, LineBox[{{8, 2}, {9, 1}}], LineBox[{{8, 2}, {9, 3}}]}}, {LineBox[{{9, -1}, {10, 1}}], {}, {}}, LineBox[{{10, 1}, {11, 1}}]}, {{}, {}, {}, {}, {}, {{}, {}}, {{{}, {}}, {{}, {}}}, {{{}, {}, \ {}}, {{}, {}, {}}}, {{}, {}, {}}, {}}}, {RGBColor[1, 0, 0], LineBox[{{1, 1}, {1, 1.5}}], {}, LineBox[{{3, 1}, {3, 1.5}}], {}, LineBox[{{5, 1}, {5, 1.5}}], {}, {LineBox[{{7, 0}, {7, 0.5}}], LineBox[{{7, 2}, {7, 2.5}}]}, {{}, {}}, { LineBox[{{9, -1}, {9.2, 0}, {9, 1}}], LineBox[{{9, 1}, {9.2, 0}, {9, -1}}], LineBox[{{9, 3}, {9, 3.5}}]}, {}, LineBox[{{11, 1}, {11, 1.5}}]}}]], "Output", CellChangeTimes->{{3.450712935999394*^9, 3.4507129453002996`*^9}, 3.450713127288024*^9, 3.4624992304281*^9, 3.462499892239387*^9, 3.462500022059428*^9}] }, Open ]] }, WindowSize->{640, 652}, WindowMargins->{{28, Automatic}, {36, Automatic}}, FrontEndVersion->"7.0 for Mac OS X x86 (32-bit) (February 18, 2009)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[545, 20, 992, 22, 58, "Input"], Cell[1540, 44, 4025, 96, 223, "Input"], Cell[CellGroupData[{ Cell[5590, 144, 173, 3, 27, "Input"], Cell[5766, 149, 1426, 21, 145, "Output"] }, Open ]], Cell[7207, 173, 699, 17, 58, "Input"], Cell[7909, 192, 4387, 94, 253, "Input"], Cell[CellGroupData[{ Cell[12321, 290, 251, 4, 27, "Input"], Cell[12575, 296, 1405, 24, 169, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[14017, 325, 181, 3, 27, "Input"], Cell[14201, 330, 1481, 26, 185, "Output"] }, Open ]] } ] *) (* End of internal cache information *)