Done day 15

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index 5af0b4b4655eacccac392fa60eee001841d92219..0a38ddc77900d3f7e3672081a62f6517903d585c 100644 (file)
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -186,3 +186,8 @@ executable advent14
   import: common-extensions, build-directives
   main-is: advent14/Main.hs
   build-depends: containers
+
+executable advent15
+  import: common-extensions, build-directives
+  main-is: advent15/Main.hs
+  build-depends: containers, text, attoparsec, 

diff --git a/advent15/Main.hs b/advent15/Main.hs
new file mode 100644 (file)
index 0000000..7fa4789
--- /dev/null
+++ b/advent15/Main.hs
@@ -0,0 +1,79 @@
+-- Writeup at https://work.njae.me.uk/2023/12/18/advent-of-code-2023-day-15/
+
+import AoC
+import Data.List
+-- import Data.List.Split
+import Data.Char
+
+import Data.Text (Text, splitOn, unpack)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text -- hiding (take, takeWhile)
+import Control.Applicative
+import qualified Data.IntMap.Strict as M
+
+data Instruction = Remove String | Insert String Int deriving (Show, Eq)
+data Lens = Lens {lensLabel :: String, lensPower :: Int} deriving (Show, Eq)
+type Facility = M.IntMap [Lens]
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let instructions = successfulParse text
+      -- print instructions
+      print $ part1 text
+      print $ part2 instructions
+
+-- part1, part2 :: [Pattern] -> Int
+part1 :: Text -> Int
+part1 = sum . fmap (hash . unpack) . splitOn ","
+
+part2 :: [Instruction] -> Int
+part2 = power . processAll
+
+hash :: String -> Int
+hash s = foldl' go 0 s
+  where go current c = ((current + ord c) * 17)  `mod` 256
+
+processAll :: [Instruction] -> Facility
+processAll = foldl' process M.empty
+
+process :: Facility -> Instruction -> Facility
+process facility (Remove s) = 
+  M.adjust (filter ((/= s) . lensLabel))
+           (hash s) 
+           facility
+process facility (Insert s p)
+  | any ((== s) . lensLabel) content = M.insert hs content' facility
+  | otherwise = M.insert hs (content ++ [lens]) facility
+  where hs = hash s
+        content = M.findWithDefault [] hs facility
+        lens = Lens s p
+        content' = fmap replaceLens content
+        replaceLens l 
+          | lensLabel l == s = lens
+          | otherwise = l
+
+powerCell :: Int -> [Lens] -> Int
+powerCell boxNum lenses = 
+  (boxNum + 1) * (sum $ zipWith (*) [1..] (fmap lensPower lenses))
+
+power :: Facility -> Int 
+power = sum . M.elems . M.mapWithKey powerCell
+
+-- Parse the input file
+
+instructionsP :: Parser [Instruction]
+instructionP, removeP, insertP :: Parser Instruction
+
+instructionsP = instructionP `sepBy` ","
+instructionP = removeP <|> insertP
+
+removeP = Remove <$> (many1 letter) <* "-"
+insertP = Insert <$> ((many1 letter) <* "=") <*> decimal
+
+successfulParse :: Text -> [Instruction]
+successfulParse input = 
+  case parseOnly instructionsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right matches -> matches
\ No newline at end of file