Done day 6

diff --git a/advent05/MainOrdering.hs b/advent05/MainOrdering.hs
index 6ed5b47610898e9266008ee9177bda8478104ef2..11c86d6cb9abecc8436f8cad1595eb821b3c60f9 100644 (file)
--- a/advent05/MainOrdering.hs
+++ b/advent05/MainOrdering.hs
@@ -6,10 +6,10 @@ import qualified Data.Text.IO as TIO
 import Data.Attoparsec.Text 
 -- import Control.Applicative
 import qualified Data.IntMap.Strict as M
-import Data.IntMap.Strict ((!))
+-- import Data.IntMap.Strict ((!))
 import qualified Data.Set as S
 import Data.List
-import Data.Maybe
+-- import Data.Maybe
 
 type Page = Int
 type Rules = M.IntMap (S.Set Page)
@@ -50,7 +50,7 @@ middlePage :: [Page] -> Page
 middlePage b = b !! (length b `div` 2)
 
 sortBook :: Rules -> [Page] -> [Page]
-sortBook rules pages = sortBy (pageOrder rules) pages
+sortBook rules = sortBy (pageOrder rules) 
 
 -- valid :: Rules -> [Page] -> Bool
 -- valid rules book = sortBook rules book == book

diff --git a/advent06/Main.hs b/advent06/Main.hs
new file mode 100644 (file)
index 0000000..db5fbae
--- /dev/null
+++ b/advent06/Main.hs
@@ -0,0 +1,102 @@
+-- Writeup at https://work.njae.me.uk/2024/12/04/advent-of-code-2024-day-4/
+
+import AoC
+import Linear
+import Data.Array.IArray
+-- import Data.Array.Unboxed
+import Data.List
+import Data.Maybe
+import Data.Ix
+
+type Position = V2 Int -- r, c
+type Grid = Array Position Bool
+
+pattern U, D, L, R :: Position
+pattern U = V2 (-1) 0
+pattern D = V2 1 0
+pattern L = V2 0 (-1)
+pattern R = V2 0 1
+
+data Guard = Guard { pos :: Position, dir :: Position }
+  deriving (Show, Eq)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let grid = mkGrid text
+      let start = findStart text
+      let guard = Guard start U
+      print $ part1 grid guard
+      print $ part2 grid guard
+
+
+part1 :: Grid -> Guard -> Int
+part1 grid guard = length $ nub $ walk grid guard
+
+part2 grid guard = length $ filter (isLoop guard []) modifiedGrids
+  where modifiedGrids = [ grid // [ (new, True) ] 
+                        | new <- news -- range (bounds grid)
+                        , new /= guard.pos
+                        ]
+        news = nub $ walk grid guard
+
+turnRight :: Position -> Position
+turnRight U = R
+turnRight R = D
+turnRight D = L
+turnRight L = U
+
+walk :: Grid -> Guard -> [Position]
+walk grid guard = unfoldr (step grid) guard
+
+step :: Grid -> Guard -> Maybe (Position, Guard)
+step grid guard 
+  | not (inRange (bounds grid) guard.pos) = Nothing
+  | not (inRange (bounds grid) ahead) = Just (guard.pos, guard { pos = ahead })
+  | grid ! ahead = Just (guard.pos, guard { dir = turnRight $ guard.dir })
+  | otherwise = Just (guard.pos, guard { pos = ahead })
+  where ahead = guard.pos ^+^ guard.dir
+
+-- isLoop :: Guard -> [Guard] -> Grid -> Bool
+-- isLoop guard trail grid
+--   | isNothing stepped = False
+--   | guard' `elem` trail = True
+--   | otherwise = isLoop guard' (guard:trail) grid
+--   where stepped = step grid guard
+--         (_, guard') = fromJust stepped
+isLoop :: Guard -> [Guard] -> Grid -> Bool
+isLoop guard trail grid
+  | isNothing stepped = False
+  | hasTurned && guard `elem` trail = True
+  | hasTurned = isLoop guard' (guard:trail) grid
+  | otherwise = isLoop guard' trail grid
+  where stepped = step grid guard
+        (_, guard') = fromJust stepped
+        hasTurned = guard.dir /= guard'.dir
+
+mkGrid :: String -> Grid
+mkGrid text = listArray ((V2 0 0), (V2 r c)) $ fmap (== '#') $ concat rows
+  where rows = lines text
+        r = length rows - 1
+        c = (length $ head rows) - 1
+
+findStart :: String -> Position
+findStart text = head $ [ V2 r c 
+                       | c <- [0..maxC]
+                       , r <- [0..maxR]
+                       , rows !! r !! c == '^'
+                       ]
+  where rows = lines text
+        maxR = length rows - 1
+        maxC = (length $ head rows) - 1
+
+
+showGrid :: Grid -> String
+showGrid grid = unlines rows
+  where (_, V2 rMax cMax) = bounds grid
+        rows = [showRow r | r <- [0..rMax]]
+        showRow r = [showElem r c | c <- [0..cMax]]
+        showElem r c = if grid ! (V2 r c)
+                        then '#'
+                        else '.'

diff --git a/advent06/MainPar.hs b/advent06/MainPar.hs
new file mode 100644 (file)
index 0000000..ec034d5
--- /dev/null
+++ b/advent06/MainPar.hs
@@ -0,0 +1,106 @@
+-- Writeup at https://work.njae.me.uk/2024/12/04/advent-of-code-2024-day-4/
+
+import AoC
+import Linear
+import Data.Array.IArray
+import Data.List
+import Data.Maybe
+import Data.Ix
+import Control.Parallel.Strategies
+
+type Position = V2 Int -- r, c
+type Grid = Array Position Bool
+
+pattern U, D, L, R :: Position
+pattern U = V2 (-1) 0
+pattern D = V2 1 0
+pattern L = V2 0 (-1)
+pattern R = V2 0 1
+
+data Guard = Guard { pos :: Position, dir :: Position }
+  deriving (Show, Eq)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let grid = mkGrid text
+      let start = findStart text
+      let guard = Guard start U
+      print $ part1 grid guard
+      print $ part2 grid guard
+
+
+part1 :: Grid -> Guard -> Int
+part1 grid guard = length $ nub $ walk grid guard
+
+part2 grid guard = length $ filter id loopResults
+  where modifiedGrids = [ grid // [ (new, True) ] 
+                        | new <- news -- range (bounds grid)
+                        , new /= guard.pos
+                        ]
+        loopResults = parMap rpar (isLoop guard []) modifiedGrids
+        -- loopResults = withStrategy (parBuffer 100 rseq) (isLoop guard []) modifiedGrids
+        -- loopResults = (fmap (isLoop guard []) modifiedGrids) `using` parList rseq
+        -- loopResults = (fmap (isLoop guard []) modifiedGrids) `using` parBuffer 100 rseq
+        news = nub $ walk grid guard
+
+turnRight :: Position -> Position
+turnRight U = R
+turnRight R = D
+turnRight D = L
+turnRight L = U
+
+walk :: Grid -> Guard -> [Position]
+walk grid guard = unfoldr (step grid) guard
+
+step :: Grid -> Guard -> Maybe (Position, Guard)
+step grid guard 
+  | not (inRange (bounds grid) guard.pos) = Nothing
+  | not (inRange (bounds grid) ahead) = Just (guard.pos, guard { pos = ahead })
+  | grid ! ahead = Just (guard.pos, guard { dir = turnRight $ guard.dir })
+  | otherwise = Just (guard.pos, guard { pos = ahead })
+  where ahead = guard.pos ^+^ guard.dir
+
+-- isLoop :: Guard -> [Guard] -> Grid -> Bool
+-- isLoop guard trail grid
+--   | isNothing stepped = False
+--   | guard' `elem` trail = True
+--   | otherwise = isLoop guard' (guard:trail) grid
+--   where stepped = step grid guard
+--         (_, guard') = fromJust stepped
+isLoop :: Guard -> [Guard] -> Grid -> Bool
+isLoop guard trail grid
+  | isNothing stepped = False
+  | hasTurned && guard `elem` trail = True
+  | hasTurned = isLoop guard' (guard:trail) grid
+  | otherwise = isLoop guard' trail grid
+  where stepped = step grid guard
+        (_, guard') = fromJust stepped
+        hasTurned = guard.dir /= guard'.dir
+
+mkGrid :: String -> Grid
+mkGrid text = listArray ((V2 0 0), (V2 r c)) $ fmap (== '#') $ concat rows
+  where rows = lines text
+        r = length rows - 1
+        c = (length $ head rows) - 1
+
+findStart :: String -> Position
+findStart text = head $ [ V2 r c 
+                       | c <- [0..maxC]
+                       , r <- [0..maxR]
+                       , rows !! r !! c == '^'
+                       ]
+  where rows = lines text
+        maxR = length rows - 1
+        maxC = (length $ head rows) - 1
+
+
+showGrid :: Grid -> String
+showGrid grid = unlines rows
+  where (_, V2 rMax cMax) = bounds grid
+        rows = [showRow r | r <- [0..rMax]]
+        showRow r = [showElem r c | c <- [0..cMax]]
+        showElem r c = if grid ! (V2 r c)
+                        then '#'
+                        else '.'

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 19d7cef961c225523acb984a99a9815611ad9084..903ceb9c9aa2c7ba0f25a62c7e47294f988866ec 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -31,7 +31,7 @@ common common-extensions
                         , NumDecimals
                         -- , NoFieldSelectors
                         -- , OverloadedLists
-                        -- , OverloadedRecordDot
+                        , OverloadedRecordDot
                         , OverloadedStrings
                         -- , PartialTypeSignatures
                         , PatternSynonyms
@@ -99,3 +99,12 @@ executable advent05ord
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent05/MainOrdering.hs  
   build-depends: attoparsec, text, containers
+
+executable advent06
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent06/Main.hs  
+  build-depends: array, linear
+executable advent06par
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent06/MainPar.hs  
+  build-depends: array, linear, parallel