6-1

1 files changed, 72 insertions, 0 deletions

diff --git a/6-1.hs b/6-1.hs
new file mode 100644
index 0000000..a164f8b
--- /dev/null
+++ b/6-1.hs
@@ -0,0 +1,72 @@
+import Control.Monad (unless)
+import Control.Monad.Writer
+import Data.List (nub)
+
+type Map = [[Tile]]
+data Tile = Free | Obstacle deriving (Eq)
+data Coords = Coords Int Int deriving (Eq, Show)
+type Vel = Coords
+
+width, height :: [[a]] -> Int
+width = length . head
+height = length
+
+map2 :: (a -> b) -> [[a]] -> [[b]]
+map2 = map . map
+
+sub :: Map -> Coords -> Tile
+sub m c@(Coords x y)
+  | outOfBounds m c = Free
+  | otherwise = m !! y !! x
+
+parseLines :: [[Char]] -> Map
+parseLines =
+  let p c = case c of
+              '#' -> Obstacle
+              _   -> Free
+  in map2 p
+
+startingPosition :: [[Char]] -> Coords
+startingPosition = head . coords . map2 (== '^')
+  where
+    coords :: [[Bool]] -> [Coords]
+    coords xs = [ Coords x y | x <- [0 .. width xs  - 1]
+                             , y <- [0 .. height xs - 1]
+                             , xs !! y !! x
+                             ]
+
+move :: Vel -> Coords -> Coords
+move (Coords vx vy) (Coords px py) = Coords (px + vx) (py + vy)
+
+checkAhead :: Map -> Vel -> Coords -> Bool
+checkAhead m = (((== Free) . sub m) .) . move
+
+turn :: Vel -> Coords -> (Coords, Vel)
+turn v p = let rot (Coords x y) = Coords (-y) x
+               v' = rot v
+  in (move v' p, v')
+
+step :: Map -> Vel -> Coords -> (Coords, Vel)
+step m v p = if checkAhead m v p
+  then (move v p, v)
+  else turn v p
+
+outOfBounds :: Map -> Coords -> Bool
+outOfBounds m (Coords x y) = x < 0 || x >= w || y < 0 || y >= h
+  where
+    w = width m
+    h = height m
+
+run :: Map -> Vel -> Coords -> Writer [Coords] ()
+run m v p = unless (outOfBounds m p) $ do
+  tell [p]
+  let (p', v') = step m v p
+    in run m v' p'
+
+main :: IO ()
+main = do
+  ls <- lines <$> getContents
+  let m = parseLines ls
+  let p = startingPosition ls
+  let v = Coords 0 (-1)
+  print . length . nub . execWriter $ run m v p