Done day 18

diff --git a/advent17/Main.hs b/advent17/Main.hs
index 51dccade761c36ce4facc65143d653de895b85e0..d9f5a16eb294d2f491fe441df90dba5f46334106 100644 (file)
--- a/advent17/Main.hs
+++ b/advent17/Main.hs
@@ -1,6 +1,5 @@
 -- Writeup at https://work.njae.me.uk/2024/12/17/advent-of-code-2024-day-17/
 
-
 import AoC
 import Data.Text (Text)
 import qualified Data.Text.IO as TIO

diff --git a/advent18/Main.hs b/advent18/Main.hs
new file mode 100644 (file)
index 0000000..27b59ca
--- /dev/null
+++ b/advent18/Main.hs
@@ -0,0 +1,105 @@
+-- Writeup at https://work.njae.me.uk/2024/12/18/advent-of-code-2024-day-18/
+
+-- import Debug.Trace
+
+import AoC
+import qualified Data.Set as S
+import Data.Ix
+import Data.Maybe
+import Data.List
+import Linear (V2(..), (^+^), (^-^))
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Algorithm.Search
+
+type Position = V2 Int -- x, y
+
+type Corrupted = S.Set Position
+
+data Memory = Memory
+  { corrupted :: Corrupted
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+type Explorer = Position
+
+memoryBounds :: (Position, Position)
+-- memoryBounds = (V2 0 0, V2 6 6)
+memoryBounds = (V2 0 0, V2 70 70)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let bytes = successfulParse text
+      -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- print memory
+      print $ part1 bytes
+      putStrLn $ part2 bytes
+
+part1 :: [Position] -> Int
+part1 bytes = fst $ fromJust path
+  where path = aStar (neighbours memory) 
+                      (transitionCost)
+                      (estimateCost memory) 
+                      (isGoal memory) 
+                      (initial memory)
+        -- memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+        memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+
+part2 :: [Position] -> String
+part2 bytes = showResult $ head $ snd $ head results
+  where 
+    (goods, poss) = splitAt 1024 bytes
+    results = dropWhile ((== True) . fst) $ scanl' go (True, goods) poss
+    go (_, acc) byte = (escapePossible (byte : acc), (byte : acc))
+    showResult (V2 x y) = show x ++ "," ++ show y
+
+escapePossible :: [Position] -> Bool
+escapePossible bytes = isJust path
+  where 
+    memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
+    path = aStar (neighbours memory) 
+                  (transitionCost)
+                  (estimateCost memory) 
+                  (isGoal memory) 
+                  (initial memory)
+
+neighbours :: Memory -> Explorer -> [Explorer]
+neighbours memory explorer = 
+  filter (`S.notMember` memory.corrupted) $
+  filter (inRange memoryBounds) 
+    [ explorer ^+^ d
+    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
+    ]
+
+transitionCost :: Explorer -> Explorer -> Int
+transitionCost _ _ = 1
+
+isGoal :: Memory -> Explorer -> Bool
+isGoal memory e = memory.goal == e
+
+estimateCost :: Memory -> Explorer -> Int
+estimateCost memory e = (abs dr) + (abs dc)
+  where (V2 dr dc) = e ^-^ memory.goal
+
+initial :: Memory -> Explorer
+initial memory = memory.start
+
+-- parse the input file
+
+bytesP :: Parser [Position]
+byteP :: Parser Position
+
+bytesP = byteP `sepBy` endOfLine
+byteP = V2 <$> decimal <* "," <*> decimal
+
+successfulParse :: Text -> [Position]
+successfulParse input = 
+  case parseOnly bytesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right bytes -> bytes

diff --git a/advent18/MainExplorer.hs b/advent18/MainExplorer.hs
new file mode 100644 (file)
index 0000000..8d63149
--- /dev/null
+++ b/advent18/MainExplorer.hs
@@ -0,0 +1,119 @@
+-- Writeup at https://work.njae.me.uk/2024/12/18/advent-of-code-2024-day-18/
+
+-- import Debug.Trace
+
+import AoC
+import qualified Data.Set as S
+import Data.Ix
+import Data.Maybe
+import Data.List
+import Linear (V2(..), (^+^), (^-^))
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import Algorithm.Search
+
+type Position = V2 Int -- x, y
+
+type Corrupted = S.Set Position
+
+data Memory = Memory
+  { corrupted :: Corrupted
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+data Explorer = Explorer
+  { pos :: Position
+  , ct :: Int
+  } 
+  -- deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
+instance Ord Explorer where
+  compare e1 e2 = compare (pos e1) (pos e2)
+  -- compare e1 e2 = case pc of
+  --   EQ -> compare (ct e1) (ct e2)
+  --   _ -> pc
+  --   where pc = compare (pos e1) (pos e2)
+
+-- type Explorer = Position
+
+memoryBounds :: (Position, Position)
+-- memoryBounds = (V2 0 0, V2 6 6)
+memoryBounds = (V2 0 0, V2 70 70)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let bytes = successfulParse text
+      -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+      -- print memory
+      print $ part1 bytes
+      print $ part2 bytes
+
+part1 :: [Position] -> Int
+part1 bytes = fst $ fromJust path
+  where path = aStar (neighbours memory) 
+                      (transitionCost)
+                      (estimateCost memory) 
+                      (isGoal memory) 
+                      (initial memory)
+        -- memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds)
+        memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds)
+
+-- part2 :: [Position] -> String
+part2 bytes = showResult $ head $ snd $ head results
+  where 
+    results = dropWhile ((== True) . fst) $ scanl' go (True, []) bytes
+    -- results = scanl' go (True, []) (take 22 bytes)
+    go (_, acc) byte = (escapePossible (byte : acc), (byte : acc))
+    showResult (V2 x y) = show x ++ "," ++ show y
+
+escapePossible :: [Position] -> Bool
+escapePossible bytes = isJust path
+  where 
+    memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
+    path = aStar (neighbours memory) 
+                  (transitionCost)
+                  (estimateCost memory) 
+                  (isGoal memory) 
+                  (initial memory)
+
+neighbours :: Memory -> Explorer -> [Explorer]
+neighbours memory explorer = 
+  filter ((`S.notMember` memory.corrupted) . pos) $
+  filter ((inRange memoryBounds) . pos)
+    [ explorer {pos = explorer.pos ^+^ d , ct = explorer.ct + 1} 
+    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
+    ]
+
+transitionCost :: Explorer -> Explorer -> Int
+transitionCost _ _ = 1
+
+isGoal :: Memory -> Explorer -> Bool
+isGoal memory e = memory.goal == e.pos
+
+estimateCost :: Memory -> Explorer -> Int
+estimateCost memory e = (abs dx) + (abs dy)
+  where (V2 dx dy) = e.pos ^-^ memory.goal
+
+initial :: Memory -> Explorer
+-- initial memory = Explorer { pos = memory.start }
+initial memory = Explorer { pos = memory.start, ct = 0 }
+
+-- parse the input file
+
+bytesP :: Parser [Position]
+byteP :: Parser Position
+
+bytesP = byteP `sepBy` endOfLine
+byteP = V2 <$> decimal <* "," <*> decimal
+
+successfulParse :: Text -> [Position]
+successfulParse input = 
+  case parseOnly bytesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right bytes -> bytes

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index e89d9c426935c2996180c75396efcdc26bd82f7a..fabde5f4025259c5d11a94661fed17c2469bcbe0 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -172,4 +172,13 @@ executable advent17
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent17/Main.hs
   build-depends: containers, text, attoparsec, mtl
+
+executable advent18
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent18/Main.hs 
+  build-depends: containers, linear, attoparsec, text, search-algorithms
+executable advent18e
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent18/MainExplorer.hs 
+  build-depends: containers, linear, attoparsec, text, search-algorithms
   
\ No newline at end of file