domino-tromino-tiling.nb

(* 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[{"\"\<PrevisitVertex\>\"", "\[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", ",", "\"\<tile type\>\""}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"3", "\[Rule]", "\"\<triominoes\>\""}], ",", 
       RowBox[{"2", "\[Rule]", "\"\<dominoes\>\""}]}], "}"}], ",", 
     "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"}]}], "}"}], ",", "\"\<blanks\>\""}], 
              "}"}], ",", 
             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"}]}], "}"}], ",", "\"\<blanks\>\""}],
                "}"}], ",", 
              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"], ",", "\"\<board width\>\""}], "}"}], ",", 
     RowBox[{"Table", "[", 
      RowBox[{
       SuperscriptBox["2", "k"], ",", 
       RowBox[{"{", 
        RowBox[{"k", ",", "1", ",", "5"}], "}"}]}], "]"}]}], "}"}], ",", 
   "\"\<\>\"", ",", "\[IndentingNewLine]", 
   RowBox[{"Button", "[", 
    RowBox[{"\"\<randomize colors\>\"", ",", 
     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  ]]
}
]
*)