summaryrefslogtreecommitdiff
path: root/2020/12.hs
diff options
context:
space:
mode:
Diffstat (limited to '2020/12.hs')
-rw-r--r--2020/12.hs78
1 files changed, 78 insertions, 0 deletions
diff --git a/2020/12.hs b/2020/12.hs
new file mode 100644
index 0000000..92ce67c
--- /dev/null
+++ b/2020/12.hs
@@ -0,0 +1,78 @@
+module Main where
+
+import Data.List (foldl')
+
+import Input
+
+
+data V2 a = V2 a a deriving (Show)
+
+data M2 a = M2 a a a a deriving (Show)
+
+class LinMappable v where
+ vfmap :: (a -> b) -> v a -> v b
+ vzip :: (a -> b -> c) -> v a -> v b -> v c
+ vzero :: Num a => v a
+instance LinMappable V2 where
+ vfmap f (V2 a b) = V2 (f a) (f b)
+ vzip f (V2 a b) (V2 a' b') = V2 (f a a') (f b b')
+ vzero = V2 0 0
+instance LinMappable M2 where
+ vfmap f (M2 a b c d) = M2 (f a) (f b) (f c) (f d)
+ vzip f (M2 a b c d) (M2 a' b' c' d') = M2 (f a a') (f b b') (f c c') (f d d')
+ vzero = M2 0 0 0 0
+
+(!+!) :: (LinMappable v, Num a) => v a -> v a -> v a
+(!+!) = vzip (+)
+
+dot :: Num a => V2 a -> V2 a -> a
+dot (V2 a b) (V2 c d) = a * c + b * d
+
+(*$) :: (LinMappable v, Num a) => v a -> a -> v a
+v *$ s = vfmap (* s) v
+
+(*!) :: Num a => M2 a -> V2 a -> V2 a
+M2 a b c d *! v = V2 (V2 a b `dot` v) (V2 c d `dot` v)
+
+-- mathematical axes: X faces east, Y faces north
+-- Shift v: pos = pos + v
+-- Sail v m1 m2: direction' = m1 *! direction; pos = pos + v + m2 *! direction'
+data Instr = Sail (V2 Int) (M2 Int) (M2 Int)
+ deriving (Show)
+
+parseInstr :: String -> Instr
+parseInstr (c : ns) = case (c, read ns :: Int) of
+ ('N', n) -> Sail (V2 0 1 *$ n) idMat vzero
+ ('S', n) -> Sail (V2 0 (-1) *$ n) idMat vzero
+ ('E', n) -> Sail (V2 1 0 *$ n) idMat vzero
+ ('W', n) -> Sail (V2 (-1) 0 *$ n) idMat vzero
+ ('F', n) -> Sail vzero idMat (M2 1 0 0 1 *$ n)
+ ('R', 90) -> Sail vzero rotRightMat vzero
+ ('R', 180) -> Sail vzero mirrorMat vzero
+ ('R', 270) -> Sail vzero rotLeftMat vzero
+ ('L', 90) -> Sail vzero rotLeftMat vzero
+ ('L', 180) -> Sail vzero mirrorMat vzero
+ ('L', 270) -> Sail vzero rotRightMat vzero
+ _ -> error "Cannot parse instr"
+ where
+ idMat = M2 1 0 0 1
+ rotRightMat = M2 0 1 (-1) 0
+ rotLeftMat = rotRightMat *$ (-1)
+ mirrorMat = idMat *$ (-1)
+parseInstr _ = error "Cannot parse empty instr"
+
+data State = State { sPos :: V2 Int, sDir :: V2 Int }
+ deriving (Show)
+
+sail :: Instr -> State -> State
+sail (Sail offset dirm posm) (State pos dir) =
+ let dir' = dirm *! dir
+ in State (pos !+! offset !+! (posm *! dir')) dir'
+
+manhattan :: Num a => V2 a -> a
+manhattan (V2 a b) = abs a + abs b
+
+main :: IO ()
+main = do
+ input <- map parseInstr <$> getInput 12
+ print (manhattan . sPos $ foldl' (flip sail) (State (V2 0 0) (V2 1 0)) input)