From 433e177136808d7b5821129ff25efe8b79417280 Mon Sep 17 00:00:00 2001
From: Eric Mertens <emertens@gmail.com>
Date: Wed, 1 Jan 2025 10:08:56 -0600
Subject: [PATCH] simplify away facing logic

---
 solutions/src/2022/22_alt.hs | 71 ++++++++++++++----------------------
 1 file changed, 28 insertions(+), 43 deletions(-)

diff --git a/solutions/src/2022/22_alt.hs b/solutions/src/2022/22_alt.hs
index 4ba0533..145eee6 100644
--- a/solutions/src/2022/22_alt.hs
+++ b/solutions/src/2022/22_alt.hs
@@ -32,10 +32,10 @@ coordinates and then is converted back into input file coordinates at the end.
 5031
 
 -}
-module Main where
+module Main (main) where
 
 import Advent (stageTH, format, countBy)
-import Advent.Coord (Coord(..), coordLines, above, below, left, origin, right)
+import Advent.Coord (Coord(..), coordLines, origin, above, below, left, right)
 import Advent.Permutation (Permutation, mkPermutation, invert)
 import Advent.Search (dfsOn)
 import Control.Monad (msum)
@@ -57,7 +57,7 @@ type HiVal = ?hiVal :: Int
 main :: IO ()
 main =
  do (rawmap, path) <- [format|2022 22 (( |.|#)*!%n)*%n(%u|@D)*%n|]
-    
+
     -- figure out the side-length of the cube we're working with
     -- so that we can handle both examples and regular inputs
     let elts = countBy (`elem` ".#") (concat rawmap)
@@ -67,18 +67,16 @@ main =
     let maze = explore (Set.fromList [c | (c, '.') <- coordLines rawmap])
 
     -- figure out the cube coordinate that our path ends on
-    let S endLoc endFacing = fixFacing maze (foldl (applyCommand maze) (S originLoc 0) path)
-    
-    -- translate the cube coordinates back into flat coordinates
-    let C y x = maze Map.! endLoc
+    let endLoc = foldl (flip (applyCommand maze)) locOrigin path
+        (C y x, facing) = findFacing maze endLoc
 
     -- compute the "password" from the end location
-    print (1000 * (y + 1) + 4 * (x + 1) + endFacing)
+    print (1000 * (y + 1) + 4 * (x + 1) + facing)
 
 -- | Given the set of flat path coordinates compute the cube-coordinate
 -- to flat coordinate map.
 explore :: HiVal => Set Coord -> Map Loc Coord
-explore input = Map.fromList (dfsOn snd step (originLoc, Set.findMin input))
+explore input = Map.fromList (dfsOn snd step (locOrigin, Set.findMin input))
   where
     step (l, c) =
       [(locRight l, right c) | right c `Set.member` input] ++
@@ -86,25 +84,22 @@ explore input = Map.fromList (dfsOn snd step (originLoc, Set.findMin input))
       [(locUp    l, above c) | above c `Set.member` input] ++
       [(locDown  l, below c) | below c `Set.member` input]
 
--- | A location on the cube and a direction
-data S = S !Loc !Facing
-
 -- | Apply a command to the state of the walker on the cube.
 -- Each move is either forward a certain number or a turn.
-applyCommand :: HiVal => Map Loc Coord -> S -> Either Int D -> S
-applyCommand maze (S here dir) = \case
-  Left  n -> S (walkN maze n dir here) dir
-  Right t -> S here (turn t dir)
+applyCommand :: HiVal => Map Loc Coord -> Either Int D -> Loc -> Loc
+applyCommand maze = \case
+  Left  n  -> walkN maze n
+  Right DL -> locRotateR
+  Right DR -> locRotateL
 
 -- | Walk a number of steps in the given direction
-walkN :: HiVal => Map Loc Coord -> Int -> Facing -> Loc -> Loc
-walkN maze n dir here = last (takeWhile valid (take (n + 1) (iterate (move dir) here)))
-  where valid = isJust . onMaze maze
+walkN :: HiVal => Map Loc Coord -> Int -> Loc -> Loc
+walkN maze n = last . takeWhile (isJust . onMaze maze) . take (n + 1) . iterate locRight
 
 -- | Find the location in the input file corresponding to this
 -- cube location if one exists.
 onMaze :: HiVal => Map Loc Coord -> Loc -> Maybe Coord
-onMaze maze loc = msum (map (`Map.lookup` maze) (take 4 (iterate locRotate loc)))
+onMaze maze = msum . map (`Map.lookup` maze) . take 4 . iterate locRotateR
 
 -- | Symmetric group S4 corresponds to the symmetries of a cube.
 type S4 = Permutation 4
@@ -119,10 +114,10 @@ data Loc = Loc { locFace :: S4, locCoord :: Coord }
   deriving (Show, Ord, Eq)
 
 -- | Initial location on the top-left or a face.
-originLoc :: Loc
-originLoc = Loc mempty origin
+locOrigin :: Loc
+locOrigin = Loc mempty origin
 
-locRight, locLeft, locUp, locDown, locRotate :: HiVal => Loc -> Loc
+locRight, locLeft, locUp, locDown, locRotateL, locRotateR :: HiVal => Loc -> Loc
 locRight (Loc p (C y x))
   | x < ?hiVal = Loc p (C y (x + 1))
   | otherwise = Loc (p <> invert rotY) (C y 0)
@@ -139,26 +134,16 @@ locUp (Loc p (C y x))
   | 0 < y = Loc p (C (y - 1) x)
   | otherwise = Loc (p <> invert rotX) (C ?hiVal x)
 
--- Rotate the representation of the current location 90-degrees
--- clockwise in order to put it onto a symmetric cube-face.
-locRotate (Loc p (C y x)) = Loc (p <> rotZ) (C x (?hiVal - y))
+locRotateR (Loc p (C y x)) = Loc (p <> rotZ) (C x (?hiVal - y))
+
+locRotateL (Loc p (C y x)) = Loc (p <> invert rotZ) (C (?hiVal - x) y)
 
 -- | Rotate the facing until we're on the cube face as it
 -- is oriented on the input text.
-fixFacing :: HiVal => Map Loc Coord -> S -> S
-fixFacing maze (S loc n)
-  | Map.member loc maze = S loc n
-  | otherwise = fixFacing maze (S (locRotate loc) (turn DR n))
-
-type Facing = Int
-
-turn :: D -> Facing -> Facing
-turn DL x = (x - 1) `mod` 4
-turn DR x = (x + 1) `mod` 4
-
-move :: HiVal => Facing -> Loc -> Loc
-move 0 = locRight
-move 1 = locDown
-move 2 = locLeft
-move 3 = locUp
-move _ = error "move: bad facing"
+findFacing :: HiVal => Map Loc Coord -> Loc -> (Coord, Int)
+findFacing maze = go 0
+  where
+    go n loc =
+      case Map.lookup loc maze of
+        Just c -> (c, n)
+        Nothing -> go (n + 1) (locRotateR loc)