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.

Representations

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.

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.

Code

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