15-1

1 files changed, 89 insertions, 0 deletions

diff --git a/15-1.hs b/15-1.hs
new file mode 100644
index 0000000..69f5b14
--- /dev/null
+++ b/15-1.hs
@@ -0,0 +1,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