Cell[CellGroupData[{Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"sums", "[", RowBox[{"s_", ",", "i_"}], "]"}], ":=", RowBox[{ RowBox[{"{", "}"}], "/;", RowBox[{ RowBox[{"s", "<", "i"}], "||", RowBox[{"i", "==", "0"}]}]}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"sums", "[", RowBox[{"s_", ",", "s_"}], "]"}], ":=", RowBox[{"{", RowBox[{"Table", "[", RowBox[{"1", ",", RowBox[{"{", "s", "}"}]}], "]"}], "}"}]}], ";"}], "\n", RowBox[{ RowBox[{ RowBox[{"sums", "[", RowBox[{"s_", ",", "1"}], "]"}], ":=", RowBox[{"{", RowBox[{"{", "s", "}"}], "}"}]}], ";"}], "\n", RowBox[{ RowBox[{"sums", "[", RowBox[{"s_", ",", "i_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", "d", "}"}], ",", RowBox[{"Flatten", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Join", "[", RowBox[{ RowBox[{"{", "d", "}"}], ",", "#1"}], "]"}], "&"}], ")"}], "/@", RowBox[{"sums", "[", RowBox[{ RowBox[{"s", "-", "d"}], ",", RowBox[{"i", "-", "1"}]}], "]"}]}], ",", RowBox[{"{", RowBox[{"d", ",", RowBox[{"s", "-", "i", "+", "1"}]}], "}"}]}], "]"}], ",", "1"}], "]"}]}], "]"}]}]}], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068*^9}, CellID->465632763], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"hanoiP", "[", RowBox[{"n_", ",", "p_"}], "]"}], ":=", RowBox[{ RowBox[{"Join", "[", RowBox[{ RowBox[{"Table", "[", RowBox[{"1", ",", RowBox[{"{", RowBox[{"n", "-", "1"}], "}"}]}], "]"}], ",", RowBox[{"Table", "[", RowBox[{"0", ",", RowBox[{"{", RowBox[{"p", "-", "n", "-", "1"}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"2", " ", "n"}], "-", "1"}], "}"}]}], "]"}], "/;", RowBox[{"n", "<", RowBox[{"p", "-", "1"}]}]}]}], ";"}], "\n", RowBox[{ RowBox[{"hanoiP", "[", RowBox[{"n_", ",", "p_"}], "]"}], ":=", RowBox[{ RowBox[{"hanoiP", "[", RowBox[{"n", ",", "p"}], "]"}], "=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"v", ",", "t"}], "}"}], ",", RowBox[{ RowBox[{"t", "=", RowBox[{"sums", "[", RowBox[{ RowBox[{"n", "-", "1"}], ",", RowBox[{"p", "-", "2"}]}], "]"}]}], ";", RowBox[{"v", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"Join", "[", RowBox[{"#1", ",", RowBox[{"{", RowBox[{ RowBox[{"2", " ", RowBox[{"Plus", "@@", RowBox[{"Table", "[", RowBox[{ RowBox[{"Last", "[", RowBox[{"hanoiP", "[", RowBox[{ RowBox[{ "#1", "[[", "i", "]]"}], ",", RowBox[{"p", "-", "i", "+", "1"}]}], "]"}], "]"}], ",", RowBox[{"{", RowBox[{"i", ",", RowBox[{"p", "-", "2"}]}], "}"}]}], "]"}]}]}], "+", "1"}], "}"}]}], "]"}], "&"}], ")"}], "/@", "t"}]}], ";", RowBox[{"First", "[", RowBox[{"Sort", "[", RowBox[{"v", ",", RowBox[{ RowBox[{ RowBox[{"Last", "[", "#2", "]"}], ">", RowBox[{"Last", "[", "#1", "]"}]}], "&"}]}], "]"}], "]"}]}]}], "]"}]}]}]}], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068136*^9}, CellID->55638857], Cell[BoxData[ RowBox[{ RowBox[{"superHanoi", "[", RowBox[{"{", RowBox[{ RowBox[{"{", "d_", "}"}], ",", RowBox[{"{", RowBox[{"a_", ",", "___", ",", "b_"}], "}"}]}], "}"}], "]"}], ":=", RowBox[{"{", RowBox[{"d", ",", "a", ",", "b"}], "}"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.7608300600682573`*^9}, CellID->34484665], Cell[BoxData[ RowBox[{ RowBox[{"superHanoi", "[", RowBox[{"{", RowBox[{"tower_", ",", "pegs_"}], "}"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"a", ",", "pat", ",", RowBox[{"lp", "=", RowBox[{"Length", "[", "pegs", "]"}]}], ",", "n", ",", RowBox[{"ans", "=", RowBox[{"{", "}"}]}], ",", "i", ",", "p", ",", "spread", ",", "back"}], "}"}], ",", RowBox[{ RowBox[{"a", "=", RowBox[{"Drop", "[", RowBox[{ RowBox[{"hanoiP", "[", RowBox[{ RowBox[{"Length", "[", "tower", "]"}], ",", "lp"}], "]"}], ",", RowBox[{"-", "1"}]}], "]"}]}], ";", RowBox[{"pat", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"Take", "[", RowBox[{"tower", ",", RowBox[{"{", RowBox[{ RowBox[{"1", "+", RowBox[{ UnderoverscriptBox["\[Sum]", RowBox[{"i", "=", "1"}], RowBox[{"n", "-", "1"}]], RowBox[{ "a", "[[", "i", "]]"}]}]}], ",", RowBox[{ UnderoverscriptBox["\[Sum]", RowBox[{"i", "=", "1"}], "n"], RowBox[{ "a", "[[", "i", "]]"}]}]}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"n", ",", RowBox[{"lp", "-", "2"}]}], "}"}]}], "]"}]}], ";", RowBox[{"spread", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{ RowBox[{"p", "=", RowBox[{"Drop", "[", RowBox[{"pegs", ",", RowBox[{"{", RowBox[{"2", ",", "n"}], "}"}]}], "]"}]}], ";", RowBox[{"i", "=", RowBox[{"Last", "[", "p", "]"}]}], ";", RowBox[{ RowBox[{"p", "[[", RowBox[{"-", "1"}], "]]"}], "=", RowBox[{ "p", "[[", "2", "]]"}]}], ";", RowBox[{ RowBox[{ "p", "[[", "2", "]]"}], "=", "i"}], ";", RowBox[{"{", RowBox[{ RowBox[{ "pat", "[[", "n", "]]"}], ",", "p"}], "}"}]}], ",", RowBox[{"{", RowBox[{"n", ",", RowBox[{"lp", "-", "2"}]}], "}"}]}], "]"}]}], ";", RowBox[{"spread", "=", RowBox[{"Cases", "[", RowBox[{"spread", ",", RowBox[{"{", RowBox[{ RowBox[{"{", "__", "}"}], ",", "_"}], "}"}]}], "]"}]}], ";", RowBox[{"back", "=", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"First", "[", "#1", "]"}], ",", RowBox[{"Join", "[", RowBox[{ RowBox[{"{", RowBox[{"Last", "[", RowBox[{"Last", "[", "#1", "]"}], "]"}], "}"}], ",", RowBox[{"Complement", "[", RowBox[{ RowBox[{"Last", "[", "#1", "]"}], ",", RowBox[{"{", RowBox[{ RowBox[{"Last", "[", RowBox[{"Last", "[", "#1", "]"}], "]"}], ",", RowBox[{"Last", "[", "pegs", "]"}]}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"Last", "[", "pegs", "]"}], "}"}]}], "]"}]}], "}"}], "&"}], ")"}], "/@", RowBox[{"Reverse", "[", "spread", "]"}]}]}], ";", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"ans", ",", RowBox[{"superHanoi", "[", "#1", "]"}]}], "]"}], "&"}], ")"}], "/@", "spread"}], ";", RowBox[{"AppendTo", "[", RowBox[{"ans", ",", RowBox[{"{", RowBox[{ RowBox[{"Last", "[", "tower", "]"}], ",", RowBox[{"First", "[", "pegs", "]"}], ",", RowBox[{"Last", "[", "pegs", "]"}]}], "}"}]}], "]"}], ";", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"AppendTo", "[", RowBox[{"ans", ",", RowBox[{"superHanoi", "[", "#1", "]"}]}], "]"}], "&"}], ")"}], "/@", "back"}], ";", RowBox[{"Partition", "[", RowBox[{ RowBox[{"Flatten", "[", "ans", "]"}], ",", "3"}], "]"}]}]}], "]"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068346*^9}, CellID->212012085], Cell[BoxData[ RowBox[{ RowBox[{"towers", "[", RowBox[{"numDisks_", ",", "numPegs_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"t", ",", RowBox[{"sH", "=", RowBox[{"superHanoi", "[", RowBox[{"{", RowBox[{ RowBox[{"Range", "[", "numDisks", "]"}], ",", RowBox[{"Range", "[", "numPegs", "]"}]}], "}"}], "]"}]}]}], "}"}], ",", RowBox[{"FoldList", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"t", "=", "#1"}], ";", RowBox[{ RowBox[{"t", "[[", RowBox[{ "#2", "[[", "2", "]]"}], "]]"}], "=", RowBox[{"Rest", "[", RowBox[{"t", "[[", RowBox[{ "#2", "[[", "2", "]]"}], "]]"}], "]"}]}], ";", RowBox[{ RowBox[{"t", "[[", RowBox[{"Last", "[", "#2", "]"}], "]]"}], "=", RowBox[{"Prepend", "[", RowBox[{ RowBox[{"t", "[[", RowBox[{"Last", "[", "#2", "]"}], "]]"}], ",", RowBox[{"First", "[", "#2", "]"}]}], "]"}]}], ";", "t"}], ")"}], "&"}], ",", RowBox[{"Join", "[", RowBox[{ RowBox[{"{", RowBox[{"Range", "[", "numDisks", "]"}], "}"}], ",", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", "}"}], ",", RowBox[{"{", RowBox[{"numPegs", "-", "1"}], "}"}]}], "]"}]}], "]"}], ",", "sH"}], "]"}]}], "]"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068449*^9}, CellID->331072270], Cell[BoxData[ RowBox[{ RowBox[{"colors", "=", RowBox[{"{", RowBox[{ RowBox[{"RGBColor", "[", RowBox[{"0.53", ",", "0.2", ",", "0.18"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.95", ",", "0.57", ",", "0.38"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.23", ",", "0.46", ",", "0.52"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.71", ",", "0.86", ",", "0.5"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.5", ",", "0.78", ",", "0.78"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.8", ",", "0.78", ",", "0.68"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.33", ",", "0.38", ",", "0.48"}], "]"}], ",", RowBox[{"RGBColor", "[", RowBox[{"0.85", ",", "0.87", ",", "0.32"}], "]"}]}], "}"}]}], ";"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068534*^9}, CellID->120531558], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"graphtower", "[", RowBox[{"n_", ",", "li_"}], "]"}], ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"y", "=", RowBox[{"-", "2"}]}], "}"}], ",", RowBox[{"Graphics", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"RGBColor", "[", RowBox[{"0.2", ",", "0.4", ",", "0.4"}], "]"}], ",", RowBox[{"Rectangle", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", ".4"}], ",", "0"}], "}"}], ",", RowBox[{"{", RowBox[{".4", ",", RowBox[{ RowBox[{"2", " ", "n"}], "+", "1"}]}], "}"}]}], "]"}]}], "}"}], ",", RowBox[{"Map", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"y", "=", RowBox[{"y", "+", "2"}]}], ";", RowBox[{"{", RowBox[{ RowBox[{"EdgeForm", "[", RowBox[{"{", RowBox[{"Black", ",", RowBox[{"Thickness", "[", ".025", "]"}]}], "}"}], "]"}], ",", RowBox[{"colors", "[", RowBox[{"[", "#", "]"}], "]"}], ",", RowBox[{"Rectangle", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "2"}], " ", "#"}], "+", ".6"}], ",", RowBox[{"y", "+", ".05"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"2", " ", "#"}], "-", ".6"}], ",", RowBox[{"y", "+", "2"}]}], "}"}]}], "]"}]}], "}"}]}], ")"}], "&"}], ",", RowBox[{"Reverse", "[", "li", "]"}]}], "]"}]}], "}"}], ",", RowBox[{"PlotRange", "->", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"-", "2"}], " ", "n"}], ",", RowBox[{"2", " ", "n"}]}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", RowBox[{ RowBox[{"2", " ", "n"}], "+", "1"}]}], "}"}]}], "}"}]}], ",", RowBox[{"AspectRatio", "->", "2"}]}], "]"}]}], "]"}]}], ";"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068616*^9}, CellID->101209206], Cell[BoxData[ RowBox[{ RowBox[{"showtowers", "[", "li_List", "]"}], ":=", RowBox[{"GraphicsRow", "[", RowBox[{ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"graphtower", "[", RowBox[{ RowBox[{"Length", "[", RowBox[{"Flatten", "[", "li", "]"}], "]"}], ",", "#"}], "]"}], "&"}], ")"}], "/@", "li"}], ",", RowBox[{"ImageSize", "->", RowBox[{"{", RowBox[{"500", ",", "400"}], "}"}]}]}], "]"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.7608300600687*^9}, CellID->193672618], Cell[BoxData[ RowBox[{ RowBox[{"HanoiDiagram", "[", RowBox[{ "NumberOfDisks_", ",", "NumberOfPegs_", ",", "PositionInmoveList_"}], "]"}], ":=", RowBox[{"showtowers", "[", RowBox[{ RowBox[{"towers", "[", RowBox[{"NumberOfDisks", ",", "NumberOfPegs"}], "]"}], "[", RowBox[{"[", "PositionInmoveList", "]"}], "]"}], "]"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.760830060068787*^9}, CellID->351985079], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"PositionInmoveList", ">", RowBox[{"Length", "@", RowBox[{"towers", "[", RowBox[{"NumberOfDisks", ",", "NumberOfPegs"}], "]"}]}]}], ",", RowBox[{"PositionInmoveList", "=", RowBox[{"Length", "@", RowBox[{"towers", "[", RowBox[{"NumberOfDisks", ",", "NumberOfPegs"}], "]"}]}]}]}], "]"}], ";", RowBox[{"HanoiDiagram", "[", RowBox[{ "NumberOfDisks", ",", "NumberOfPegs", ",", "PositionInmoveList"}], "]"}]}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "PositionInmoveList", ",", "1", ",", "\"\\""}], "}"}], ",", "1", ",", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "8", ",", "16", ",", "32", ",", "64", ",", "128", ",", "256"}], "}"}], ",", RowBox[{"{", RowBox[{ "6", ",", "10", ",", "14", ",", "18", ",", "26", ",", "34"}], "}"}], ",", RowBox[{"{", RowBox[{ "6", ",", "8", ",", "12", ",", "16", ",", "20", ",", "24"}], "}"}]}], "}"}], "[", RowBox[{"[", RowBox[{ RowBox[{"NumberOfPegs", "-", "2"}], ",", RowBox[{"NumberOfDisks", "-", "2"}]}], "]"}], "]"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "NumberOfPegs", ",", "3", ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{"3", ",", "4", ",", "5"}], "}"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "NumberOfDisks", ",", "4", ",", "\"\\""}], "}"}], ",", RowBox[{"Range", "[", RowBox[{"3", ",", "8"}], "]"}]}], "}"}], ",", RowBox[{"SaveDefinitions", "->", "True"}]}], "]"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{ 3.35696210375764*^9, {3.3883382540247498`*^9, 3.3883382561809998`*^9}, {3.3883424807903748`*^9, 3.3883424812434998`*^9}, {3.3883441663997498`*^9, 3.3883441667434998`*^9}, {3.388403721311121*^9, 3.388403740451624*^9}, 3.760830060063401*^9}, CellID->201861619], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`NumberOfDisks$$ = 4, $CellContext`NumberOfPegs$$ = 3, $CellContext`PositionInmoveList$$ = 1, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`PositionInmoveList$$], 1, "position"}, 1, Dynamic[ Part[{{8, 16, 32, 64, 128, 256}, {6, 10, 14, 18, 26, 34}, {6, 8, 12, 16, 20, 24}}, $CellContext`NumberOfPegs$$ - 2, $CellContext`NumberOfDisks$$ - 2]], 1}, {{ Hold[$CellContext`NumberOfPegs$$], 3, "number of pegs"}, {3, 4, 5}}, {{ Hold[$CellContext`NumberOfDisks$$], 4, "number of disks"}, {3, 4, 5, 6, 7, 8}}}, Typeset`size$$ = {500., {198., 202.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`PositionInmoveList$4380$$ = 0, $CellContext`NumberOfPegs$4381$$ = 0, $CellContext`NumberOfDisks$4382$$ = 0}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`NumberOfDisks$$ = 4, $CellContext`NumberOfPegs$$ = 3, $CellContext`PositionInmoveList$$ = 1}, "ControllerVariables" :> { Hold[$CellContext`PositionInmoveList$$, \ $CellContext`PositionInmoveList$4380$$, 0], Hold[$CellContext`NumberOfPegs$$, \ $CellContext`NumberOfPegs$4381$$, 0], Hold[$CellContext`NumberOfDisks$$, \ $CellContext`NumberOfDisks$4382$$, 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" :> (If[$CellContext`PositionInmoveList$$ > Length[ $CellContext`towers[$CellContext`NumberOfDisks$$, \ $CellContext`NumberOfPegs$$]], $CellContext`PositionInmoveList$$ = Length[ $CellContext`towers[$CellContext`NumberOfDisks$$, \ $CellContext`NumberOfPegs$$]]]; \ $CellContext`HanoiDiagram[$CellContext`NumberOfDisks$$, \ $CellContext`NumberOfPegs$$, $CellContext`PositionInmoveList$$]), "Specifications" :> {{{$CellContext`PositionInmoveList$$, 1, "position"}, 1, Dynamic[ Part[{{8, 16, 32, 64, 128, 256}, {6, 10, 14, 18, 26, 34}, { 6, 8, 12, 16, 20, 24}}, $CellContext`NumberOfPegs$$ - 2, $CellContext`NumberOfDisks$$ - 2]], 1}, {{$CellContext`NumberOfPegs$$, 3, "number of pegs"}, {3, 4, 5}}, {{$CellContext`NumberOfDisks$$, 4, "number of disks"}, {3, 4, 5, 6, 7, 8}}}, "Options" :> {}, "DefaultOptions" :> {ControllerLinking -> True}], ImageSizeCache->{545., {269., 275.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`towers[ Pattern[$CellContext`n, Blank[]]] := FoldList[$CellContext`moveOneDisk, { Range[$CellContext`n], {}, {}}, $CellContext`moves[$CellContext`n, 1, 3]], $CellContext`towers[ Pattern[$CellContext`numDisks, Blank[]], Pattern[$CellContext`numPegs, Blank[]]] := Module[{$CellContext`t, $CellContext`sH = \ $CellContext`superHanoi[{ Range[$CellContext`numDisks], Range[$CellContext`numPegs]}]}, FoldList[($CellContext`t = #; Part[$CellContext`t, Part[#2, 2]] = Rest[ Part[$CellContext`t, Part[#2, 2]]]; Part[$CellContext`t, Last[#2]] = Prepend[ Part[$CellContext`t, Last[#2]], First[#2]]; $CellContext`t)& , Join[{ Range[$CellContext`numDisks]}, Table[{}, {$CellContext`numPegs - 1}]], $CellContext`sH]], $CellContext`moveOneDisk[ Pattern[$CellContext`t, Blank[]], { Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`j, Blank[]]}] := Module[{$CellContext`q = $CellContext`t, $CellContext`d}, \ $CellContext`d = First[ Part[$CellContext`q, $CellContext`i]]; Part[$CellContext`q, $CellContext`i] = Rest[ Part[$CellContext`q, $CellContext`i]]; Part[$CellContext`q, $CellContext`j] = Prepend[ Part[$CellContext`q, $CellContext`j], $CellContext`d]; \ $CellContext`q], $CellContext`moves[1, Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`j, Blank[]]] := {{$CellContext`i, $CellContext`j}}, \ $CellContext`moves[ Pattern[$CellContext`n, Blank[]], Pattern[$CellContext`i, Blank[]], Pattern[$CellContext`j, Blank[]]] := Join[ $CellContext`moves[$CellContext`n - 1, $CellContext`i, 6 - $CellContext`i - $CellContext`j], {{$CellContext`i, \ $CellContext`j}}, $CellContext`moves[$CellContext`n - 1, 6 - $CellContext`i - $CellContext`j, $CellContext`j]], \ $CellContext`superHanoi[{{ Pattern[$CellContext`d, Blank[]]}, { Pattern[$CellContext`a, Blank[]], BlankNullSequence[], Pattern[$CellContext`b, Blank[]]}}] := {$CellContext`d, $CellContext`a, \ $CellContext`b}, $CellContext`superHanoi[{ Pattern[$CellContext`tower, Blank[]], Pattern[$CellContext`pegs, Blank[]]}] := Module[{$CellContext`a, $CellContext`pat, $CellContext`lp = Length[$CellContext`pegs], $CellContext`n, $CellContext`ans = \ {}, $CellContext`i, $CellContext`p, $CellContext`spread, \ $CellContext`back}, $CellContext`a = Drop[ $CellContext`hanoiP[ Length[$CellContext`tower], $CellContext`lp], -1]; \ $CellContext`pat = Table[ Take[$CellContext`tower, {1 + Sum[ Part[$CellContext`a, $CellContext`i], {$CellContext`i, 1, $CellContext`n - 1}], Sum[ Part[$CellContext`a, $CellContext`i], {$CellContext`i, 1, $CellContext`n}]}], {$CellContext`n, \ $CellContext`lp - 2}]; $CellContext`spread = Table[$CellContext`p = Drop[$CellContext`pegs, { 2, $CellContext`n}]; $CellContext`i = Last[$CellContext`p]; Part[$CellContext`p, -1] = Part[$CellContext`p, 2]; Part[$CellContext`p, 2] = $CellContext`i; { Part[$CellContext`pat, $CellContext`n], \ $CellContext`p}, {$CellContext`n, $CellContext`lp - 2}]; $CellContext`spread = Cases[$CellContext`spread, {{ BlankSequence[]}, Blank[]}]; $CellContext`back = Map[{ First[#], Join[{ Last[ Last[#]]}, Complement[ Last[#], { Last[ Last[#]], Last[$CellContext`pegs]}], { Last[$CellContext`pegs]}]}& , Reverse[$CellContext`spread]]; Map[AppendTo[$CellContext`ans, $CellContext`superHanoi[#]]& , $CellContext`spread]; AppendTo[$CellContext`ans, { Last[$CellContext`tower], First[$CellContext`pegs], Last[$CellContext`pegs]}]; Map[AppendTo[$CellContext`ans, $CellContext`superHanoi[#]]& , $CellContext`back]; Partition[ Flatten[$CellContext`ans], 3]], $CellContext`hanoiP[ 2, 3] = {1, 3}, $CellContext`hanoiP[3, 3] = {2, 7}, $CellContext`hanoiP[3, 4] = {1, 1, 5}, $CellContext`hanoiP[4, 3] = {3, 15}, $CellContext`hanoiP[ 4, 4] = {2, 1, 9}, $CellContext`hanoiP[4, 5] = {1, 1, 1, 7}, $CellContext`hanoiP[5, 3] = {4, 31}, $CellContext`hanoiP[ 6, 3] = {5, 63}, $CellContext`hanoiP[6, 4] = {3, 2, 17}, $CellContext`hanoiP[6, 5] = {3, 1, 1, 15}, $CellContext`hanoiP[7, 3] = {6, 127}, $CellContext`hanoiP[8, 3] = {7, 255}, $CellContext`hanoiP[ Pattern[$CellContext`n, Blank[]], Pattern[$CellContext`p, Blank[]]] := Condition[ Join[ Table[1, {$CellContext`n - 1}], Table[0, {$CellContext`p - $CellContext`n - 1}], { 2 $CellContext`n - 1}], $CellContext`n < $CellContext`p - 1], $CellContext`hanoiP[ Pattern[$CellContext`n, Blank[]], Pattern[$CellContext`p, Blank[]]] := ($CellContext`hanoiP[$CellContext`n, \ $CellContext`p] = Module[{$CellContext`v, $CellContext`t}, $CellContext`t = \ $CellContext`sums[$CellContext`n - 1, $CellContext`p - 2]; $CellContext`v = Map[Join[#, {2 Apply[Plus, Table[ Last[ $CellContext`hanoiP[ Part[#, $CellContext`i], $CellContext`p - \ $CellContext`i + 1]], {$CellContext`i, $CellContext`p - 2}]] + 1}]& , $CellContext`t]; First[ Sort[$CellContext`v, Last[#2] > Last[#]& ]]]), $CellContext`sums[ Pattern[$CellContext`s, Blank[]], Pattern[$CellContext`i, Blank[]]] := Condition[{}, Or[$CellContext`s < $CellContext`i, $CellContext`i == 0]], $CellContext`sums[ Pattern[$CellContext`s, Blank[]], Pattern[$CellContext`s, Blank[]]] := { Table[1, {$CellContext`s}]}, $CellContext`sums[ Pattern[$CellContext`s, Blank[]], 1] := {{$CellContext`s}}, $CellContext`sums[ Pattern[$CellContext`s, Blank[]], Pattern[$CellContext`i, Blank[]]] := Module[{$CellContext`d}, Flatten[ Table[ Map[Join[{$CellContext`d}, #]& , $CellContext`sums[$CellContext`s - $CellContext`d, \ $CellContext`i - 1]], {$CellContext`d, $CellContext`s - $CellContext`i + 1}], 1]], $CellContext`HanoiDiagram[ Pattern[$CellContext`m, Blank[]], Pattern[$CellContext`n, Blank[]]] := $CellContext`showtowers[ Part[ $CellContext`towers[$CellContext`m], $CellContext`n]], \ $CellContext`HanoiDiagram[ Pattern[$CellContext`NumberOfDisks, Blank[]], Pattern[$CellContext`NumberOfPegs, Blank[]], Pattern[$CellContext`PositionInmoveList, Blank[]]] := $CellContext`showtowers[ Part[ $CellContext`towers[$CellContext`NumberOfDisks, \ $CellContext`NumberOfPegs], $CellContext`PositionInmoveList]], \ $CellContext`showtowers[{ Pattern[$CellContext`a, Blank[]], Pattern[$CellContext`b, Blank[]], Pattern[$CellContext`c, Blank[]]}] := GraphicsRow[ Map[$CellContext`graphtower[ Length[ Flatten[{$CellContext`a, $CellContext`b, \ $CellContext`c}]], #]& , {$CellContext`a, $CellContext`b, \ $CellContext`c}], ImageSize -> {500, 400}], $CellContext`showtowers[ Pattern[$CellContext`li, Blank[List]]] := GraphicsRow[ Map[$CellContext`graphtower[ Length[ Flatten[$CellContext`li]], #]& , $CellContext`li], ImageSize -> {500, 400}], $CellContext`graphtower[ Pattern[$CellContext`n, Blank[]], Pattern[$CellContext`li, Blank[]]] := Module[{$CellContext`y = -2}, Graphics[{{ RGBColor[0.2, 0.4, 0.4], Rectangle[{-0.4, 0}, {0.4, 2 $CellContext`n + 1}]}, Map[($CellContext`y = $CellContext`y + 2; { EdgeForm[{Black, Thickness[0.025]}], Part[$CellContext`colors, #], Rectangle[{(-2) # + 0.6, $CellContext`y + 0.05}, { 2 # - 0.6, $CellContext`y + 2}]})& , Reverse[$CellContext`li]]}, PlotRange -> {{(-2) $CellContext`n, 2 $CellContext`n}, { 0, 2 $CellContext`n + 1}}, AspectRatio -> 2]], $CellContext`colors = { RGBColor[0.53, 0.2, 0.18], RGBColor[0.95, 0.57, 0.38], RGBColor[0.23, 0.46, 0.52], RGBColor[0.71, 0.86, 0.5], RGBColor[0.5, 0.78, 0.78], RGBColor[0.8, 0.78, 0.68], RGBColor[0.33, 0.38, 0.48], RGBColor[0.85, 0.87, 0.32]}}; Typeset`initDone$$ = True), SynchronousInitialization->True, UnsavedVariables:>{Typeset`initDone$$}, UntrackedVariables:>{Typeset`size$$}], "Manipulate", Deployed->True, StripOnInput->False], Manipulate`InterpretManipulate[1]]], "Output", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{3.35696210375764*^9, 3.3884038664195676`*^9, 3.760830060063683*^9}, CellID->17466832] }, {11}]]