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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
-- requires cabal install --lib megaparsec parser-combinators vector
module Main (main) where
import Control.Monad (void, when)
import Data.Functor
import Data.List qualified as L
import Data.Maybe
import Data.Vector qualified as V
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
import System.Exit (die)
exampleExpectedOutput = 5031
type Line = V.Vector Char
type Map = V.Vector Line
data Instruction = Move Int | L | R deriving Show
data Input = Input Map [Instruction] deriving Show
type Parser = Parsec Void String
parseMapLine :: Parser Line
parseMapLine = do
line <- some (char '.' <|> char ' ' <|> char '#') <* char '\n'
return $ V.generate (length line) (line !!)
parseMap :: Parser Map
parseMap = do
lines <- some parseMapLine <* char '\n'
return $ V.generate (length lines) (lines !!)
parseInstruction :: Parser Instruction
parseInstruction = (Move . read <$> some digitChar)
<|> (char 'L' $> L)
<|> (char 'R' $> R)
parseInput' :: Parser Input
parseInput' = do
m <- parseMap
i <- some parseInstruction
void $ optional (char '\n') <* eof
return $ Input m i
parseInput :: String -> IO Input
parseInput filename = do
input <- readFile filename
case runParser parseInput' filename input of
Left bundle -> die $ errorBundlePretty bundle
Right input' -> return input'
data Heading = N | S | E | W deriving (Eq, Show)
data Cursor = Cursor Int Int Heading
isOut :: Map -> Int -> Int -> Bool
isOut m x y = isNothing line || isNothing tile || tile == Just ' '
where
line = m V.!? y
tile = fromJust line V.!? x
stepOutside :: Map -> Int -> Int -> Int -> Heading -> Int -> Cursor
stepOutside m s x y h i | (t, h) == (a, N) = proceed fw (fn + rx) E
| (t, h) == (a, W) = proceed dw (ds - ry) E
| (t, h) == (b, N) = proceed (fw + rx) fs N
| (t, h) == (b, E) = proceed ee (es - ry) W
| (t, h) == (b, S) = proceed ce (cn + rx) W
| (t, h) == (c, W) = proceed (dw + ry) dn S
| (t, h) == (c, E) = proceed (bw + ry) bs N
| (t, h) == (d, N) = proceed cw (cn + rx) E
| (t, h) == (d, W) = proceed aw (as - ry) E
| (t, h) == (e, E) = proceed be (bs - ry) W
| (t, h) == (e, S) = proceed fe (fn + rx) W
| (t, h) == (f, W) = proceed (aw + ry) an S
| (t, h) == (f, S) = proceed (bw + rx) bn S
| (t, h) == (f, E) = proceed (ew + ry) es N
where
(tx, rx) = x `divMod` s
(ty, ry) = y `divMod` s
t = (tx, ty)
proceed :: Int -> Int -> Heading -> Cursor
proceed x' y' h' = case m V.! y' V.! x' of
'.' -> step m s (Cursor x' y' h') (Move $ i - 1)
'#' -> Cursor x y h
a = (ax, ay)
b = (bx, by)
c = (cx, cy)
d = (dx, dy)
e = (ex, ey)
f = (fx, fy)
(ax, ay) = (1, 0)
(bx, by) = (2, 0)
(cx, cy) = (1, 1)
(dx, dy) = (0, 2)
(ex, ey) = (1, 2)
(fx, fy) = (0, 3)
(an, as, aw, ae) = (ay * s, (ay+1)*s-1, ax *s, (ax+1)*s-1)
(bn, bs, bw, be) = (by * s, (by+1)*s-1, bx *s, (bx+1)*s-1)
(cn, cs, cw, ce) = (cy * s, (cy+1)*s-1, cx *s, (cx+1)*s-1)
(dn, ds, dw, de) = (dy * s, (dy+1)*s-1, dx *s, (dx+1)*s-1)
(en, es, ew, ee) = (ey * s, (ey+1)*s-1, ex *s, (ex+1)*s-1)
(fn, fs, fw, fe) = (fy * s, (fy+1)*s-1, fx *s, (fx+1)*s-1)
step :: Map -> Int -> Cursor -> Instruction -> Cursor
step _ _ (Cursor x y N) L = Cursor x y W
step _ _ (Cursor x y S) L = Cursor x y E
step _ _ (Cursor x y E) L = Cursor x y N
step _ _ (Cursor x y W) L = Cursor x y S
step _ _ (Cursor x y N) R = Cursor x y E
step _ _ (Cursor x y S) R = Cursor x y W
step _ _ (Cursor x y E) R = Cursor x y S
step _ _ (Cursor x y W) R = Cursor x y N
step m _ c (Move 0) = c
step m s (Cursor x y h) (Move i) | isOut m x' y' = stepOutside m s x y h i
| tile == '.' = step m s (Cursor x' y' h) (Move $ i - 1)
| tile == '#' = Cursor x y h
where
(x', y') = case h of
N -> (x, y-1)
S -> (x, y+1)
E -> (x+1, y)
W -> (x-1, y)
tile = m V.! y' V.! x'
compute :: Input -> Int
compute (Input m i) = 1000 * (y+1) + 4 * (x+1) + hv
where
xmin = length (V.filter (== ' ') (m V.! 0))
startingCursor = Cursor xmin 0 E
s = length (m V.! 0) `div` 3
Cursor x y h = L.foldl' (step m s) startingCursor i
hv = case h of
E -> 0
S -> 1
W -> 2
N -> 3
main :: IO ()
main = do
-- not doing the example, this solution is dependent on the shape of the input cube and sadly the example does not match it
-- example <- parseInput "example"
-- let exampleOutput = compute example
-- when (exampleOutput /= exampleExpectedOutput) (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
input <- parseInput "input"
print $ compute input
|
