Xah Talk Show 2022-12-18 Advent of Code Day 5B, in WolframLang, Live Coding
Part 1, Precedural Style Solution
xinput = "
[D]
[N] [C]
[Z] [M] [P]
1 2 3
move 1 from 2 to 1
move 3 from 1 to 3
move 2 from 2 to 1
move 1 from 1 to 2"
x1 = StringSplit[ xinput , "\n\n" ]
xLinesOfStackConfig = StringSplit[ x1[[1]] , "\n" ]
xProcedureLines = StringSplit[ x1[[2]] , "\n" ]
xColumnCount = ToExpression @ Last@ StringSplit[ Last@xLinesOfStackConfig ]
x2 = Map[ StringPadRight[ #, xColumnCount * 4 ]& , xLinesOfStackConfig ]
x3 = Map[ StringPartition[ #, 4 ]&, x2 ]
x4 = Transpose @ (Drop[ #, -1 ]&) @ Map[ StringTrim, x3 ]
x5 = Map[(StringReplace[ #, { "[" -> "", "]" -> "" } ]&), x4 ]
xListOfStacks = Map[ DeleteCases[ # , "" ] &, x5 ]
x7 = StringReplace[xProcedureLines , { "move " -> "", "from " -> "", "to " -> "" } ]
xProcedureNumbers = ToExpression @ StringSplit[ x7 ]
Clear[fmove]
fmove[{p_, m_, n_}] :=
Do[
xListOfStacks[[n]] = Prepend[ xListOfStacks[[n]], xListOfStacks[[m, 1]] ];
xListOfStacks[[m]] = Drop[ xListOfStacks[[m]], 1 ],
{p} ]
Map[ fmove , xProcedureNumbers ]
xAnswer = StringRiffle[ Map[ If[ Length@# === 0, {}, First@# ]& , xListOfStacks ], "" ]
xAnswer === "CMZ"
Part 1, Function Style Solution
xinput = "
[D]
[N] [C]
[Z] [M] [P]
1 2 3
move 1 from 2 to 1
move 3 from 1 to 3
move 2 from 2 to 1
move 1 from 1 to 2"
{xStacksString, xProcedureString} = (StringSplit[ # , "\n\n" ]& @ xinput)
xLinesOfStackConfig = StringSplit[ StringReplace[ xStacksString, { "[" -> " ", "]" -> " " } ], "\n" ]
xColumnCount = StringCases[ Last@xLinesOfStackConfig , RegularExpression[ " (\\d+) *$" ] -> "$1" ][[1]]//ToExpression
xListOfStacks = ((DeleteCases[ # , "" ]) &) /@ Transpose @ (Drop[ #, -1 ]&) @ (StringTrim /@ (StringPartition[ #, 4 ]&) /@ (StringPadRight[ #, xColumnCount * 4 ]& /@ xLinesOfStackConfig ))
xProcedureNumbers = ToExpression @ StringSplit@ (StringSplit[ StringReplace[ xProcedureString , { "move " -> "", "from " -> "", "to " -> "" } ] , "\n" ])
Clear[fmove]
fmove[{p_, m_, n_}, xstacks_] :=
Nest[ReplacePart[#1, {n -> Prepend[#1[[n]], First[#1[[m]]]],
m -> Drop[#1[[m]], 1]}] &, xstacks, p]
xResultStacks = Fold[ fmove[#2, #1]&, xListOfStacks, xProcedureNumbers ]
xAnswer = StringRiffle[ Cases[xResultStacks, {x_,___} -> x] , "" ]
xAnswer === "CMZ"
part 2
Clear[ fmove ]
fmove[{p_, m_, n_}, xstacks_] :=
ReplacePart[xstacks, {n -> Join[ Take[ xstacks[[m]], p ], xstacks[[n]] ],
m -> Drop[ xstacks[[m]], p ] }]
xResultStacks = Fold[ fmove[#2, #1]&, xListOfStacks, xProcedureNumbers ]
xAnswer = StringRiffle[ Cases[xResultStacks, {x_,___} -> x] , "" ]
xAnswer === "MCD"