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
|
import Data.Array
data Tile = Empty | Box | Wall deriving Eq
type Map = Array (Int,Int) Tile
data Direction = North | South | East | West
type State = ((Int,Int), Map)
neighbour :: Direction -> (Int,Int) -> (Int,Int)
neighbour North (x,y) = (x,y-1)
neighbour South (x,y) = (x,y+1)
neighbour West (x,y) = (x-1,y)
neighbour East (x,y) = (x+1,y)
doMove :: Map -> (Int,Int) -> (Int,Int) -> Map
doMove m p0 p1 = m // [ (p0,Empty), (p1,Box) ]
moveBox :: Map -> Direction -> (Int,Int) -> Maybe Map
moveBox m dir p = let n = neighbour dir p
in case m ! n of
Empty -> Just $ doMove m p n
Wall -> Nothing
Box -> do m' <- moveBox m dir n ; return (doMove m' p n)
moveRobot :: State -> Direction -> State
moveRobot (pos, m) dir = let n = neighbour dir pos
in case m ! n of
Empty -> (n, m)
Wall -> (pos, m)
Box -> case moveBox m dir n of
Nothing -> (pos, m)
Just m' -> (n, m')
parseMap :: [String] -> Map
parseMap s = let w = length $ head s
h = length s
in array ((0,0), (w-1, h-1))
[ ((x,y), f (s!!y!!x)) | x <- [0..w-1], y <- [0..h-1] ]
where
f :: Char -> Tile
f '.' = Empty
f '@' = Empty
f '#' = Wall
f 'O' = Box
f _ = undefined
findRobot :: [String] -> (Int,Int)
findRobot s = let w = length $ head s
h = length s
in head [ (x,y)
| x <- [0..w-1]
, y <- [0..h-1]
, s!!y!!x == '@'
]
parseState :: [String] -> State
parseState s = let pos = findRobot s
m = parseMap s
in (pos,m)
parseDirections :: String -> [Direction]
parseDirections = let f '^' = North
f 'v' = South
f '>' = East
f '<' = West
f _ = undefined
in map f
parseInput :: String -> (State,[Direction])
parseInput s = let (xs, ys) = break null $ lines s
in (parseState xs, parseDirections $ concat ys)
run :: State -> [Direction] -> State
run = foldl moveRobot
gps :: (Int,Int) -> Int
gps (x,y) = 100 * y + x
score :: Map -> Int
score = sum . map (gps . fst) . filter ((== Box) . snd) . assocs
main :: IO ()
main = do
input <- getContents
let (start, directions) = parseInput input
let (_,end) = run start directions
print $ score end
|