Day 17 was a challenge of two very different parts. Part 1 was a simple parsing of some Intcode output. Part 2 was about finding a lossless compression, including finding your own dictionary.
Part 1
This was relatively straightforward: run an Intcode machine, use its output as an Ascii-coded text file to build a Scaffold data structure, then look for some interesting points.
I created a ScaffoldBuilder to hold the state of the scaffold, the robot on it, and where I was in the scaffold creation process.
type Scaffold = S.Set Position
type Position = (Integer, Integer) -- r, c
data Direction = North | East | South | West deriving (Show, Eq, Ord, Enum, Bounded)
data ScaffoldBuilder = ScaffoldBuilder
{ _scaffold :: Scaffold
, _r :: Integer
, _c :: Integer
, _droidPos :: Position
, _droidDirection :: Direction
} deriving (Show, Eq)
Building the scaffold was a foldl' on the machine's output. addGridChar keeps track of the current row and column to use for adding the next piece of scaffold.
buildScaffold :: [Integer] -> ScaffoldBuilder
buildScaffold mem = foldl' addGridChar emptyScaffoldBuilder output
where (_, _, output) = runProgram [] mem
emptyScaffoldBuilder = ScaffoldBuilder {_scaffold = S.empty, _r = 0, _c = 0,
_droidPos = (0, 0), _droidDirection = North }
addGridChar :: ScaffoldBuilder -> Integer -> ScaffoldBuilder
addGridChar sb 10 = sb { _r = _r sb + 1, _c = 0 }
addGridChar sb 46 = sb { _c = _c sb + 1 }
addGridChar sb 35 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
_c = _c sb + 1 }
addGridChar sb 94 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
_c = _c sb + 1,
_droidPos = (_r sb, _c sb),
_droidDirection = North }
addGridChar sb 118 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
_c = _c sb + 1,
_droidPos = (_r sb, _c sb),
_droidDirection = South }
addGridChar sb 60 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
_c = _c sb + 1,
_droidPos = (_r sb, _c sb),
_droidDirection = West }
addGridChar sb 61 = sb { _scaffold = S.insert (_r sb, _c sb) $ _scaffold sb,
_c = _c sb + 1,
_droidPos = (_r sb, _c sb),
_droidDirection = East }
A point is an intersection if it has a piece of scaffolding in all four directions. I found the intersections by taking each point, imagining what these four neighbouring scaffolding pieces would be, and checking whether all those pieces are in the scaffold.
part1 sb = S.foldl (+) 0 $ S.map alignmentParam intersections
where scaffold = _scaffold sb
intersections = S.filter (isIntersection scaffold) scaffold
isIntersection :: Scaffold -> Position -> Bool
isIntersection scaffold (r, c) = neighbours `S.isSubsetOf` scaffold
where neighbours = [(r - 1, c), (r + 1, c), (r, c - 1), (r, c + 1)]
alignmentParam :: Position -> Integer
alignmentParam (r, c) = r * c
Note how isIntersection is partially applied in the S.filter function.
Part 2
This was a lot more involved. The basic approach was:
- find a series of
Steps that moved the robot around the scaffolding, - convert those
Steps into a series ofCommands, - compress the
Commands into theRoutine, - feed the
Routineinto the Intcode program
The first three steps are combined in findRoutine:
findRoutine :: ScaffoldBuilder -> Routine
findRoutine scaff = head $ compressedCmds
where path = findPath scaff
cmds = toCommands path
compressedCmds = compress cmds
I also created a few more data types for keep things straight.
data Step = F | ACW | CW deriving (Show, Eq, Ord)
data Command = FN Int | L | R | A | B | C deriving (Eq)
type Routine = ([Command], [Command], [Command], [Command])
Find the steps
A quick look at the map (rendered into Ascii-art) indicated that the robot should move forward as far as possible, and there was only one option for turning at each point. In particular, it seemed likely that the most compressible route was for the robot to pass over each intersection.
But how to implement it?
I used the same ScaffoldBuilder structure to track where the robot was on the scaffold. The notion of transforming a object into a list of steps is an unfold operation, and that's what I did.
takeStep pulls out a few parts of the current ScaffoldBuilder and checks if there are scaffold elements ahead, to the left, and to the right of the robot. Depending on those checks, the next step is either F, CW or ACW. If there's no valid step, takeStep returns Nothing and the unfold stops.
findPath :: ScaffoldBuilder -> [Step]
findPath = unfoldr takeStep
takeStep :: ScaffoldBuilder -> Maybe (Step, ScaffoldBuilder)
takeStep visitedScaffold = step
where scaff = _scaffold visitedScaffold
here = _droidPos visitedScaffold
dir = _droidDirection visitedScaffold
fPos = ahead here dir
cwPos = ahead here $ succW dir
acwPos = ahead here $ predW dir
step = if canVisit scaff fPos
then Just (F, visitedScaffold {_droidPos = fPos})
else if canVisit scaff cwPos
then Just (CW, visitedScaffold {_droidDirection = succW dir})
else if canVisit scaff acwPos
then Just (ACW, visitedScaffold {_droidDirection = predW dir})
else Nothing
ahead :: Position -> Direction -> Position
ahead (r, c) North = (r - 1, c)
ahead (r, c) South = (r + 1, c)
ahead (r, c) West = (r, c - 1)
ahead (r, c) East = (r, c + 1)
canVisit :: Scaffold -> Position -> Bool
canVisit scaff here = (S.member here scaff)
This uses the same wrapping versions of pred and succ I used in day 11.
Convert steps to commands
This is much simpler. The code exploits the fact that there are no U-turns in the map, so the only repeated steps are F. toCommands groups similar Steps and toCommand turns each group of Steps into a single Command.
toCommands :: [Step] -> [Command]
toCommands path = map toCommand segments
where segments = group path
toCommand :: [Step] -> Command
toCommand segment = case (head $ segment) of
F -> FN (length segment)
CW -> R
ACW -> L
Compress the commands
Compression is dictionary-based compression, where we have to create our own dictionary. The puzzle statement gives a few other constraints:
- The dictionary has exactly three entries
- No entry can be more than 20 characters (including the comma separators)
- The compressed routine can contain only dictionary keys
- The compressed routine can be no more than 20 characters
I handled the "20 character" limit by building a custom show and showList functions for Commands. (I was inspired by ephemient's post). That means I can show a bunch of commands then directly find the length of their representation.
showList took a bit of thinking about, as it uses a difference list for efficiency (and they're not quite the difference lists I'm used to from Prolog).
instance Show Command where
show (FN n) = show n
show L = "L"
show R = "R"
show A = "A"
show B = "B"
show C = "C"
showList [] s = s
showList (c:[]) s = (show c) ++ s
showList (c:cs) s = (show c) ++ "," ++ (showList cs s)
For finding the compression, I took inspiration from gedhrel's solution and used the list monad to explore all possible compressions, using the lists for non-determinism.
The constraints above mean that dictionary entry A is some non-empty prefix of the commands, entry B starts with the first basic command after the initial As, and entry C takes what's left.
The core of the compression takes place in the compress function. tail $ inits commands gives all non-empty prefixes of commands. The guard statements ensure that the dictionary entries valid; they're evaluated as soon as possible for efficiency. compress will find all possible Routines: in my case, there was only one valid solution.
compress :: [Command] -> [Routine]
compress commands =
do a <- tail $ inits commands
guard $ length (show a) <= 20
let commandsA = replace a A commands
let commandsABase = dropWhile (not . isBase) commandsA
b <- tail $ inits commandsABase
guard $ onlyBase b
guard $ length (show b) <= 20
let commandsAB = replace b B commandsA
let commandsABBase = dropWhile (not . isBase) commandsAB
c <- tail $ inits commandsABBase
guard $ onlyBase c
guard $ length (show c) <= 20
let commandsABC = replace c C commandsAB
guard $ length (show commandsABC) <= 20
guard $ onlyNonBase commandsABC
return (commandsABC, a, b, c)
The replace function replaces a dictionary entry with its label and onlyBase and friends check that lists of commands contain (or don't) the base commands.
replace :: Eq a => [a] -> a -> [a] -> [a]
replace _ _ [] = []
replace moves label commands =
if moves `isPrefixOf` commands
then (label:(replace moves label commands'))
else (head commands:(replace moves label (tail commands)))
where commands' = drop (length moves) commands
onlyBase :: [Command] -> Bool
onlyBase moves = all isBase moves
onlyNonBase :: [Command] -> Bool
onlyNonBase moves = all (not . isBase) moves
isBase :: Command -> Bool
isBase (FN _) = True
isBase L = True
isBase R = True
isBase _ = False
Process the routine
After all that, converting the routine into the numbers to feed into the Intcode program is almost trivial, even if I do have to convert from Int to Integer.
encodeRoutine :: Routine -> [Integer]
encodeRoutine (abc, a, b, c) = map (fromIntegral . ord)
$ unlines [show abc, show a, show b, show c, "n", ""]
Finally, I take the output of the machine, display the scaffolding map it produces (complete with human-sensible-prompts!) and the amount of space dust collected.
part2 sb mem = (scaff, last output)
where compressedCmds = findRoutine sb
inputs = encodeRoutine compressedCmds
mem' = (2:(tail mem))
(_, _, output) = runProgram inputs mem'
scaff = map (chr . fromIntegral) $ init output
Code
The whole thing is available to look at, and on Github.
Comments
I'm somewhat bemused why this puzzle was Intcode based: the map wasn't too large, and the puzzle solution could have been judged by the lengths of the various parts of the compressed instructions.