1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
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
------------
-- PART 2 --
------------
data State2 = State2 { sPos2 :: V2 Int, sWP :: V2 Int }
deriving (Show)
runInstr2 :: String -> State2 -> State2
runInstr2 (c : ns) = case (c, read ns :: Int) of
('N', n) -> addWP (V2 0 n)
('S', n) -> addWP (V2 0 (-n))
('E', n) -> addWP (V2 n 0)
('W', n) -> addWP (V2 (-n) 0)
('F', n) -> \(State2 ship wp) -> State2 (ship !+! (wp *$ n)) wp
('R', 90) -> mulWP rotRightMat
('R', 180) -> mulWP mirrorMat
('R', 270) -> mulWP rotLeftMat
('L', 90) -> mulWP rotLeftMat
('L', 180) -> mulWP mirrorMat
('L', 270) -> mulWP rotRightMat
_ -> error "Cannot parse instr"
where
rotRightMat = M2 0 1 (-1) 0
rotLeftMat = rotRightMat *$ (-1)
mirrorMat = M2 (-1) 0 0 (-1)
addWP v (State2 ship wp) = State2 ship (wp !+! v)
mulWP m (State2 ship wp) = State2 ship (m *! wp)
runInstr2 _ = error "Cannot parse empty instr"
main :: IO ()
main = do
input <- getInput 12
print (manhattan . sPos $ foldl' (flip sail) (State (V2 0 0) (V2 1 0)) (map parseInstr input))
print (manhattan . sPos2 $ foldl' (flip runInstr2) (State2 (V2 0 0) (V2 10 1)) input)
|
