Day 15

advent-of-code-2023.cabal

@@ -116,3 +116,11 @@ executable day14
     build-depends:    base ^>=4.15.1.0, array
     hs-source-dirs:   day14
     default-language: Haskell2010
+
+executable day15
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, MissingH, array
+    hs-source-dirs:   day15
+    default-language: Haskell2010

day15/Commons.hs

@@ -0,0 +1,24 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.List.Utils (split)
+import Data.Char (ord, digitToInt)
+
+data IType = Set | Remove deriving (Eq, Show)
+data Instruction = Instruction { raw :: String, label :: String, focal :: Int, iType :: IType } deriving Show
+
+parseInstructions :: [String] -> [Instruction]
+parseInstructions = map (\h -> let label = if last h == '-' then init h else init $ init h
+                                   focal = if last h == '-' then 0 else digitToInt $ last h
+                                   iType = if last h == '-' then Remove else Set
+                               in Instruction {raw = h, label = label, focal = focal, iType = iType})
+
+parse :: IO [Instruction]
+parse = do line <- getLine
+           let splittedLine = split "," line
+           return $ parseInstructions splittedLine
+
+
+getHash :: String -> Int -> Int
+getHash [] value = value
+getHash (h: t) value = getHash t (17 * (value + ord h)) `mod` 256

day15/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do instructions <- parse
+          let part1Res = Part1.getHashes instructions
+          print $ sum part1Res
+          let part2Res = Part2.getAllFocusingPower instructions
+          print $ sum part2Res

day15/Part1.hs

@@ -0,0 +1,7 @@
+module Part1 where
+
+import Commons
+
+
+getHashes :: [Instruction] -> [Int]
+getHashes = foldr (\ h -> (:) (getHash (raw h) 0)) [0]

day15/Part2.hs

@@ -0,0 +1,35 @@
+module Part2 where
+
+import Commons
+import GHC.Arr (Array(Array), array, (!), (//), assocs)
+
+
+type Hashmap = Array Int [Instruction]
+
+
+initHashmap :: Hashmap
+initHashmap = array (0, 255) [(i, []) | i <- [0..255]]
+
+applyInstructionToList :: [Instruction] -> Instruction -> [Instruction]
+applyInstructionToList [] i | iType i == Set = [i]
+                            | otherwise      = []
+applyInstructionToList (h: t) i | iType i == Set && label h == label i    = i: t
+                                | iType i == Remove && label h == label i = t
+                                | otherwise                               = h: applyInstructionToList t i
+
+applyInstruction :: Hashmap -> Instruction -> Hashmap
+applyInstruction m i = let hash = getHash (label i ) 0
+                       in m // [(hash, applyInstructionToList (m ! hash) i)]
+
+applyInstructions :: [Instruction] -> Hashmap
+applyInstructions = foldl applyInstruction initHashmap
+
+getFocusingPowerFromList :: Int -> Int -> [Instruction] -> [Int]
+getFocusingPowerFromList _ _ [] = []
+getFocusingPowerFromList i slot (h: t) = i * slot * focal h: getFocusingPowerFromList i (slot + 1) t
+
+getFocusingPower :: Hashmap -> [Int]
+getFocusingPower m = concatMap (\ (i, h) -> getFocusingPowerFromList (i + 1) 1 h) (assocs m)
+
+getAllFocusingPower :: [Instruction] -> [Int]
+getAllFocusingPower = getFocusingPower . applyInstructions