Skip to content

Commit

Permalink
simplify away facing logic
Browse files Browse the repository at this point in the history
  • Loading branch information
glguy committed Jan 1, 2025
1 parent d906ebb commit 433e177
Showing 1 changed file with 28 additions and 43 deletions.
71 changes: 28 additions & 43 deletions solutions/src/2022/22_alt.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -67,44 +67,39 @@ 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] ++
[(locLeft l, left c) | left c `Set.member` 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
Expand All @@ -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)
Expand All @@ -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)

0 comments on commit 433e177

Please sign in to comment.