Better solution for day 14

diff --git a/advent14/Main.hs b/advent14/Main.hs
index 87e6f59ec42de0f7381005086fe3beea866dc9af..17aca73c20cb2aa9e8a596a7d32c27cdebb275cd 100644 (file)
--- a/advent14/Main.hs
+++ b/advent14/Main.hs
@@ -8,6 +8,8 @@ import Data.Attoparsec.Text hiding (take)
 import Linear
 import Control.Lens
 import Data.Char (intToDigit)
+import Data.List
+import Data.Function
 
 type Position = V2 Int -- x, y
 
@@ -26,21 +28,15 @@ 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
+      print $ part2 robots
 
-part1 :: [Robot] -> Int
+part1, part2 :: [Robot] -> Int
 part1 robots = safetyFactor $ (!! 100) $ iterate (fmap move) robots
+part2 robots = fst $ minimumBy (compare `on` snd) 
+                   $ take 10000 $ zip [0..] 
+                   $ fmap safetyFactor 
+                   $ iterate (fmap move) robots
 
 move :: Robot -> Robot
 move = teleport . step 
@@ -69,24 +65,14 @@ 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
+-- 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]
 
 -- parse the input file
 

diff --git a/advent14/MainOriginal.hs b/advent14/MainOriginal.hs
new file mode 100644 (file)
index 0000000..87e6f59
--- /dev/null
+++ b/advent14/MainOriginal.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 890db95342da16d6fbc13e1ac5326912c4fc9328..dcde33dca364fcb2141aa6acf404ba703a79d7e6 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -164,6 +164,10 @@ executable advent14
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent14/Main.hs  
   build-depends: attoparsec, text, linear, lens
+executable advent14orig
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent14/MainOriginal.hs  
+  build-depends: attoparsec, text, linear, lens
 
 executable advent15
   import: warnings, common-extensions, build-directives, common-modules