X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent15%2FMain.hs;fp=advent15%2FMain.hs;h=7fa47890163291cfe8e4baf228b2897f88f2d091;hb=c52e9a0b89ca5b5351b9208046cc56980550f993;hp=0000000000000000000000000000000000000000;hpb=a9af1ff8e08c473ece30ccdee9ff1a895126c0b2;p=advent-of-code-23.git

diff --git a/advent15/Main.hs b/advent15/Main.hs
new file mode 100644
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