Done day 9
authorNeil Smith <NeilNjae@users.noreply.github.com>
Sat, 9 Dec 2023 09:22:29 +0000 (09:22 +0000)
committerNeil Smith <NeilNjae@users.noreply.github.com>
Sat, 9 Dec 2023 09:22:29 +0000 (09:22 +0000)
advent-of-code23.cabal
advent08/Main.hs
advent09/Main.hs [new file with mode: 0644]

index df6d0ec0bc13ff45d1db201eee574d668cb889da..eca8d28041afe712b19240c48a81a47c9374d2aa 100644 (file)
@@ -150,3 +150,7 @@ executable advent08
   import: common-extensions, build-directives
   main-is: advent08/Main.hs
   build-depends: text, attoparsec, containers
+
+executable advent09
+  import: common-extensions, build-directives
+  main-is: advent09/Main.hs
index 90f596d0359e317bf18193900ef62db4df88a5f0..b2c9895b9929f4a922bb4e51c25fe83a39c291c3 100644 (file)
@@ -31,7 +31,7 @@ main =
       -- print $ desert
       print $ part1 desert directions
       print $ part2 desert directions
-      -- print $ part3 desert directions
+      print $ part3 desert directions
 
 part1, part2 :: Desert -> [Direction] -> Int
 part1 desert directions = getSteps $ walk desert directions (State "AAA" 0)
@@ -50,16 +50,16 @@ generateRouteLengths desert directions = M.unions ((fmap snd sResults) ++ (fmap
         gResults = fmap (walkWithCache desert directions M.empty) fromGoals
 
 
--- part3 desert directions = multiWalk desert directions M.empty starts
---   where starts = fmap (\s -> State s 0) $ startsOf desert
+part3 desert directions = multiWalk desert directions M.empty starts
+  where starts = fmap (\s -> State s 0) $ startsOf desert
 
--- multiWalk desert directions cache states@(s:ss)
---   | (all isGoal states) && (sameTime states) = states
---   | otherwise = multiWalk desert directions newCache $ sort (s':ss)
---   where (s', newCache) = walkWithCache desert directions cache s
+multiWalk desert directions cache states@(s:ss)
+  | (all isGoal states) && (sameTime states) = states
+  | otherwise = multiWalk desert directions newCache $ sort (s':ss)
+  where (s', newCache) = walkWithCache desert directions cache s
 
--- sameTime states = (length $ nub times) == 1
---   where times = fmap getSteps states
+sameTime states = (length $ nub times) == 1
+  where times = fmap getSteps states
 
 walk :: Desert -> [Direction] -> State -> State
 walk desert directions start = head $ dropWhile (not . isGoal) path
diff --git a/advent09/Main.hs b/advent09/Main.hs
new file mode 100644 (file)
index 0000000..9352f5d
--- /dev/null
@@ -0,0 +1,45 @@
+-- Writeup at https://work.njae.me.uk/2023/12/09/advent-of-code-2023-day-09/
+
+import AoC
+import Data.List
+
+newtype Sequence = Sequence [[Int]] deriving (Show, Eq)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let histories = readInput text
+      -- print histories
+      let seqs = fmap (expand . Sequence . pure) histories
+      -- print seqs
+      -- let seqs' = fmap extend seqs
+      -- print seqs'
+      print $ part1 seqs
+      let rseqs = fmap (expand . Sequence . pure . reverse) histories
+      print $ part1 rseqs
+
+part1 :: [Sequence] -> Int
+part1 = sum . fmap (evaluate . extend)
+
+
+readInput :: String -> [[Int]]
+readInput = fmap (fmap read . words) . lines
+
+expand :: Sequence -> Sequence
+expand (Sequence xss)
+  | all (== 0) $ last xss = Sequence xss
+  | otherwise = expand $ Sequence $ xss ++ [differences $ last xss]
+
+differences :: [Int] -> [Int]
+differences xs = zipWith (-) (tail xs) xs
+
+extend :: Sequence -> Sequence
+extend (Sequence xss) = Sequence $ fst $ foldr extendRow ([], 0) xss
+
+extendRow :: [Int] -> ([[Int]], Int) -> ([[Int]], Int)
+extendRow row (seq, n) = ((row ++ [n']) : seq, n')
+  where n' = last row + n
+
+evaluate :: Sequence -> Int
+evaluate (Sequence xss) = last $ head xss