Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# language RecordWildCards #-}
- import Control.Arrow ((&&&))
- import Data.List (foldl')
- import Data.Maybe (listToMaybe)
- data Action = North | South | East | West | TurnLeft | TurnRight | Forward deriving (Eq, Show)
- data Instruction = MkInstruction { action :: Action, value :: Int } deriving (Eq, Show)
- parseLine :: String -> Maybe Instruction
- parseLine [] = Nothing
- parseLine (d:n) = MkInstruction <$> charAction d <*> fmap fst (listToMaybe $ reads n)
- charAction :: Char -> Maybe Action
- charAction 'N' = pure North
- charAction 'S' = pure South
- charAction 'E' = pure East
- charAction 'W' = pure West
- charAction 'L' = pure TurnLeft
- charAction 'R' = pure TurnRight
- charAction 'F' = pure Forward
- charAction _ = Nothing
- data Ship =
- MkShip
- { xPos :: Int
- , yPos :: Int
- , xDir :: Int
- , yDir :: Int
- } deriving (Eq, Show)
- initShip :: Ship
- initShip = MkShip{ xPos = 0, yPos = 0, xDir = 1, yDir = 0 }
- applyShipInstruction :: Instruction -> Ship -> Ship
- applyShipInstruction MkInstruction{ action = North, value = delta } s = s{ yPos = yPos s + delta }
- applyShipInstruction MkInstruction{ action = South, value = delta } s = s{ yPos = yPos s - delta }
- applyShipInstruction MkInstruction{ action = East, value = delta } s = s{ xPos = xPos s + delta }
- applyShipInstruction MkInstruction{ action = West, value = delta } s = s{ xPos = xPos s - delta }
- applyShipInstruction MkInstruction{ action = TurnLeft, value = degrees } s =
- foldr ($) s $ replicate (degrees `quot` 90) oneLeft
- where oneLeft ss = ss{ xDir = negate $ yDir ss, yDir = xDir ss }
- applyShipInstruction MkInstruction{ action = TurnRight, value = degrees } s =
- foldr ($) s $ replicate (degrees `quot` 90) oneRight
- where oneRight ss = ss{ xDir = yDir ss, yDir = negate $ xDir ss }
- applyShipInstruction MkInstruction{ action = Forward, value = scale } s =
- s{ xPos = xPos s + scale * xDir s, yPos = yPos s + scale * yDir s }
- shipManhattan :: Ship -> Int
- shipManhattan MkShip{..} = abs xPos + abs yPos
- part1 :: [Instruction] -> Int
- part1 = shipManhattan . foldl' (flip applyShipInstruction) initShip
- initWaypoint :: Waypoint
- initWaypoint = MkWaypoint { xWay = 10, yWay = 1 }
- data Waypoint = MkWaypoint { xWay :: Int, yWay :: Int } deriving (Eq, Show)
- applyWaypointedInstruction :: Instruction -> (Ship, Waypoint) -> (Ship, Waypoint)
- applyWaypointedInstruction MkInstruction{ action = North, value = delta } (s, w) =
- (s, w{ yWay = yWay w + delta })
- applyWaypointedInstruction MkInstruction{ action = South, value = delta } (s, w) =
- (s, w{ yWay = yWay w - delta })
- applyWaypointedInstruction MkInstruction{ action = East, value = delta } (s, w) =
- (s, w{ xWay = xWay w + delta })
- applyWaypointedInstruction MkInstruction{ action = West, value = delta } (s, w) =
- (s, w{ xWay = xWay w - delta })
- applyWaypointedInstruction MkInstruction{ action = TurnLeft, value = degrees } (s, w) =
- (s, foldr ($) w $ replicate (degrees `quot` 90) oneLeft)
- where oneLeft ww = ww{ xWay = negate $ yWay ww, yWay = xWay ww }
- applyWaypointedInstruction MkInstruction{ action = TurnRight, value = degrees } (s, w) =
- (s, foldr ($) w $ replicate (degrees `quot` 90) oneRight)
- where oneRight ww = ww{ xWay = yWay ww, yWay = negate $ xWay ww }
- applyWaypointedInstruction MkInstruction{ action = Forward, value = scale } (s, w) =
- (s{ xPos = xPos s + scale * xWay w, yPos = yPos s + scale * yWay w}, w)
- part2 :: [Instruction] -> Int
- part2 = shipManhattan . fst . foldl' (flip applyWaypointedInstruction) (initShip, initWaypoint)
- interactive :: Show a => (String -> a) -> IO ()
- interactive f = getContents >>= print . f
- main :: IO ()
- main = interactive (fmap (part1 &&& part2) . traverse parseLine . lines)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement