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


    The whole thing is available to look at, and on Github.


    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.

    Neil Smith

    Read more posts by this author.