76 lines
2.3 KiB
Haskell
76 lines
2.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Aoc.Y2020.D12
|
|
( day
|
|
) where
|
|
|
|
import Data.Foldable
|
|
|
|
import Aoc.Day
|
|
import Aoc.Parse
|
|
|
|
data Pos = Pos Int Int
|
|
data Rot = RLeft | RRight | RFlip
|
|
|
|
data Move
|
|
= MTranslate Pos Int
|
|
| MForward Int
|
|
| MRotate Rot
|
|
|
|
parser :: Parser [Move]
|
|
parser = manyLines
|
|
$ (MTranslate <$> pDir <*> decimal)
|
|
<|> (MForward <$> (char 'F' *> decimal))
|
|
<|> (MRotate <$> pRot)
|
|
where
|
|
pDir = foldr1 (<|>) [ Pos 0 (-1) <$ char 'N'
|
|
, Pos 1 0 <$ char 'E'
|
|
, Pos 0 1 <$ char 'S'
|
|
, Pos (-1) 0 <$ char 'W'
|
|
]
|
|
pRot = foldr1 (<|>) [ RLeft <$ (string "L90" <|> string "R270")
|
|
, RRight <$ (string "L270" <|> string "R90")
|
|
, RFlip <$ (string "L180" <|> string "R180")
|
|
]
|
|
|
|
add :: Pos -> Pos -> Pos
|
|
add (Pos x1 y1) (Pos x2 y2) = Pos (x1 + x2) (y1 + y2)
|
|
|
|
mul :: Int -> Pos -> Pos
|
|
mul a (Pos x y) = Pos (a * x) (a * y)
|
|
|
|
manhattan :: Pos -> Int
|
|
manhattan (Pos x y) = abs x + abs y
|
|
|
|
rotate :: Rot -> Pos -> Pos
|
|
rotate RRight (Pos x y) = Pos (-y) x
|
|
rotate RLeft (Pos x y) = Pos y (-x)
|
|
rotate RFlip (Pos x y) = Pos (-x) (-y)
|
|
|
|
data State = State Pos Pos -- Ship, direction/waypoint
|
|
|
|
step1 :: Move -> State -> State
|
|
step1 (MTranslate dir steps) (State spos sdir) = State (add spos $ mul steps dir) sdir
|
|
step1 (MForward steps) (State spos sdir) = State (add spos $ mul steps sdir) sdir
|
|
step1 (MRotate rot) (State spos sdir) = State spos (rotate rot sdir)
|
|
|
|
step2 :: Move -> State -> State
|
|
step2 (MTranslate dir steps) (State spos wp) = State spos (add wp $ mul steps dir)
|
|
step2 (MForward steps) (State spos wp) = State (add spos $ mul steps wp) wp
|
|
step2 (MRotate rot) (State spos wp) = State spos (rotate rot wp)
|
|
|
|
solver :: [Move] -> IO ()
|
|
solver moves = do
|
|
putStrLn ">> Part 1"
|
|
let initialState1 = State (Pos 0 0) (Pos 1 0)
|
|
(State pos1 _) = foldl' (flip step1) initialState1 moves
|
|
print $ manhattan pos1
|
|
|
|
putStrLn ""
|
|
putStrLn ">> Part 2"
|
|
let initialState2 = State (Pos 0 0) (Pos 10 (-1))
|
|
(State pos2 _) = foldl' (flip step2) initialState2 moves
|
|
print $ manhattan pos2
|
|
|
|
day :: Day
|
|
day = dayParse parser solver
|