Done day 14

diff --git a/advent14/Main.hs b/advent14/Main.hs
new file mode 100644 (file)
index 0000000..8fd259c
--- /dev/null
+++ b/advent14/Main.hs
@@ -0,0 +1,106 @@
+-- Writeup at https://work.njae.me.uk/2024/12/14/advent-of-code-2024-day-14/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Linear
+import Control.Lens
+import Data.Char (intToDigit)
+
+type Position = V2 Int -- x, y
+
+data Robot = Robot { _pos :: Position
+                   , _vel :: Position
+                   }
+  deriving (Show, Eq, Ord)
+makeLenses ''Robot
+
+bounds :: Position
+-- bounds = V2 11 7
+bounds = V2 101 103
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let robots = successfulParse text
+      -- print robots
+      -- putStrLn $ showGrid robots
+      -- let i100 = (!! 100) $ iterate (fmap move) robots
+      -- putStrLn $ showGrid i100
+      -- print $ quadrants i100
+      -- print $ safetyFactor i100
+      print $ part1 robots
+      -- putStrLn $ unlines $ fmap show $ zip [0..] $ fmap (fmap (\r -> r ^. pos . _y)) $ take 104 $ iterate (fmap move) robots
+      print $ filter (\(i, ds) -> length ds > 20) $ fmap diagonals $ zip [0..] $ take 10000 $ iterate (fmap move) robots
+      -- putStrLn $ showGrid $ (!! 6492) $ iterate (fmap move) robots
+      putStrLn $ showGrid $ (!! 6493) $ iterate (fmap move) robots
+      -- putStrLn $ showGrid $ (!! 6495) $ iterate (fmap move) robots
+
+part1 :: [Robot] -> Int
+part1 robots = safetyFactor $ (!! 100) $ iterate (fmap move) robots
+
+move :: Robot -> Robot
+move = teleport . step 
+  where 
+    teleport :: Robot -> Robot
+    teleport r = r & pos . _x .~ (r ^. pos . _x `mod` bounds ^. _x)
+                   & pos . _y .~ (r ^. pos . _y `mod` bounds ^. _y)
+    step :: Robot -> Robot
+    step r = r & pos .~ (r ^. pos ^+^ r ^. vel)
+
+safetyFactor :: [Robot] -> Int
+safetyFactor = product . quadrants 
+
+quadrants :: [Robot] -> [Int]
+quadrants robots = [lu, ru, lb, rb]
+  where u = filter isUpper robots
+        b = filter isLower robots
+        lu = length $ filter isLeft u
+        ru = length $ filter isRight u
+        lb = length $ filter isLeft b
+        rb = length $ filter isRight b
+
+isLeft, isRight, isUpper, isLower :: Robot -> Bool
+isLeft  robot = robot ^. pos . _x < (bounds ^. _x `div` 2)
+isRight robot = robot ^. pos . _x > (bounds ^. _x `div` 2)
+isUpper robot = robot ^. pos . _y < (bounds ^. _y `div` 2)
+isLower robot = robot ^. pos . _y > (bounds ^. _y `div` 2)
+
+showGrid :: [Robot] -> String
+showGrid robots = unlines $ fmap (showRow robots) [0..(bounds^._y)-1]
+  where showRow robots y = [showCell robots (V2 x y) | x <- [0..(bounds^._x)-1]]
+        showCell robots p = if null $ countR robots p then '.' else intToDigit $ length $ countR robots p
+        countR robots p = filter (==p) $ fmap (^.pos) robots
+
+showFrame :: (Int, [Robot]) -> String
+showFrame (i, robots) = unlines $ [("Frame " ++ show i), showGrid robots]
+
+diagonals :: (Int, [Robot]) -> (Int, [Position])
+diagonals (i, robots) = 
+  (i, [ V2 x y 
+      | x <- [0..(bounds^._x)-1], y <- [0..(bounds^._y)-1]
+      , V2 x y `elem` robotPoss
+      , V2 (x-1) (y+1) `elem` robotPoss
+      , V2 (x-2) (y+2) `elem` robotPoss
+      ] )
+  where robotPoss = fmap (^.pos) robots
+
+-- parse the input file
+
+robotsP :: Parser [Robot]
+robotP :: Parser Robot
+posP :: Parser Position
+
+robotsP = robotP `sepBy` endOfLine
+robotP = Robot <$> ("p=" *> posP) <* " " <*> ("v=" *> posP)
+posP = V2 <$> signed decimal <* "," <*> signed decimal
+
+successfulParse :: Text -> [Robot]
+successfulParse input = 
+  case parseOnly robotsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right robots -> robots
+

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 9eef0fddf4146de270ee9d2b67eb19a2a235fb3b..75d093ef4ce1ccb20933f05ce5717cf08dfba768 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -147,4 +147,10 @@ executable advent12orig
 executable advent13
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent13/Main.hs  
-  build-depends: attoparsec, text, linear
\ No newline at end of file
+  build-depends: attoparsec, text, linear
+
+executable advent14
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent14/Main.hs  
+  build-depends: attoparsec, text, linear, lens
+  
\ No newline at end of file