From 20d249b7155734152f2abe98ba6481cd312301d5 Mon Sep 17 00:00:00 2001
From: RhiobeT <rhiobet@gmail.com>
Date: Fri, 15 Dec 2023 12:21:40 +0100
Subject: [PATCH] Day 15

---
 advent-of-code-2023.cabal |  8 ++++++++
 day15/Commons.hs          | 25 +++++++++++++++++++++++++
 day15/Main.hs             | 12 ++++++++++++
 day15/Part1.hs            |  7 +++++++
 day15/Part2.hs            | 35 +++++++++++++++++++++++++++++++++++
 5 files changed, 87 insertions(+)
 create mode 100644 day15/Commons.hs
 create mode 100644 day15/Main.hs
 create mode 100644 day15/Part1.hs
 create mode 100644 day15/Part2.hs

diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal
index f10fc11..65c8fb1 100644
--- a/advent-of-code-2023.cabal
+++ b/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
diff --git a/day15/Commons.hs b/day15/Commons.hs
new file mode 100644
index 0000000..076a332
--- /dev/null
+++ b/day15/Commons.hs
@@ -0,0 +1,25 @@
+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 :: Int -> String -> Int
+getHash = foldl (\ value h -> (17 * (value + ord h)) `mod` 256)
diff --git a/day15/Main.hs b/day15/Main.hs
new file mode 100644
index 0000000..f4ce6f0
--- /dev/null
+++ b/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
diff --git a/day15/Part1.hs b/day15/Part1.hs
new file mode 100644
index 0000000..db89be4
--- /dev/null
+++ b/day15/Part1.hs
@@ -0,0 +1,7 @@
+module Part1 where
+
+import Commons
+
+
+getHashes :: [Instruction] -> [Int]
+getHashes = map $ getHash 0 . raw
diff --git a/day15/Part2.hs b/day15/Part2.hs
new file mode 100644
index 0000000..f7c4588
--- /dev/null
+++ b/day15/Part2.hs
@@ -0,0 +1,35 @@
+module Part2 where
+
+import Commons
+import Data.Array (Array, array, (!), (//), assocs, listArray)
+
+
+type Hashmap = Array Int [Instruction]
+
+
+initHashmap :: Hashmap
+initHashmap = listArray (0, 255) [[] | _ <- [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 0 (label i)
+                       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 = concatMap (\ (i, h) -> getFocusingPowerFromList (i + 1) 1 h) . assocs
+
+getAllFocusingPower :: [Instruction] -> [Int]
+getAllFocusingPower = getFocusingPower . applyInstructions