(* Content-type: application/vnd.wolfram.mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 10.4' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 158, 7] NotebookDataLength[ 68158, 1663] NotebookOptionsPosition[ 66693, 1607] NotebookOutlinePosition[ 67037, 1622] CellTagsIndexPosition[ 66994, 1619] WindowFrame->Normal*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell["Domino and Tromino Tilings", "Title", CellChangeTimes->{{3.776600831050974*^9, 3.7766008318453026`*^9}, { 3.776603732985325*^9, 3.7766037370460243`*^9}}], Cell["Adam Rumpf, 10/16/2017", "Text", CellChangeTimes->{{3.7766008347881403`*^9, 3.776600838290375*^9}, { 3.7766037429321527`*^9, 3.7766037447040315`*^9}}], Cell[CellGroupData[{ Cell["Introduction", "Section", CellChangeTimes->{{3.7766008459498987`*^9, 3.776600848547045*^9}}], Cell[TextData[{ "If a single square is removed from a ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", "n"], "\[Times]", SuperscriptBox["2", "n"]}], TraditionalForm]], "InlineMath"], " chess board, then it is always possible to tile the remaining squares \ using L-shaped trominos. Likewise, if two opposite-colored squares are \ removed, then it is always possible to tile the remaining squares using \ standard dominos. This program generates tromino and domino tilings for chess \ boards of various sizes, with controls to select the type of tile used, the \ size of the board, and the location(s) of the blank square(s)." }], "Text", CellChangeTimes->{{3.776600856235587*^9, 3.776600860481224*^9}, 3.7766038551799235`*^9, {3.776603893760318*^9, 3.776603911709834*^9}}], Cell[TextData[{ "The tromino tiling algorithm is recursive, and is based on the inductive \ proof of the existence of the tiling. Given a ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", "n"], "\[Times]", SuperscriptBox["2", "n"]}], TraditionalForm]], "InlineMath"], " board missing one square, we can divide it into four ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", RowBox[{"n", "-", "1"}]], "\[Times]", SuperscriptBox["2", RowBox[{"n", "-", "1"}]]}], TraditionalForm]], "InlineMath"], " boards, exactly one of which is missing a square. From the remaining three \ we remove the corner at the center of the board. This results in four ", Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", RowBox[{"n", "-", "1"}]], "\[Times]", SuperscriptBox["2", RowBox[{"n", "-", "1"}]]}], TraditionalForm]], "InlineMath"], " boards, each missing a square. Three of these missing squares are located \ at the center of the board, and can easily be tiled by a single L-shaped \ tromino. To tile the rest of the sub-boards, we recursively apply the process \ until reaching the base case of a ", Cell[BoxData[ FormBox[ RowBox[{"2", "\[Times]", "2"}], TraditionalForm]], "InlineMath"], " board missing a square, which can obviously be tiled by a single L-shaped \ tromino." }], "Text", CellChangeTimes->{ 3.776603876939519*^9, {3.776603918715714*^9, 3.776603955197132*^9}}], Cell["\<\ The domino tiling algorithm is also based on the proof of the existence of \ the tiling. We begin by finding a Hamiltonian cycle on the original board. \ Removing two squares cuts this cycle into one or two paths. The tiling can be \ generated by laying down dominos in line with the path(s). Note that it is \ only possible to complete this domino tiling if the removed squares are \ opposite colors. This is because each domino must cover one black square and \ one white square, so any tileable board must have the same number of each \ color square.\ \>", "Text", CellChangeTimes->{ 3.776603884010332*^9, {3.7766039692203283`*^9, 3.776603971719529*^9}}] }, Open ]], Cell[CellGroupData[{ Cell["Code", "Section", CellChangeTimes->{{3.776600864408964*^9, 3.7766008650447807`*^9}}], Cell[CellGroupData[{ Cell["Initialization", "Subsection", CellChangeTimes->{{3.776600871130811*^9, 3.776600873087188*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{"Given", " ", "n", " ", "and", " ", "a", " ", "coordinate"}], ",", " ", RowBox[{ RowBox[{ "find", " ", "a", " ", "tiling", " ", "of", " ", "the", " ", "remaining", " ", "grid", " ", "using", " ", "L"}], "-", RowBox[{"shaped", " ", RowBox[{"triominoes", ".", " ", "The"}], " ", "output", " ", "is", " ", "an", " ", "array", " ", "of", " ", "real", " ", "numbers"}]}], ",", " ", RowBox[{ "where", " ", "cells", " ", "with", " ", "the", " ", "same", " ", "real", " ", "number", " ", "correspond", " ", "to", " ", "the", " ", "same", " ", "triomino"}], ",", " ", RowBox[{ "and", " ", "the", " ", "cell", " ", "with", " ", "a", " ", "value", " ", "of", " ", "0", " ", "represents", " ", "the", " ", RowBox[{"blank", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"tmat", "[", RowBox[{"n_", ",", RowBox[{"p_:", RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}]}]}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"pos", "=", RowBox[{"Round", "[", "p", "]"}]}], ",", RowBox[{"grid", "=", RowBox[{"ConstantArray", "[", RowBox[{"1", ",", RowBox[{"{", RowBox[{ SuperscriptBox["2", "n"], ",", SuperscriptBox["2", "n"]}], "}"}]}], "]"}]}], ",", RowBox[{"squares", "=", RowBox[{"{", "}"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"Setting", " ", "up", " ", "the", " ", RowBox[{"grid", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Min", "[", "pos", "]"}], "<", "1"}], "||", RowBox[{ RowBox[{"Max", "[", "pos", "]"}], ">", SuperscriptBox["2", "n"]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"pos", "=", RowBox[{"RandomInteger", "[", RowBox[{ RowBox[{"{", RowBox[{"1", ",", SuperscriptBox["2", "n"]}], "}"}], ",", "2"}], "]"}]}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"grid", "[", RowBox[{"[", RowBox[{ RowBox[{"pos", "[", RowBox[{"[", "1", "]"}], "]"}], ",", RowBox[{"pos", "[", RowBox[{"[", "2", "]"}], "]"}]}], "]"}], "]"}], "=", "0"}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ "Call", " ", "the", " ", "recursive", " ", "subroutine", " ", "tsub", " ", "to", " ", "come", " ", "up", " ", "with", " ", "the", " ", RowBox[{"colors", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"grid", "=", RowBox[{"tsub", "[", "grid", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"Draw", " ", "the", " ", RowBox[{"result", "."}]}], " ", "*)"}], "\[IndentingNewLine]", "grid"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.6185142070757103`*^9, 3.6185142085437946`*^9}, { 3.6185142643839884`*^9, 3.618514338419223*^9}, {3.6185143703930516`*^9, 3.6185145226347594`*^9}, {3.618514554380575*^9, 3.618514580551072*^9}, { 3.6185146129789267`*^9, 3.6185146536922555`*^9}, {3.6185147301676297`*^9, 3.618514964558036*^9}, {3.618514996918887*^9, 3.618515162957384*^9}, { 3.618515243151971*^9, 3.6185152993261833`*^9}, {3.618515331187006*^9, 3.6185153686151466`*^9}, {3.618515478795449*^9, 3.61851562339872*^9}, { 3.618515686674339*^9, 3.618515692742686*^9}, {3.61851573390704*^9, 3.618515736052163*^9}, {3.618515794080482*^9, 3.618515801130885*^9}, { 3.6185159289031935`*^9, 3.618516089028352*^9}, {3.6185161342819405`*^9, 3.6185161969055223`*^9}, {3.618516229929411*^9, 3.6185162395539618`*^9}, { 3.6185162884517584`*^9, 3.618516329866127*^9}, {3.6185164299888535`*^9, 3.618516466999971*^9}, {3.6185165913120813`*^9, 3.618516599230534*^9}, { 3.618516661012068*^9, 3.6185166906487627`*^9}, {3.6185167283309183`*^9, 3.6185168026051664`*^9}, {3.6185170258139334`*^9, 3.618517055561634*^9}, { 3.618517098684101*^9, 3.6185173251740556`*^9}, {3.6185173771390276`*^9, 3.618517401253407*^9}, {3.6185175113677053`*^9, 3.6185176290414357`*^9}, { 3.6185176662305627`*^9, 3.6185177126492176`*^9}, {3.6185177560427*^9, 3.6185178206603956`*^9}, {3.6185178519501853`*^9, 3.6185178555753927`*^9}, {3.618517938962162*^9, 3.618517988741009*^9}, { 3.618518023871019*^9, 3.6185180802392426`*^9}, {3.618518126994917*^9, 3.6185181706584144`*^9}, {3.618518273474295*^9, 3.6185184199966755`*^9}, { 3.618518550999169*^9, 3.6185185714863405`*^9}, {3.6185186684718876`*^9, 3.6185186701519837`*^9}, {3.618518702670844*^9, 3.6185187133864565`*^9}, { 3.6185187867096505`*^9, 3.618518821897663*^9}, {3.6185348495143905`*^9, 3.6185348501984296`*^9}, {3.618534890645743*^9, 3.6185349270758266`*^9}, { 3.6185349899104204`*^9, 3.6185350103405895`*^9}, {3.6185350714280834`*^9, 3.6185350802055855`*^9}, {3.618535115019576*^9, 3.6185352390986733`*^9}, { 3.6185352771008472`*^9, 3.618535393663514*^9}, {3.618535444139401*^9, 3.618535482493595*^9}, {3.6185355189976826`*^9, 3.6185355640242577`*^9}, { 3.618535602400453*^9, 3.6185356170412903`*^9}, 3.717120410370682*^9, { 3.717120454772726*^9, 3.717120477602621*^9}, {3.717120640541622*^9, 3.717120670959137*^9}, {3.717120712320592*^9, 3.717120806628689*^9}, { 3.717120891826638*^9, 3.717120908214367*^9}, 3.7171209769024506`*^9, { 3.7184603882401*^9, 3.7184604399348516`*^9}, 3.7184621576499567`*^9, { 3.71846228643172*^9, 3.718462291358412*^9}}, CellID->186327850], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Recursive", " ", "subroutine", " ", "for", " ", "the", " ", "triomino", " ", "tiling", " ", RowBox[{"algorithm", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"tsub", "[", "m_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"mat", "=", "m"}], ",", RowBox[{"s", "=", RowBox[{"Length", "[", "m", "]"}]}], ",", "tl", ",", "tr", ",", "bl", ",", "br", ",", RowBox[{"num", "=", RowBox[{"RandomReal", "[", "]"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ RowBox[{ "If", " ", "we", " ", "have", " ", "a", " ", "2", "x2", " ", "grid"}], ",", " ", RowBox[{"recolor", " ", RowBox[{"it", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"s", "\[LessEqual]", "2"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"For", "[", RowBox[{ RowBox[{"i", "=", "1"}], ",", RowBox[{"i", "\[LessEqual]", "2"}], ",", RowBox[{"i", "++"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"For", "[", RowBox[{ RowBox[{"j", "=", "1"}], ",", RowBox[{"j", "\[LessEqual]", "2"}], ",", RowBox[{"j", "++"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{"i", ",", "j"}], "]"}], "]"}], "\[Equal]", "1"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{"i", ",", "j"}], "]"}], "]"}], "=", "num"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";"}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"Otherwise", ",", " ", RowBox[{"begin", " ", "by", " ", "quartering", " ", "the", " ", RowBox[{"grid", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"tl", "=", RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"1", ";;", FractionBox["s", "2"]}], ",", RowBox[{"1", ";;", FractionBox["s", "2"]}]}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"tr", "=", RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"1", ";;", FractionBox["s", "2"]}], ",", RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}]}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"bl", "=", RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}], ",", RowBox[{"1", ";;", FractionBox["s", "2"]}]}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"br", "=", RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}], ",", RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}]}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ RowBox[{ "Find", " ", "where", " ", "the", " ", "single", " ", "colored", " ", "square", " ", "is"}], ",", " ", RowBox[{ "and", " ", "color", " ", "the", " ", "other", " ", "three", " ", RowBox[{"centers", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Count", "[", RowBox[{ RowBox[{"Flatten", "[", "tl", "]"}], ",", "1"}], "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"(", FractionBox["s", "2"], ")"}], "2"]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"tl", "[", RowBox[{"[", RowBox[{ FractionBox["s", "2"], ",", FractionBox["s", "2"]}], "]"}], "]"}], "=", "num"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Count", "[", RowBox[{ RowBox[{"Flatten", "[", "tr", "]"}], ",", "1"}], "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"(", FractionBox["s", "2"], ")"}], "2"]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"tr", "[", RowBox[{"[", RowBox[{ FractionBox["s", "2"], ",", "1"}], "]"}], "]"}], "=", "num"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Count", "[", RowBox[{ RowBox[{"Flatten", "[", "bl", "]"}], ",", "1"}], "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"(", FractionBox["s", "2"], ")"}], "2"]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"bl", "[", RowBox[{"[", RowBox[{"1", ",", FractionBox["s", "2"]}], "]"}], "]"}], "=", "num"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Count", "[", RowBox[{ RowBox[{"Flatten", "[", "br", "]"}], ",", "1"}], "]"}], "\[Equal]", SuperscriptBox[ RowBox[{"(", FractionBox["s", "2"], ")"}], "2"]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"br", "[", RowBox[{"[", RowBox[{"1", ",", "1"}], "]"}], "]"}], "=", "num"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ "Color", " ", "the", " ", "rest", " ", "of", " ", "the", " ", "squares", " ", "by", " ", "going", " ", "through", " ", "the", " ", "same", " ", RowBox[{"process", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"tl", "=", RowBox[{"tsub", "[", "tl", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"tr", "=", RowBox[{"tsub", "[", "tr", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"bl", "=", RowBox[{"tsub", "[", "bl", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"br", "=", RowBox[{"tsub", "[", "br", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"Reassemble", " ", "the", " ", "main", " ", RowBox[{"grid", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"1", ";;", FractionBox["s", "2"]}], ",", RowBox[{"1", ";;", FractionBox["s", "2"]}]}], "]"}], "]"}], "=", "tl"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"1", ";;", FractionBox["s", "2"]}], ",", RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}]}], "]"}], "]"}], "=", "tr"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}], ",", RowBox[{"1", ";;", FractionBox["s", "2"]}]}], "]"}], "]"}], "=", "bl"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}], ",", RowBox[{ RowBox[{ FractionBox["s", "2"], "+", "1"}], ";;", "s"}]}], "]"}], "]"}], "=", "br"}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", "mat"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.618534539115637*^9, 3.6185346405024357`*^9}, { 3.618534712693565*^9, 3.6185347134176064`*^9}, {3.618534745924465*^9, 3.618534767944725*^9}, {3.717120568832734*^9, 3.7171205918841743`*^9}, { 3.717120624922908*^9, 3.717120642431926*^9}, {3.7171208112275486`*^9, 3.7171208669737253`*^9}, {3.7171209348401384`*^9, 3.7171209593453803`*^9}, 3.718460502800016*^9, 3.718462294532206*^9}, CellID->831793641], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ "Paint", " ", "the", " ", "regions", " ", "deterministically", " ", "by", " ", "first", " ", "finding", " ", "the", " ", "centroids", " ", "of", " ", "all", " ", "regions", " ", "and", " ", "using", " ", "the", " ", "centroids", " ", "as", " ", "random", " ", RowBox[{"seeds", "."}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"Dynamic", "[", "pal", "]"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"pal", "=", "1"}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"cpainter", "[", RowBox[{"mat_", ",", "pal_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"list", ",", "temp", ",", "c", ",", "s"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"list", "=", RowBox[{"DeleteCases", "[", RowBox[{ RowBox[{"DeleteDuplicates", "[", RowBox[{"Flatten", "[", "mat", "]"}], "]"}], ",", "0"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"temp", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Position", "[", RowBox[{"mat", ",", RowBox[{"list", "[", RowBox[{"[", "i", "]"}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "list", "]"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"c", "=", RowBox[{"ConstantArray", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", RowBox[{"Length", "[", "temp", "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"c", "[", RowBox[{"[", "i", "]"}], "]"}], "=", RowBox[{"{", RowBox[{ FractionBox[ RowBox[{ RowBox[{"Max", "[", RowBox[{"temp", "[", RowBox[{"[", RowBox[{"i", ",", ";;", ",", "1"}], "]"}], "]"}], "]"}], "+", RowBox[{"Min", "[", RowBox[{"temp", "[", RowBox[{"[", RowBox[{"i", ",", ";;", ",", "1"}], "]"}], "]"}], "]"}]}], "2"], ",", FractionBox[ RowBox[{ RowBox[{"Max", "[", RowBox[{"temp", "[", RowBox[{"[", RowBox[{"i", ",", ";;", ",", "2"}], "]"}], "]"}], "]"}], "+", RowBox[{"Min", "[", RowBox[{"temp", "[", RowBox[{"[", RowBox[{"i", ",", ";;", ",", "2"}], "]"}], "]"}], "]"}]}], "2"]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "c", "]"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"s", "=", RowBox[{"ConstantArray", "[", RowBox[{"\"\<\>\"", ",", RowBox[{"Length", "[", "c", "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"SeedRandom", "[", RowBox[{"Ceiling", "[", RowBox[{"30", RowBox[{"(", RowBox[{ RowBox[{"c", "[", RowBox[{"[", RowBox[{"i", ",", "1"}], "]"}], "]"}], "+", RowBox[{"pal", " ", RowBox[{"Length", "[", "mat", "]"}], RowBox[{"c", "[", RowBox[{"[", RowBox[{"i", ",", "2"}], "]"}], "]"}]}]}], ")"}]}], "]"}], "]"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"s", "[", RowBox[{"[", "i", "]"}], "]"}], "=", RowBox[{"RandomReal", "[", RowBox[{"1", ",", "3"}], "]"}]}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "c", "]"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"ArrayPlot", "[", RowBox[{"mat", ",", RowBox[{"ColorRules", "\[Rule]", RowBox[{"Join", "[", RowBox[{ RowBox[{"{", RowBox[{"0", "\[Rule]", "White"}], "}"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"list", "[", RowBox[{"[", "i", "]"}], "]"}], "\[Rule]", RowBox[{"RGBColor", "@@", RowBox[{"s", "[", RowBox[{"[", "i", "]"}], "]"}]}]}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "list", "]"}]}], "}"}]}], "]"}]}], "]"}]}]}], "]"}]}]}], "\[IndentingNewLine]", "]"}]}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.7171222953749113`*^9, 3.7171223438686*^9}, { 3.717122380467951*^9, 3.717122418654686*^9}, {3.7171224667948046`*^9, 3.7171224729573665`*^9}, {3.717122521964258*^9, 3.717122551142415*^9}, { 3.7171226741537795`*^9, 3.7171227941573257`*^9}, {3.7171228349307413`*^9, 3.717123000506459*^9}, {3.717123036749447*^9, 3.717123123248371*^9}, { 3.7171286930097675`*^9, 3.717128815693149*^9}, {3.717128848045336*^9, 3.717128911706232*^9}, 3.7171291950007005`*^9, {3.717129318303735*^9, 3.7171293455401278`*^9}, {3.7171299314295044`*^9, 3.7171299574449167`*^9}, 3.717168981589218*^9, {3.7171729021600504`*^9, 3.7171729375439153`*^9}, { 3.7171757824684515`*^9, 3.7171757990744143`*^9}, {3.717175829653081*^9, 3.7171758298475704`*^9}, {3.717176100094463*^9, 3.717176104312569*^9}, { 3.717176135265507*^9, 3.7171761598382597`*^9}, {3.718460481290072*^9, 3.718460526525556*^9}, {3.718461422244679*^9, 3.718461425618636*^9}, { 3.71846145975249*^9, 3.718461460707569*^9}, 3.718461607266644*^9, { 3.7766041628312674`*^9, 3.7766041652755804`*^9}}, CellID->948736883], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{"Given", " ", "n"}], ",", " ", RowBox[{ "generate", " ", "a", " ", "Hamiltonian", " ", "cycle", " ", "on", " ", "a", " ", Cell[TextData[Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", "n"], "\[Times]", SuperscriptBox["2", "n"]}], TraditionalForm]]]]], " ", "grid", " ", "and", " ", "output", " ", "the", " ", "resulting", " ", RowBox[{"graph", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"cyclegraph", "[", "n_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"e", "=", RowBox[{"{", "}"}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "1"}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{ RowBox[{"i", "+", "1"}], ",", "1"}], "}"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "1"}]}], "}"}]}], "]"}]}], "]"}]}], ";", RowBox[{"(*", " ", RowBox[{"left", " ", "side"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ SuperscriptBox["2", "n"], ",", "j"}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{ SuperscriptBox["2", "n"], ",", RowBox[{"j", "+", "1"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "1"}]}], "}"}]}], "]"}]}], "]"}]}], ";", RowBox[{"(*", " ", "bottom", " ", "*)"}], "\[IndentingNewLine]", RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", SuperscriptBox["2", "n"]}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{ RowBox[{"i", "-", "1"}], ",", SuperscriptBox["2", "n"]}], "}"}]}], ",", RowBox[{"{", RowBox[{"i", ",", SuperscriptBox["2", "n"], ",", "2", ",", RowBox[{"-", "1"}]}], "}"}]}], "]"}]}], "]"}]}], ";", RowBox[{"(*", " ", RowBox[{"right", " ", "side"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"vertical", " ", "bars"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"i", ",", "j"}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{ RowBox[{"i", "+", "1"}], ",", "j"}], "}"}]}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "2"}]}], "}"}]}], "]"}]}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"j", ",", "2", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "1"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"1", ",", "j"}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{"1", ",", RowBox[{"j", "+", "1"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "1"}], ",", "2"}], "}"}]}], "]"}]}], "]"}]}], ";", RowBox[{"(*", " ", RowBox[{"top", " ", "horizontal", " ", "links"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"e", "=", RowBox[{"Join", "[", RowBox[{"e", ",", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["2", "n"], "-", "1"}], ",", "j"}], "}"}], "\[UndirectedEdge]", RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["2", "n"], "-", "1"}], ",", RowBox[{"j", "+", "1"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{"j", ",", "2", ",", RowBox[{ SuperscriptBox["2", "n"], "-", "2"}], ",", "2"}], "}"}]}], "]"}]}], "]"}]}], ";", RowBox[{"(*", " ", RowBox[{"bottom", " ", "horizontal", " ", "links"}], " ", "*)"}], "\[IndentingNewLine]", "e"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.717118961847698*^9, 3.7171191065681973`*^9}, { 3.717119188174086*^9, 3.7171192710939846`*^9}, {3.7171193052666883`*^9, 3.7171196754883127`*^9}, {3.717119727942465*^9, 3.7171199276824074`*^9}, { 3.7171199767865562`*^9, 3.717119983573266*^9}, {3.71846054681534*^9, 3.718460551096431*^9}}, CellID->88583857], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{"Given", " ", "a", " ", "graph"}], ",", " ", RowBox[{"return", " ", "the", " ", "names", " ", "of", " ", "the", " ", RowBox[{"leaves", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"findleaves", "[", "g_", "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"v", ",", RowBox[{"leaf", "=", RowBox[{"{", "}"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"v", "=", RowBox[{"VertexList", "[", "g", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"VertexDegree", "[", RowBox[{"g", ",", RowBox[{"v", "[", RowBox[{"[", "i", "]"}], "]"}]}], "]"}], "\[Equal]", "1"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"leaf", "=", RowBox[{"Append", "[", RowBox[{"leaf", ",", RowBox[{"v", "[", RowBox[{"[", "i", "]"}], "]"}]}], "]"}]}], ";"}]}], "\[IndentingNewLine]", "]"}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "v", "]"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", "leaf"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.71716605906036*^9, 3.7171660909914756`*^9}, { 3.7171661289557147`*^9, 3.717166136130888*^9}, {3.717166167889346*^9, 3.7171662101464777`*^9}, {3.7171662490604196`*^9, 3.717166318745971*^9}, 3.71846057224549*^9}, CellID->724788800], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{ "Given", " ", "a", " ", "graph", " ", "and", " ", "a", " ", "starting", " ", "vertex"}], ",", " ", RowBox[{"perform", " ", "a", " ", "DFS"}], ",", " ", RowBox[{ "and", " ", "return", " ", "a", " ", "list", " ", "of", " ", "the", " ", "vertices", " ", "visited", " ", "in", " ", RowBox[{"order", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"dfs", "[", RowBox[{"g_", ",", "s_"}], "]"}], ":=", RowBox[{ RowBox[{"Reap", "[", RowBox[{"DepthFirstScan", "[", RowBox[{"g", ",", "s", ",", RowBox[{"{", RowBox[{"\"\\"", "\[Rule]", "Sow"}], "}"}]}], "]"}], "]"}], "[", RowBox[{"[", RowBox[{"2", ",", "1"}], "]"}], "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.718460583719769*^9, 3.7184605858346987`*^9}}, CellID->20493368], Cell[BoxData[ RowBox[{ RowBox[{"(*", " ", RowBox[{ RowBox[{"Given", " ", "n"}], ",", " ", RowBox[{ "and", " ", "the", " ", "coordinates", " ", "of", " ", "two", " ", "vertices", " ", "to", " ", "delete"}], ",", " ", RowBox[{"generate", " ", "a", " ", Cell[TextData[Cell[BoxData[ FormBox[ RowBox[{ SuperscriptBox["2", "n"], "\[Times]", SuperscriptBox["2", "n"]}], TraditionalForm]]]]], " ", "array", " ", "of", " ", "real", " ", "numbers"}], ",", " ", RowBox[{ "where", " ", "entries", " ", "with", " ", "the", " ", "same", " ", "value", " ", "correspond", " ", "to", " ", "the", " ", "same", " ", RowBox[{"domino", "."}]}]}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"dmat", "[", RowBox[{"n_", ",", RowBox[{"p1_:", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}]}], ",", RowBox[{"p2_:", RowBox[{"{", RowBox[{"1", ",", "2"}], "}"}]}]}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"g", ",", "gc", ",", "cc", ",", "start", ",", "chain", ",", RowBox[{"mat", "=", RowBox[{"ConstantArray", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{ SuperscriptBox["2", "n"], ",", SuperscriptBox["2", "n"]}], "}"}]}], "]"}]}]}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"g", "=", RowBox[{"VertexDelete", "[", RowBox[{ RowBox[{"Graph", "[", RowBox[{"cyclegraph", "[", "n", "]"}], "]"}], ",", RowBox[{"{", RowBox[{"p1", ",", "p2"}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"cc", "=", RowBox[{"ConnectedComponents", "[", "g", "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"gc", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Subgraph", "[", RowBox[{"g", ",", RowBox[{"cc", "[", RowBox[{"[", "k", "]"}], "]"}]}], "]"}], ",", RowBox[{"{", RowBox[{"k", ",", "1", ",", RowBox[{"Length", "[", "cc", "]"}]}], "}"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{"Length", "[", "gc", "]"}], "\[Equal]", "2"}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"two", " ", "separate", " ", "chains"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{"start", "=", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"findleaves", "[", RowBox[{"gc", "[", RowBox[{"[", "1", "]"}], "]"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], ",", RowBox[{ RowBox[{"findleaves", "[", RowBox[{"gc", "[", RowBox[{"[", "2", "]"}], "]"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{"one", " ", "chain"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"start", "=", RowBox[{"{", RowBox[{ RowBox[{"findleaves", "[", RowBox[{"gc", "[", RowBox[{"[", "1", "]"}], "]"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}], "}"}]}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{"(*", " ", RowBox[{ "assign", " ", "random", " ", "numbers", " ", "to", " ", "pairs", " ", "of", " ", "consecutive", " ", "vertices", " ", "in", " ", "each", " ", "chain"}], " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"chain", "=", RowBox[{"dfs", "[", RowBox[{ RowBox[{"gc", "[", RowBox[{"[", "i", "]"}], "]"}], ",", RowBox[{"start", "[", RowBox[{"[", "i", "]"}], "]"}]}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"Do", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"(", RowBox[{"chain", "[", RowBox[{"[", RowBox[{"j", ",", "1"}], "]"}], "]"}], ")"}], ",", RowBox[{"(", RowBox[{"chain", "[", RowBox[{"[", RowBox[{"j", ",", "2"}], "]"}], "]"}], ")"}]}], "]"}], "]"}], "=", RowBox[{ RowBox[{"mat", "[", RowBox[{"[", RowBox[{ RowBox[{"(", RowBox[{"chain", "[", RowBox[{"[", RowBox[{ RowBox[{"j", "+", "1"}], ",", "1"}], "]"}], "]"}], ")"}], ",", RowBox[{"(", RowBox[{"chain", "[", RowBox[{"[", RowBox[{ RowBox[{"j", "+", "1"}], ",", "2"}], "]"}], "]"}], ")"}]}], "]"}], "]"}], "=", RowBox[{"RandomReal", "[", "]"}]}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{ RowBox[{"Length", "[", "chain", "]"}], "-", "1"}], ",", "2"}], "}"}]}], "]"}]}], ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{"i", ",", "1", ",", RowBox[{"Length", "[", "start", "]"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", "mat"}]}], "\[IndentingNewLine]", "]"}]}]}]], "Input", InitializationCell->True, CellChangeTimes->{{3.717120278662059*^9, 3.7171203156808863`*^9}, { 3.71712326410678*^9, 3.7171234255520506`*^9}, {3.7171237305673046`*^9, 3.7171237578014803`*^9}, {3.717124689898405*^9, 3.717124719356659*^9}, { 3.7171660246045523`*^9, 3.717166049775727*^9}, {3.7171663639855337`*^9, 3.7171664134929075`*^9}, {3.717166450921838*^9, 3.7171664911664762`*^9}, { 3.7171665554625397`*^9, 3.7171665583257895`*^9}, {3.717167220938902*^9, 3.717167282457119*^9}, {3.7171673124744816`*^9, 3.7171673425184455`*^9}, { 3.7171673811899805`*^9, 3.71716756415689*^9}, {3.717167631526585*^9, 3.717167655223211*^9}, {3.717167695203794*^9, 3.717167722604334*^9}, { 3.7171677737971087`*^9, 3.717167805256285*^9}, 3.718460596050982*^9, 3.7191009600794764`*^9, {3.7191014140742865`*^9, 3.719101425289412*^9}, { 3.7191014630623913`*^9, 3.719101506187969*^9}, {3.719101536966412*^9, 3.719101546317435*^9}, {3.719101737917748*^9, 3.7191017703347607`*^9}}, CellID->304082261] }, Closed]], Cell[CellGroupData[{ Cell["Demonstration", "Subsection", CellChangeTimes->{{3.7766008885632277`*^9, 3.7766008904796133`*^9}}], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"pt1", ",", "pt2", ",", "mat", ",", "black", ",", "white"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"black", "=", RowBox[{"Flatten", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{"i", ",", RowBox[{ RowBox[{"2", "j"}], "-", RowBox[{"Mod", "[", RowBox[{ RowBox[{"i", "+", "1"}], ",", "2"}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{"n", "/", "2"}]}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "n"}], "}"}]}], "]"}], ",", "1"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"white", "=", RowBox[{"Flatten", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{"i", ",", RowBox[{ RowBox[{"2", "j"}], "-", RowBox[{"Mod", "[", RowBox[{"i", ",", "2"}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"j", ",", "1", ",", RowBox[{"n", "/", "2"}]}], "}"}], ",", RowBox[{"{", RowBox[{"i", ",", "1", ",", "n"}], "}"}]}], "]"}], ",", "1"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"If", "[", RowBox[{ RowBox[{"type", "\[Equal]", "3"}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", "triominoes", " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"pt1", "=", RowBox[{"{", RowBox[{ RowBox[{"Min", "[", RowBox[{ RowBox[{"Floor", "[", RowBox[{"x1", "[", RowBox[{"[", "1", "]"}], "]"}], "]"}], ",", "n"}], "]"}], ",", RowBox[{"Min", "[", RowBox[{ RowBox[{"Floor", "[", RowBox[{"x1", "[", RowBox[{"[", "2", "]"}], "]"}], "]"}], ",", "n"}], "]"}]}], "}"}]}], ";", "\[IndentingNewLine]", RowBox[{"mat", "=", RowBox[{"Reverse", "[", RowBox[{"Transpose", "[", RowBox[{"tmat", "[", RowBox[{ RowBox[{"Log", "[", RowBox[{"2", ",", "n"}], "]"}], ",", "pt1"}], "]"}], "]"}], "]"}]}]}], ",", "\[IndentingNewLine]", RowBox[{"(*", " ", "dominoes", " ", "*)"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"pt1", "=", RowBox[{ RowBox[{"Nearest", "[", RowBox[{"black", ",", "x1"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"pt2", "=", RowBox[{ RowBox[{"Nearest", "[", RowBox[{"white", ",", "x2"}], "]"}], "[", RowBox[{"[", "1", "]"}], "]"}]}], ";", "\[IndentingNewLine]", RowBox[{"mat", "=", RowBox[{"Reverse", "[", RowBox[{"Transpose", "[", RowBox[{"dmat", "[", RowBox[{ RowBox[{"Log", "[", RowBox[{"2", ",", "n"}], "]"}], ",", "pt1", ",", "pt2"}], "]"}], "]"}], "]"}]}], ";"}]}], "\[IndentingNewLine]", "]"}], ";", "\[IndentingNewLine]", RowBox[{"cpainter", "[", RowBox[{"mat", ",", "pal"}], "]"}]}]}], "\[IndentingNewLine]", "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"type", ",", "3", ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"3", "\[Rule]", "\"\\""}], ",", RowBox[{"2", "\[Rule]", "\"\\""}]}], "}"}], ",", "RadioButton"}], "}"}], ",", "\"\<\>\"", ",", "\[IndentingNewLine]", RowBox[{"PaneSelector", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"3", "\[Rule]", RowBox[{"Row", "[", RowBox[{"{", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x1", ",", RowBox[{"{", RowBox[{"1.5", ",", RowBox[{"n", "+", "0.5"}]}], "}"}], ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"n", "+", "1"}], ",", RowBox[{"n", "+", "1"}]}], "}"}]}], "}"}], "]"}], "}"}], "]"}]}], ",", RowBox[{"2", "\[Rule]", RowBox[{"Row", "[", RowBox[{"{", RowBox[{ RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x1", ",", RowBox[{"{", RowBox[{"1.5", ",", RowBox[{"n", "+", "0.5"}]}], "}"}], ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"n", "+", "1"}], ",", RowBox[{"n", "+", "1"}]}], "}"}]}], "}"}], "]"}], ",", "\"\<\>\"", ",", "\[IndentingNewLine]", RowBox[{"Control", "[", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"x2", ",", RowBox[{"{", RowBox[{"1.5", ",", RowBox[{"n", "+", "0.5"}]}], "}"}], ",", "\"\<\>\""}], "}"}], ",", RowBox[{"{", RowBox[{"1", ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"n", "+", "1"}], ",", RowBox[{"n", "+", "1"}]}], "}"}]}], "}"}], "]"}]}], "}"}], "]"}]}]}], "}"}], ",", RowBox[{"Dynamic", "[", "type", "]"}]}], "]"}], ",", "\"\<\>\"", ",", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"n", ",", SuperscriptBox["2", "3"], ",", "\"\\""}], "}"}], ",", RowBox[{"Table", "[", RowBox[{ SuperscriptBox["2", "k"], ",", RowBox[{"{", RowBox[{"k", ",", "1", ",", "5"}], "}"}]}], "]"}]}], "}"}], ",", "\"\<\>\"", ",", "\[IndentingNewLine]", RowBox[{"Button", "[", RowBox[{"\"\\"", ",", RowBox[{"pal", "=", RowBox[{"RandomInteger", "[", RowBox[{"{", RowBox[{"1", ",", "10000"}], "}"}], "]"}]}]}], "]"}], ",", RowBox[{"ControlPlacement", "\[Rule]", "Left"}], ",", RowBox[{"SaveDefinitions", "\[Rule]", "True"}], ",", RowBox[{"TrackedSymbols", "\[RuleDelayed]", RowBox[{"{", RowBox[{"type", ",", "x1", ",", "x2", ",", "n", ",", "pal"}], "}"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.7171721688879395`*^9, 3.7171721792125983`*^9}, { 3.717172698715872*^9, 3.7171727088142433`*^9}, 3.717172891914034*^9, { 3.7171759307875676`*^9, 3.717175966365285*^9}, {3.7171761797486963`*^9, 3.717176195531271*^9}, {3.718461319520712*^9, 3.718461366392865*^9}, { 3.718462169982263*^9, 3.718462176787395*^9}, {3.718462225073571*^9, 3.7184622354464073`*^9}}], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`n$$ = 8, $CellContext`type$$ = 2, $CellContext`x1$$ = {1, 9.}, $CellContext`x2$$ = {3.8000000000000003`, 4.7}, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`type$$], 3, "tile type"}, { 3 -> "triominoes", 2 -> "dominoes"}}, { Hold[""], Manipulate`Dump`ThisIsNotAControl}, {{ Hold[$CellContext`x1$$], {1.5, 0.5 + $CellContext`n$$}, "blanks"}, {1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}]}, {{ Hold[$CellContext`x1$$], {1.5, 0.5 + $CellContext`n$$}, "blanks"}, {1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}]}, {{ Hold[$CellContext`x2$$], {1.5, 0.5 + $CellContext`n$$}, ""}, {1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}]}, { Hold[ PaneSelector[{3 -> Row[{ Manipulate`Place[1]}], 2 -> Row[{ Manipulate`Place[2], "", Manipulate`Place[3]}]}, Dynamic[$CellContext`type$$]]], Manipulate`Dump`ThisIsNotAControl}, { Hold[""], Manipulate`Dump`ThisIsNotAControl}, {{ Hold[$CellContext`n$$], 8, "board width"}, {2, 4, 8, 16, 32}}, { Hold[""], Manipulate`Dump`ThisIsNotAControl}, { Hold[ Button[ "randomize colors", $CellContext`pal = RandomInteger[{1, 10000}]]], Manipulate`Dump`ThisIsNotAControl}}, Typeset`size$$ = { 345., {170., 174.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`type$1179$$ = False, $CellContext`x1$1180$$ = 0, $CellContext`x2$1181$$ = 0, $CellContext`n$1182$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 2, StandardForm, "Variables" :> {$CellContext`n$$ = 8, $CellContext`type$$ = 3, $CellContext`x1$$ = { 1.5, 0.5 + $CellContext`n$$}, $CellContext`x2$$ = { 1.5, 0.5 + $CellContext`n$$}}, "ControllerVariables" :> { Hold[$CellContext`type$$, $CellContext`type$1179$$, False], Hold[$CellContext`x1$$, $CellContext`x1$1180$$, 0], Hold[$CellContext`x2$$, $CellContext`x2$1181$$, 0], Hold[$CellContext`n$$, $CellContext`n$1182$$, 0]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> Module[{$CellContext`pt1$, $CellContext`pt2$, $CellContext`mat$, \ $CellContext`black$, $CellContext`white$}, $CellContext`black$ = Flatten[ Table[{$CellContext`i, 2 $CellContext`j - Mod[$CellContext`i + 1, 2]}, {$CellContext`j, 1, $CellContext`n$$/2}, {$CellContext`i, 1, $CellContext`n$$}], 1]; $CellContext`white$ = Flatten[ Table[{$CellContext`i, 2 $CellContext`j - Mod[$CellContext`i, 2]}, {$CellContext`j, 1, $CellContext`n$$/ 2}, {$CellContext`i, 1, $CellContext`n$$}], 1]; If[$CellContext`type$$ == 3, $CellContext`pt1$ = { Min[ Floor[ Part[$CellContext`x1$$, 1]], $CellContext`n$$], Min[ Floor[ Part[$CellContext`x1$$, 2]], $CellContext`n$$]}; $CellContext`mat$ = Reverse[ Transpose[ $CellContext`tmat[ Log[ 2, $CellContext`n$$], $CellContext`pt1$]]], $CellContext`pt1$ = Part[ Nearest[$CellContext`black$, $CellContext`x1$$], 1]; $CellContext`pt2$ = Part[ Nearest[$CellContext`white$, $CellContext`x2$$], 1]; $CellContext`mat$ = Reverse[ Transpose[ $CellContext`dmat[ Log[ 2, $CellContext`n$$], $CellContext`pt1$, $CellContext`pt2$]]]; Null]; $CellContext`cpainter[$CellContext`mat$, $CellContext`pal]], "Specifications" :> {{{$CellContext`type$$, 3, "tile type"}, { 3 -> "triominoes", 2 -> "dominoes"}, ControlType -> RadioButton}, "", {{$CellContext`x1$$, {1.5, 0.5 + $CellContext`n$$}, "blanks"}, {1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}], ControlPlacement -> 1}, {{$CellContext`x1$$, {1.5, 0.5 + $CellContext`n$$}, "blanks"}, { 1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}], ControlPlacement -> 2}, {{$CellContext`x2$$, {1.5, 0.5 + $CellContext`n$$}, ""}, {1, 1}, Dynamic[{$CellContext`n$$ + 1, $CellContext`n$$ + 1}], ControlPlacement -> 3}, PaneSelector[{3 -> Row[{ Manipulate`Place[1]}], 2 -> Row[{ Manipulate`Place[2], "", Manipulate`Place[3]}]}, Dynamic[$CellContext`type$$]], "", {{$CellContext`n$$, 8, "board width"}, {2, 4, 8, 16, 32}}, "", Button[ "randomize colors", $CellContext`pal = RandomInteger[{1, 10000}]]}, "Options" :> { ControlPlacement -> Left, TrackedSymbols :> {$CellContext`type$$, $CellContext`x1$$, \ $CellContext`x2$$, $CellContext`n$$, $CellContext`pal}}, "DefaultOptions" :> {}], ImageSizeCache->{616., {208., 214.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`i = 3, $CellContext`j = 3, $CellContext`tmat[ Pattern[$CellContext`n, Blank[]], Optional[ Pattern[$CellContext`p, Blank[]], {0, 0}]] := Module[{$CellContext`pos = Round[$CellContext`p], $CellContext`grid = ConstantArray[ 1, {2^$CellContext`n, 2^$CellContext`n}], $CellContext`squares = {}}, If[ Or[ Min[$CellContext`pos] < 1, Max[$CellContext`pos] > 2^$CellContext`n], $CellContext`pos = RandomInteger[{1, 2^$CellContext`n}, 2]; Null]; Part[$CellContext`grid, Part[$CellContext`pos, 1], Part[$CellContext`pos, 2]] = 0; $CellContext`grid = $CellContext`tsub[$CellContext`grid]; \ $CellContext`grid], $CellContext`tsub[ Pattern[$CellContext`m, Blank[]]] := Module[{$CellContext`mat = $CellContext`m, $CellContext`s = Length[$CellContext`m], $CellContext`tl, $CellContext`tr, \ $CellContext`bl, $CellContext`br, $CellContext`num = RandomReal[]}, If[$CellContext`s <= 2, For[$CellContext`i = 1, $CellContext`i <= 2, Increment[$CellContext`i], For[$CellContext`j = 1, $CellContext`j <= 2, Increment[$CellContext`j], If[Part[$CellContext`mat, $CellContext`i, $CellContext`j] == 1, Part[$CellContext`mat, $CellContext`i, $CellContext`j] = \ $CellContext`num; Null]; Null]; Null]; Null, $CellContext`tl = Part[$CellContext`mat, Span[1, $CellContext`s/2], Span[1, $CellContext`s/2]]; $CellContext`tr = Part[$CellContext`mat, Span[1, $CellContext`s/2], Span[$CellContext`s/2 + 1, $CellContext`s]]; $CellContext`bl = Part[$CellContext`mat, Span[$CellContext`s/2 + 1, $CellContext`s], Span[1, $CellContext`s/2]]; $CellContext`br = Part[$CellContext`mat, Span[$CellContext`s/2 + 1, $CellContext`s], Span[$CellContext`s/2 + 1, $CellContext`s]]; If[Count[ Flatten[$CellContext`tl], 1] == ($CellContext`s/2)^2, Part[$CellContext`tl, $CellContext`s/2, $CellContext`s/ 2] = $CellContext`num; Null]; If[Count[ Flatten[$CellContext`tr], 1] == ($CellContext`s/2)^2, Part[$CellContext`tr, $CellContext`s/2, 1] = $CellContext`num; Null]; If[Count[ Flatten[$CellContext`bl], 1] == ($CellContext`s/2)^2, Part[$CellContext`bl, 1, $CellContext`s/2] = $CellContext`num; Null]; If[Count[ Flatten[$CellContext`br], 1] == ($CellContext`s/2)^2, Part[$CellContext`br, 1, 1] = $CellContext`num; Null]; $CellContext`tl = $CellContext`tsub[$CellContext`tl]; \ $CellContext`tr = $CellContext`tsub[$CellContext`tr]; $CellContext`bl = \ $CellContext`tsub[$CellContext`bl]; $CellContext`br = \ $CellContext`tsub[$CellContext`br]; Part[$CellContext`mat, Span[1, $CellContext`s/2], Span[1, $CellContext`s/2]] = $CellContext`tl; Part[$CellContext`mat, Span[1, $CellContext`s/2], Span[$CellContext`s/2 + 1, $CellContext`s]] = $CellContext`tr; Part[$CellContext`mat, Span[$CellContext`s/2 + 1, $CellContext`s], Span[1, $CellContext`s/2]] = $CellContext`bl; Part[$CellContext`mat, Span[$CellContext`s/2 + 1, $CellContext`s], Span[$CellContext`s/2 + 1, $CellContext`s]] = $CellContext`br; Null]; $CellContext`mat], $CellContext`dmat[ Pattern[$CellContext`n, Blank[]], Optional[ Pattern[$CellContext`p1, Blank[]], {1, 1}], Optional[ Pattern[$CellContext`p2, Blank[]], {1, 2}]] := Module[{$CellContext`g, $CellContext`gc, $CellContext`cc, \ $CellContext`start, $CellContext`chain, $CellContext`mat = ConstantArray[ 0, {2^$CellContext`n, 2^$CellContext`n}]}, $CellContext`g = VertexDelete[ Graph[ $CellContext`cyclegraph[$CellContext`n]], {$CellContext`p1, \ $CellContext`p2}]; $CellContext`cc = ConnectedComponents[$CellContext`g]; $CellContext`gc = Table[ Subgraph[$CellContext`g, Part[$CellContext`cc, $CellContext`k]], {$CellContext`k, 1, Length[$CellContext`cc]}]; If[Length[$CellContext`gc] == 2, $CellContext`start = { Part[ $CellContext`findleaves[ Part[$CellContext`gc, 1]], 1], Part[ $CellContext`findleaves[ Part[$CellContext`gc, 2]], 1]}, $CellContext`start = { Part[ $CellContext`findleaves[ Part[$CellContext`gc, 1]], 1]}; Null]; Do[$CellContext`chain = $CellContext`dfs[ Part[$CellContext`gc, $CellContext`i], Part[$CellContext`start, $CellContext`i]]; Do[Part[$CellContext`mat, Part[$CellContext`chain, $CellContext`j, 1], Part[$CellContext`chain, $CellContext`j, 2]] = ( Part[$CellContext`mat, Part[$CellContext`chain, $CellContext`j + 1, 1], Part[$CellContext`chain, $CellContext`j + 1, 2]] = RandomReal[]), {$CellContext`j, 1, Length[$CellContext`chain] - 1, 2}], {$CellContext`i, 1, Length[$CellContext`start]}]; $CellContext`mat], \ $CellContext`cyclegraph[ Pattern[$CellContext`n, Blank[]]] := Module[{$CellContext`e = {}}, $CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{$CellContext`i, 1}, {$CellContext`i + 1, 1}], {$CellContext`i, 1, 2^$CellContext`n - 1}]]; $CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{2^$CellContext`n, $CellContext`j}, { 2^$CellContext`n, $CellContext`j + 1}], {$CellContext`j, 1, 2^$CellContext`n - 1}]]; $CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{$CellContext`i, 2^$CellContext`n}, {$CellContext`i - 1, 2^$CellContext`n}], {$CellContext`i, 2^$CellContext`n, 2, -1}]]; Do[$CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{$CellContext`i, $CellContext`j}, \ {$CellContext`i + 1, $CellContext`j}], {$CellContext`i, 1, 2^$CellContext`n - 2}]], {$CellContext`j, 2, 2^$CellContext`n - 1}]; $CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{1, $CellContext`j}, { 1, $CellContext`j + 1}], {$CellContext`j, 1, 2^$CellContext`n - 1, 2}]]; $CellContext`e = Join[$CellContext`e, Table[ UndirectedEdge[{2^$CellContext`n - 1, $CellContext`j}, { 2^$CellContext`n - 1, $CellContext`j + 1}], {$CellContext`j, 2, 2^$CellContext`n - 2, 2}]]; $CellContext`e], $CellContext`findleaves[ Pattern[$CellContext`g, Blank[]]] := Module[{$CellContext`v, $CellContext`leaf = {}}, $CellContext`v = VertexList[$CellContext`g]; Do[ If[VertexDegree[$CellContext`g, Part[$CellContext`v, $CellContext`i]] == 1, $CellContext`leaf = Append[$CellContext`leaf, Part[$CellContext`v, $CellContext`i]]; Null], {$CellContext`i, 1, Length[$CellContext`v]}]; $CellContext`leaf], $CellContext`dfs[ Pattern[$CellContext`g, Blank[]], Pattern[$CellContext`s, Blank[]]] := Part[ Reap[ DepthFirstScan[$CellContext`g, $CellContext`s, { "PrevisitVertex" -> Sow}]], 2, 1], $CellContext`cpainter[ Pattern[$CellContext`mat, Blank[]]] := Module[{$CellContext`list, $CellContext`temp, $CellContext`c, \ $CellContext`s}, $CellContext`list = DeleteCases[ DeleteDuplicates[ Flatten[$CellContext`mat]], 0]; $CellContext`temp = Table[ Position[$CellContext`mat, Part[$CellContext`list, $CellContext`i]], {$CellContext`i, 1, Length[$CellContext`list]}]; $CellContext`c = ConstantArray[{0, 0}, Length[$CellContext`temp]]; Do[Part[$CellContext`c, $CellContext`i] = {(Max[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 1]] + Min[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 1]])/2, (Max[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 2]] + Min[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 2]])/2}, {$CellContext`i, 1, Length[$CellContext`c]}]; $CellContext`s = ConstantArray["", Length[$CellContext`c]]; Do[SeedRandom[ Ceiling[ 30 (Part[$CellContext`c, $CellContext`i, 1] + $CellContext`pal Length[$CellContext`mat] Part[$CellContext`c, $CellContext`i, 2])]]; Part[$CellContext`s, $CellContext`i] = RandomReal[1, 3], {$CellContext`i, 1, Length[$CellContext`c]}]; ArrayPlot[$CellContext`mat, ColorRules -> Join[{0 -> White}, Table[Part[$CellContext`list, $CellContext`i] -> Apply[RGBColor, Part[$CellContext`s, $CellContext`i]], {$CellContext`i, 1, Length[$CellContext`list]}]]]], $CellContext`cpainter[ Pattern[$CellContext`mat, Blank[]], Pattern[$CellContext`pal, Blank[]]] := Module[{$CellContext`list, $CellContext`temp, $CellContext`c, \ $CellContext`s}, $CellContext`list = DeleteCases[ DeleteDuplicates[ Flatten[$CellContext`mat]], 0]; $CellContext`temp = Table[ Position[$CellContext`mat, Part[$CellContext`list, $CellContext`i]], {$CellContext`i, 1, Length[$CellContext`list]}]; $CellContext`c = ConstantArray[{0, 0}, Length[$CellContext`temp]]; Do[Part[$CellContext`c, $CellContext`i] = {(Max[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 1]] + Min[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 1]])/2, (Max[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 2]] + Min[ Part[$CellContext`temp, $CellContext`i, Span[1, All], 2]])/2}, {$CellContext`i, 1, Length[$CellContext`c]}]; $CellContext`s = ConstantArray["", Length[$CellContext`c]]; Do[SeedRandom[ Ceiling[ 30 (Part[$CellContext`c, $CellContext`i, 1] + $CellContext`pal Length[$CellContext`mat] Part[$CellContext`c, $CellContext`i, 2])]]; Part[$CellContext`s, $CellContext`i] = RandomReal[1, 3], {$CellContext`i, 1, Length[$CellContext`c]}]; ArrayPlot[$CellContext`mat, ColorRules -> Join[{0 -> White}, Table[Part[$CellContext`list, $CellContext`i] -> Apply[RGBColor, Part[$CellContext`s, $CellContext`i]], {$CellContext`i, 1, Length[$CellContext`list]}]]]], $CellContext`pal = 1}; Typeset`initDone$$ = True), SynchronousInitialization->True, UndoTrackedVariables:>{Typeset`show$$, Typeset`bookmarkMode$$}, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellChangeTimes->{3.776603988560485*^9, 3.776604114383869*^9, 3.7766041690898666`*^9}] }, Open ]] }, Open ]] }, Open ]] }, Open ]] }, WindowSize->{759, 833}, WindowMargins->{{137, Automatic}, {Automatic, 44}}, FrontEndVersion->"10.4 for Microsoft Windows (64-bit) (April 11, 2016)", StyleDefinitions->"Default.nb" ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[580, 22, 162, 2, 90, "Title"], Cell[745, 26, 159, 2, 30, "Text"], Cell[CellGroupData[{ Cell[929, 32, 99, 1, 63, "Section"], Cell[1031, 35, 800, 15, 106, "Text"], Cell[1834, 52, 1456, 36, 148, "Text"], Cell[3293, 90, 670, 11, 125, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[4000, 106, 91, 1, 63, "Section"], Cell[CellGroupData[{ Cell[4116, 111, 102, 1, 43, "Subsection"], Cell[4221, 114, 5920, 120, 352, "Input", InitializationCell->True, CellID->186327850], Cell[10144, 236, 9680, 251, 1287, "Input", InitializationCell->True, CellID->831793641], Cell[19827, 489, 6160, 146, 519, "Input", InitializationCell->True, CellID->948736883], Cell[25990, 637, 5700, 154, 372, "Input", InitializationCell->True, CellID->88583857], Cell[31693, 793, 1771, 45, 212, "Input", InitializationCell->True, CellID->724788800], Cell[33467, 840, 947, 26, 72, "Input", InitializationCell->True, CellID->20493368], Cell[34417, 868, 6818, 167, 512, "Input", InitializationCell->True, CellID->304082261] }, Closed]], Cell[CellGroupData[{ Cell[41272, 1040, 105, 1, 35, "Subsection"], Cell[CellGroupData[{ Cell[41402, 1045, 7408, 193, 502, "Input"], Cell[48813, 1240, 17828, 361, 439, "Output"] }, Open ]] }, Open ]] }, Open ]] }, Open ]] } ] *)