22 December 2019 Tagged in: advent of code | haskell

# Advent of Code 2019 day 17

Stumbling in the dark, then greedy compression.

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:

1. find a series of Steps that moved the robot around the scaffolding,
2. convert those Steps into a series of Commands,
3. compress the Commands into the Routine,
4. feed the Routine into the Intcode program

The first three steps are combined in findRoutine:

findRoutine :: ScaffoldBuilder -> Routine
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:

1. The dictionary has exactly three entries
2. No entry can be more than 20 characters (including the comma separators)
3. The compressed routine can contain only dictionary keys
4. 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.