14-1

1 files changed, 97 insertions, 0 deletions

diff --git a/14-1.hs b/14-1.hs
new file mode 100644
index 0000000..8044c8d
--- /dev/null
+++ b/14-1.hs
@@ -0,0 +1,97 @@
+import Data.Maybe (fromMaybe)
+import Text.Parsec
+import Text.Parsec.Char
+
+data Vec = Vec Int Int deriving Show
+
+data Robot = Robot { pos :: Vec, vel :: Vec } deriving Show
+
+data Conf = Conf { width :: Int, height :: Int}
+
+doParse :: String -> [Robot]
+doParse s = case parse inputp "" s of
+  Left e   -> error $ show e
+  Right xs -> xs
+
+inputp :: Parsec String () [Robot]
+inputp = sepBy robotp newline
+
+robotp :: Parsec String () Robot
+robotp = Robot
+  <$> posp
+  <*  char ' '
+  <*> velp
+
+posp :: Parsec String () Vec
+posp = Vec
+  <$  string "p="
+  <*> number
+  <*  char ','
+  <*> number
+
+velp :: Parsec String () Vec
+velp = Vec
+  <$  string "v="
+  <*> number
+  <*  char ','
+  <*> number
+
+number :: Parsec String () Int
+number = ((read .) . (:)) . fromMaybe '0'
+  <$> optionMaybe (char '-')
+  <*> many1 digit
+
+update :: Conf -> Robot -> Robot
+update c (Robot (Vec x y) v@(Vec vx vy)) = wrap c $ Robot (Vec (x+vx) (y+vy)) v
+
+wrap :: Conf -> Robot -> Robot
+wrap c = wrapH c . wrapV c
+
+wrapH :: Conf -> Robot -> Robot
+wrapH c r  | tooLeft c r  = wrapRight c r
+           | tooRight c r = wrapLeft c r
+           | otherwise    = r
+  where
+    tooLeft _ (Robot (Vec x _) _) = x < 0
+    tooRight (Conf w _) (Robot (Vec x _) _) = x >= w
+    
+    wrapRight (Conf w _) r@(Robot (Vec x y) _) = r { pos = Vec (x+w) y }
+    wrapLeft (Conf w _) r@(Robot (Vec x y) _) = r { pos = Vec (x-w) y }
+
+wrapV :: Conf -> Robot -> Robot
+wrapV c r | tooHigh c r = wrapDown c r
+          | tooLow  c r = wrapUp c r
+          | otherwise   = r
+  where
+    tooHigh _ (Robot (Vec _ y) _) = y < 0
+    tooLow (Conf _ h) (Robot (Vec _ y) _) = y >= h
+
+    wrapDown (Conf _ h) r@(Robot (Vec x y) _) = r { pos = Vec x (y+h) }
+    wrapUp (Conf _ h) r@(Robot (Vec x y) _) = r { pos = Vec x (y-h) }
+
+within :: (Int,Int) -> (Int,Int) -> Robot -> Bool
+within (x0,x1) (y0,y1) (Robot (Vec x y) _) =
+  x >= x0 && x < x1 && y >= y0 && y < y1
+
+score :: Conf -> [Robot] -> Int
+score (Conf w h) rs =
+  let leftHalf  = w `div` 2
+      rightHalf = leftHalf + 1
+      topHalf   = h `div` 2
+      botHalf   = topHalf + 1
+      q1 = filter (within (0,leftHalf) (0,topHalf)) rs
+      q2 = filter (within (rightHalf,w) (0,topHalf)) rs
+      q3 = filter (within (0,leftHalf) (botHalf,h)) rs
+      q4 = filter (within (rightHalf,w) (botHalf,h)) rs
+  in  product $ map length [q1,q2,q3,q4]
+
+main :: IO ()
+main = do
+  input <- getContents
+  let conf = Conf 101 103
+  print
+    . score conf
+    . (!! 100)
+    . iterate (map (update conf))
+    . doParse
+    $ input