summaryrefslogtreecommitdiff
path: root/15-1.hs
blob: 69f5b14f09f9a4a569174b541efa682af5a5b09e (plain)
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