Advent of Code 2022 day 22

    Day 22 was quite fun, but a bit long-winded for part 2.

    I cheated somewhat and noticed people talking about the different embedding of the map for part 2 (a torus in part 1, the surface of a cube in part 2). That meant I started by thinking about how I could make the embeddings be carried into the depths of the code, so I wouldn't have to change much between parts.

    In the end, I settled on a Reader monad to store both the map and a function to find the next space ahead. As the notion of "ahead" changed in the two parts, I could move between embeddings by changing the function placed into the Reader at the start.


    Most of this was direct translation from the problem description into Haskell, with my typical perchant of making things explicit rather than reusing generic data structures.

    I chose to represent the map as a Map of Position to what was there (the Cell), giving a sparse structure of just the elements in the map. A Person knows about both their Position and Direction. predW and succW are versions of pred and succ that wrap values around, just what's needed for turning on the spot.

    type Position = V2 Int -- r, c
    _r :: Lens' (V2 Int) Int
    _r = _x
    _c :: Lens' (V2 Int) Int
    _c = _y
    data Cell = Tile | Wall
      deriving (Show, Eq)
    type FieldMap = M.Map Position Cell
    data Direction = Right | Down | Left | Up
      deriving (Show, Eq, Ord, Enum, Bounded)
    predW, succW :: (Eq a, Bounded a, Enum a) => a -> a
    predW a
      | a == minBound = maxBound
      | otherwise = pred a
    succW a
      | a == maxBound = minBound
      | otherwise = succ a
    data PathElement = Forward Int | Clockwise | Anticlockwise 
      deriving (Show, Eq)
    data Person = Person {_position :: Position, _facing :: Direction}
      deriving (Show, Eq)
    makeLenses ''Person
    data Face = A | B | C | D | E | F
      deriving (Show, Eq)

    The Reader

    The reader is there to be threaded through the computation. As well as holding the map itself, it also holds a function for showing what's ahead of a person, given that "ahead" can change between embeddings, and the direction of "ahead" can change as the person goes around corners of the cube.

    data Field = Field { getMap :: FieldMap, whatsAheadFunc :: Person -> FieldContext Person, whatsAtFunc :: Position -> FieldContext Cell}
    type FieldContext = Reader Field

    This is used in the walkOne function, where the Reader is asked to provide the function for finding the next space, and the function is then used to find the position of the next space walked to.

    walkOne :: Person -> PathElement -> FieldContext Person
    walkOne person (Forward n) 
      | n == 0 = return person
      | otherwise = 
          do whatsAhead <- asks whatsAheadFunc
             person' <- whatsAhead person
             nextCell <- whatsAt (person' ^. position)
             if nextCell == Wall 
             then return person
             else walkOne person' (Forward (n - 1))
    walkOne person Clockwise = return $ person & facing %~ succW
    walkOne person Anticlockwise = return $ person & facing %~ predW

    The niggle here is that finding what's ahead requires two stages: first to get the relevant function, then evaluating that function. I feel there should be a way of combining them into one step, but I couldn't figure it out.

    Finding what's ahead

    This is where it gets complicated. For most moves, the "easy" step is just one position across the map, in the same direction. But for the two embeddings, the "next" cell changes.

    For part 1, the toroidal embedding means finding some combination of  first or last cell in the same row or column, depending on where you're leaving the defined positions. Note the extensive use of lens operations to find the positions I need. I find all four positions, relying on Haskell's laziness to only evaluate the one I need.

    whatsAheadFlat :: Person -> FieldContext Person
    whatsAheadFlat person =
      do let easyNext = (person ^. position) + (deltaOf $ person ^. facing)
         fieldMap <- asks getMap
         if easyNext `M.member` fieldMap
         then return $ person & position .~ easyNext
         else do let currenFacing = person ^. facing
                 let currentRow = person ^. position . _r
                 let currentCol = person ^. position . _c
                 let rightMovingCol = fromJust $ minimumOf (folded . filteredBy (_r . only currentRow) . _c) $ M.keysSet fieldMap
                 let leftMovingCol = fromJust $ maximumOf (folded . filteredBy (_r . only currentRow) . _c) $ M.keysSet fieldMap
                 let upMovingRow = fromJust $ maximumOf (folded . filteredBy (_c . only currentCol) . _r) $ M.keysSet fieldMap
                 let downMovingRow = fromJust $ minimumOf (folded . filteredBy (_c . only currentCol) . _r) $ M.keysSet fieldMap
                 return $ case currenFacing of
                                     Right -> person & position . _c .~ rightMovingCol
                                     Left -> person & position . _c .~ leftMovingCol
                                     Up -> person & position . _r .~ upMovingRow
                                     Down -> person & position . _r .~ downMovingRow

    With the cube embedding, things became more verbose. Of course, I needed a paper model to keep track of all the changes in position and orientation.

    A paper model of my cube embedding, showing face names and ranges for rows and columns. Orientations of faces are implied by the orientation of the writing,
    A paper model of my cube embedding, showing face names and ranges for rows and columns. Orientations of faces are implied by the orientation of the writing,

    The core function isn't too bad: find which face you're on and, if needed, use the crossEdge function to cross the cube's edge. This changes the position and the facing of the person.

    whatsAheadCube :: Person -> FieldContext Person
    whatsAheadCube person =
      do let easyNext = (person ^. position) + (deltaOf $ person ^. facing)
         let currentFace = faceOf (person ^. position)
         let nextFace = faceOf easyNext
         fieldMap <- asks getMap
         if (easyNext `M.member` fieldMap) && (currentFace == nextFace)
         then return $ person & position .~ easyNext
         else return $ crossEdge person currentFace

    Finding which face you're currently on is a series of checks of row and column positions, using the inRange function from Data.Ix (some lines omitted for brevity).

    faceOf :: Position -> Face
    faceOf position
      | (inRange (0, 49) r) && (inRange (50, 99) c) = A
      | (inRange (0, 49) r) && (inRange (100, 149) c) = B
      | (inRange (150, 199) r) && (inRange (0, 49) c) = F
      | otherwise = error "Not a face"
      where r = position ^. _r
            c = position ^. _c

    crossEdge is a hard-coded bunch of rules, each of which deals with one combinaton of face and direction of crossing. See the code for all the gory details (many lines omitted for brevity). The only concession to understandability is the interp (interpolate) function that handles the arithmetic of mapping one range of row or column values to another.

    crossEdge :: Person -> Face -> Person
    crossEdge person face =
      case (d, face) of
        (Up,    A) -> person & position . _r .~ (interpol c 150 199) & position . _c .~ 0 & facing .~ Right
        (Right, A) -> person & position . _c .~ 100
        (Down,  A) -> person & position . _r .~ 50 
        (Left,  A) -> person & position . _r .~ (interpol r 149 100) & position . _c .~ 0 & facing .~ Right
        (Up,    B) -> person & position . _r .~ 199 & position . _c .~ (interpol c 0 49)
        (Up,    C) -> person & position . _r .~ 49
        (Left,  F) -> person & position . _r .~ 0 & position . _c .~ (interpol r 50 99) & facing .~ Down
        otherwise -> error ("Crossing illegal boundary "  ++ show (person, face))
      where r = person ^. position . _r
            c = person ^. position . _c
            d = person ^. facing
            interpol x start end = (signum (end - start)) * (x `mod` 50) + start

    Lenses become useful

    This was a problem that involved a couple of nested structures and lots of small modifications to those structures. This is where lenses start to become useful. The use of operators may make some of the code useful, but the elegance of expressing the notion of "the first cell that exists on this row" makes up for it. This is an example where lenses worked well.


    You can get the code from my locally-hosted Git repo, or from Gitlab.

    Neil Smith

    Read more posts by this author.