Cell[CellGroupData[{Cell[BoxData[ RowBox[{ RowBox[{"Collatz", "[", RowBox[{ RowBox[{"a0_Integer", "?", "Positive"}], ",", RowBox[{"maxits_", ":", "1000"}]}], "]"}], ":=", RowBox[{"NestWhileList", "[", RowBox[{ RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{"EvenQ", "[", "#1", "]"}], ",", FractionBox["#1", "2"], ",", RowBox[{ RowBox[{"3", " ", "#1"}], "+", "1"}]}], "]"}], "&"}], ",", "a0", ",", RowBox[{ RowBox[{"#1", "!=", "1"}], "&"}], ",", "1", ",", "maxits"}], "]"}]}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, InitializationCell->True, CellChangeTimes->{3.760736032199943*^9}, CellID->536722148], Cell[BoxData[ RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"ArrayPlot", "[", RowBox[{ RowBox[{"Transpose", "[", RowBox[{"DeleteCases", "[", RowBox[{ RowBox[{"Transpose", "[", " ", RowBox[{ FractionBox["1", "6"], " ", RowBox[{"(", RowBox[{ RowBox[{"NestWhileList", "[", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Partition", "[", RowBox[{"#1", ",", "3", ",", "1", ",", "2"}], "]"}], "/.", "", " ", RowBox[{ RowBox[{"{", RowBox[{"a_", ",", "b_", ",", "c_"}], "}"}], "->", RowBox[{"If", "[", RowBox[{ RowBox[{"b", "==", "6"}], ",", RowBox[{"If", "[", RowBox[{ RowBox[{"EvenQ", "[", "a", "]"}], ",", "6", ",", "4"}], "]"}], ",", RowBox[{ RowBox[{ RowBox[{"3", " ", RowBox[{"Mod", "[", RowBox[{"a", ",", "2"}], "]"}]}], "+", RowBox[{"Quotient", "[", RowBox[{"b", ",", "2"}], "]"}]}], "/.", "", RowBox[{"0", ":>", RowBox[{"6", "/;", RowBox[{"a", "==", "6"}]}]}]}]}], "]"}]}]}], "&"}], ",", RowBox[{"Flatten", "[", RowBox[{"{", RowBox[{ RowBox[{"IntegerDigits", "[", RowBox[{"n", ",", "6"}], "]"}], ",", RowBox[{"Table", "[", RowBox[{"6", ",", RowBox[{"{", "50", "}"}]}], "]"}]}], "}"}], "]"}], ",", RowBox[{ RowBox[{"!", RowBox[{"MatchQ", "[", RowBox[{"#1", ",", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"(", "6", ")"}], ".."}], ",", "1", ",", RowBox[{ RowBox[{"(", "6", ")"}], ".."}]}], "}"}]}], "]"}]}], "&"}]}], "]"}], "/.", "", RowBox[{"Thread", "[", RowBox[{ RowBox[{"Range", "[", "6", "]"}], "->", RowBox[{"Range", "[", RowBox[{"6", ",", "1", ",", RowBox[{"-", "1"}]}], "]"}]}], "]"}]}], ")"}]}], "]"}], ",", RowBox[{"{", RowBox[{ FractionBox["1", "6"], ".."}], "}"}]}], "]"}], "]"}], ",", RowBox[{"ColorFunction", "->", "\"\\""}], ",", RowBox[{"FrameTicks", "->", RowBox[{"If", "[", RowBox[{"labels", ",", RowBox[{"{", RowBox[{ RowBox[{"Transpose", "[", RowBox[{"{", RowBox[{ RowBox[{"Reverse", "@", RowBox[{"Range", "[", RowBox[{"Length", "[", RowBox[{"Collatz", "[", "n", "]"}], "]"}], "]"}]}], ",", " ", RowBox[{"Reverse", "[", RowBox[{"Collatz", "[", "n", "]"}], "]"}]}], "}"}], "]"}], ",", "None", ",", "None", ",", "None"}], "}"}], ",", "None"}], "]"}]}], ",", RowBox[{"ImageSize", "->", RowBox[{"{", RowBox[{"350", ",", RowBox[{"If", "[", RowBox[{"resize", ",", "Automatic", ",", "425"}], "]"}]}], "}"}]}]}], "]"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{"n", ",", "27", ",", "\"\\""}], "}"}], ",", "1", ",", "100", ",", "1", ",", RowBox[{"Appearance", "->", "\"\\""}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{"labels", ",", RowBox[{"{", RowBox[{"True", ",", "False"}], "}"}]}], "}"}], ",", " ", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ "resize", ",", "False", ",", "\"\\""}], "}"}], ",", RowBox[{"{", RowBox[{"True", ",", "False"}], "}"}]}], "}"}], ",", RowBox[{"AutorunSequencing", "->", RowBox[{"{", RowBox[{"1", ",", "2"}], "}"}]}], ",", RowBox[{"SaveDefinitions", "->", "True"}]}], "]"}]], "Input", CellGroupingRules->{"GroupTogetherGrouping", 10000.}, CellChangeTimes->{ 3.35696210375764*^9, {3.400184998154072*^9, 3.4001850016065187`*^9}, {3.400185041534123*^9, 3.40018504938151*^9}, {3.4001851281558647`*^9, 3.4001851880972977`*^9}, {3.400189393778761*^9, 3.400189546888446*^9}, {3.4001896553755703`*^9, 3.400189668554833*^9}, {3.400717777030924*^9, 3.4007178343939047`*^9}, {3.4007178954820433`*^9, 3.400717903181251*^9}, {3.400717952347077*^9, 3.400717986857645*^9}, {3.40071810701683*^9, 3.400718142200016*^9}, {3.400718202094863*^9, 3.4007182094690123`*^9}, {3.4007184370650597`*^9, 3.400718438870791*^9}, {3.400718496859295*^9, 3.400718500096077*^9}, {3.400856888899287*^9, 3.400856899130354*^9}, {3.400884157568205*^9, 3.400884191048965*^9}, {3.400885965640625*^9, 3.40088610271875*^9}, {3.4008861835625*^9, 3.40088618925*^9}, { 3.400967767192437*^9, 3.4009677731142745`*^9}, { 3.401145306972769*^9, 3.401145311379019*^9}, 3.7607360321912737`*^9}, CellID->419551984], Cell[BoxData[ TagBox[ StyleBox[ DynamicModuleBox[{$CellContext`labels$$ = True, $CellContext`n$$ = 27, $CellContext`resize$$ = False, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{{ Hold[$CellContext`n$$], 27, "number"}, 1, 100, 1}, { Hold[$CellContext`labels$$], {True, False}}, {{ Hold[$CellContext`resize$$], False, "allow dynamic resizing"}, {True, False}}}, Typeset`size$$ = { 350., {210., 215.}}, Typeset`update$$ = 0, Typeset`initDone$$, Typeset`skipInitDone$$ = False, $CellContext`n$4091$$ = 0, $CellContext`labels$4092$$ = "Button 1", $CellContext`resize$4093$$ = "Button 2"}, DynamicBox[Manipulate`ManipulateBoxes[ 1, StandardForm, "Variables" :> {$CellContext`labels$$ = True, $CellContext`n$$ = 27, $CellContext`resize$$ = False}, "ControllerVariables" :> { Hold[$CellContext`n$$, $CellContext`n$4091$$, 0], Hold[$CellContext`labels$$, $CellContext`labels$4092$$, False], Hold[$CellContext`resize$$, $CellContext`resize$4093$$, False]}, "OtherVariables" :> { Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$, Typeset`skipInitDone$$}, "Body" :> ArrayPlot[ Transpose[ DeleteCases[ Transpose[(1/6) ReplaceAll[ NestWhileList[ReplaceAll[ Partition[#, 3, 1, 2], { Pattern[$CellContext`a, Blank[]], Pattern[$CellContext`b, Blank[]], Pattern[$CellContext`c, Blank[]]} -> If[$CellContext`b == 6, If[ EvenQ[$CellContext`a], 6, 4], ReplaceAll[ 3 Mod[$CellContext`a, 2] + Quotient[$CellContext`b, 2], 0 :> Condition[6, $CellContext`a == 6]]]]& , Flatten[{ IntegerDigits[$CellContext`n$$, 6], Table[6, {50}]}], Not[ MatchQ[#, { Repeated[6], 1, Repeated[6]}]]& ], Thread[Range[6] -> Range[6, 1, -1]]]], { Repeated[1/6]}]], ColorFunction -> "FallColors", FrameTicks -> If[$CellContext`labels$$, { Transpose[{ Reverse[ Range[ Length[ $CellContext`Collatz[$CellContext`n$$]]]], Reverse[ $CellContext`Collatz[$CellContext`n$$]]}], None, None, None}, None], ImageSize -> {350, If[$CellContext`resize$$, Automatic, 425]}], "Specifications" :> {{{$CellContext`n$$, 27, "number"}, 1, 100, 1, Appearance -> "Labeled"}, {$CellContext`labels$$, { True, False}}, {{$CellContext`resize$$, False, "allow dynamic resizing"}, {True, False}}}, "Options" :> {AutorunSequencing -> {1, 2}}, "DefaultOptions" :> {ControllerLinking -> True}], ImageSizeCache->{395., {278., 284.}}, SingleEvaluation->True], Deinitialization:>None, DynamicModuleValues:>{}, Initialization:>({$CellContext`Collatz[ PatternTest[ Pattern[$CellContext`a0, Blank[Integer]], Positive], Optional[ Pattern[$CellContext`maxits, Blank[]], 1000]] := NestWhileList[If[ EvenQ[#], #/2, 3 # + 1]& , $CellContext`a0, # != 1& , 1, $CellContext`maxits]}; 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.760736032191543*^9}, CellID->10199195] }, {3}]]