initial commit HEAD master

1 files changed, 91 insertions, 0 deletions

diff --git a/Part1.hs b/Part1.hs
new file mode 100644
index 0000000..6b244c6
--- /dev/null
+++ b/Part1.hs
@@ -0,0 +1,91 @@
+module Main where
+
+import System.Environment
+import Data.Char
+import Data.List
+import Debug.Trace
+
+import Data.Maybe
+
+import Prelude hiding (Left, Right)
+
+data Facing = Right | Down | Left | Up deriving (Show, Enum)
+
+
+clockwise :: Facing -> Facing
+counterclockwise :: Facing -> Facing
+clockwise Up = Right
+clockwise Right = Down
+clockwise Down = Left
+clockwise Left = Up
+
+counterclockwise = foldl (.) id $ replicate 3 clockwise
+
+data Tile = Open | Wall | Empty deriving (Show,Eq)
+parseTile :: Char -> Tile
+parseTile '.' = Open
+parseTile '#' = Wall
+parseTile ' ' = Empty
+
+data Map = Map {
+  tiles :: [[Tile]],
+  width :: Int,
+  height :: Int
+} deriving Show
+data Position = Position (Int, Int) Facing deriving Show
+
+data Instruction = MoveInstruction Int | RotateL | RotateR deriving Show
+
+parseInstructions :: String -> [Instruction]
+parseInstructions [] = []
+parseInstructions ('R':xs) = RotateR:parseInstructions xs
+parseInstructions ('L':xs) = RotateL:parseInstructions xs
+parseInstructions s = let x = span isDigit s in MoveInstruction (read (fst x) :: Int):parseInstructions (snd x)
+
+parse :: String -> IO (Map, [Instruction])
+parse f = do
+  content <- lines <$> readFile f
+  let tiles = map (map parseTile) (take (length content - 2) content)
+  return (Map tiles (foldr (max.length) 0 tiles) $ length tiles , reverse $ parseInstructions $ last content)
+
+runInstruction :: Map -> Instruction -> Position -> Position
+runInstruction m (MoveInstruction n)    p = fromMaybe p $ move n p m
+runInstruction _ RotateR (Position p r) = Position p $ clockwise r
+runInstruction _ RotateL (Position p r) = Position p $ counterclockwise r
+
+nextPosition :: Position -> Position
+nextPosition (Position (x,y) Up)    = Position (x,y-1) Up
+nextPosition (Position (x,y) Down)  = Position (x,y+1) Down
+nextPosition (Position (x,y) Left)  = Position (x-1,y) Left
+nextPosition (Position (x,y) Right) = Position (x+1,y) Right
+
+wrapPosition :: Map -> Position -> Position
+wrapPosition m (Position (x,y) r) = Position (x', y') r
+  where
+    y' = y `mod` height m
+    x' = x `mod` width m
+
+move :: Int -> Position -> Map -> Maybe Position
+move 1 p m = case tile of
+  Open -> Just p'
+  Wall -> Nothing
+  Empty -> move 1 p' m
+  where
+    p' = wrapPosition m $ nextPosition p
+    (Position (x,y) _) = p'
+    row = tiles m !! y
+    tile = if x < length row then row !! x else Empty
+move n p m = Just $ fromMaybe p' $ move (n-1) p' m
+  where p' = fromMaybe p $ move 1 p m
+
+runInstructions ::  Map -> Position -> [Instruction] -> Position
+runInstructions = foldr . runInstruction
+
+main :: IO ()
+main = do
+  args <- getArgs
+  (map, instructions) <- parse (head args)
+  let starting = maybe undefined ((`Position` Right).(,0)) $ elemIndex Open (head (tiles map))
+  let (Position (x,y) r) = runInstructions map starting instructions
+  let n = (1000 * (y+1)) +  (4 * (x+1)) + fromEnum r
+  print n