22 December 2019 ; tagged in: advent of code , haskell

Advent of Code 2019 day 17

Stumbling in the dark, then greedy compression.

Advent of Code 2019 day 17

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
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:

  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.