Day 15: Lens Library

README.md

@@ -19,3 +19,4 @@ Development occurs in language-specific directories:
 |[Day12.hs](hs/src/Day12.hs)|[Day12.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day12.kt)|[day12.py](py/aoc2023/day12.py)|[day12.rs](rs/src/day12.rs)|
 |[Day13.hs](hs/src/Day13.hs)|[Day13.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day13.kt)|[day13.py](py/aoc2023/day13.py)|[day13.rs](rs/src/day13.rs)|
 |[Day14.hs](hs/src/Day14.hs)|[Day14.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day14.kt)|[day14.py](py/aoc2023/day14.py)|[day14.rs](rs/src/day14.rs)|
+|[Day15.hs](hs/src/Day15.hs)||||

hs/aoc2023.cabal

@@ -34,7 +34,8 @@ library
         Day11,
         Day12,
         Day13,
-        Day14
+        Day14,
+        Day15
 
     -- Modules included in this library but not exported.
     other-modules:
@@ -96,7 +97,8 @@ test-suite aoc2023-test
         Day11Spec,
         Day12Spec,
         Day13Spec,
-        Day14Spec
+        Day14Spec,
+        Day15Spec
     build-depends:
         aoc2023,
         base ^>=4.17.2.0,

hs/app/Main.hs

@@ -15,6 +15,7 @@ import qualified Day11 (solve)
 import qualified Day12 (part1, part2)
 import qualified Day13 (part1, part2)
 import qualified Day14 (part1, part2)
+import qualified Day15 (part1, part2)
 
 import Control.Monad (ap, when)
 import Data.Foldable (find)
@@ -59,3 +60,4 @@ main = do
     run 12 print [Day12.part1, Day12.part2]
     run 13 print [Day13.part1, Day13.part2]
     run 14 print [Day14.part1, Day14.part2]
+    run 15 print [Day15.part1, Day15.part2]

hs/bench/Main.hs

@@ -20,6 +20,7 @@ import qualified Day11 (solve)
 import qualified Day12 (part1, part2)
 import qualified Day13 (part1, part2)
 import qualified Day14 (part1, part2)
+import qualified Day15 (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -93,4 +94,8 @@ main = defaultMain
       [ bench "part 1" $ nf Day14.part1 input
       , bench "part 2" $ nf Day14.part2 input
       ]
+  , env (getDayInput 15) $ \input -> bgroup "Day 15"
+      [ bench "part 1" $ nf Day15.part1 input
+      , bench "part 2" $ nf Day15.part2 input
+      ]
   ]

hs/src/Day15.hs

@@ -0,0 +1,40 @@
+{-|
+Module:         Day15
+Description:    <https://adventofcode.com/2023/day/15 Day 15: Lens Library>
+-}
+{-# LANGUAGE OverloadedStrings, TransformListComp #-}
+module Day15 (part1, part2) where
+
+import Data.Bits ((.&.))
+import Data.Char (isAlphaNum, isSpace, ord)
+import Data.Function (on)
+import Data.List (foldl', groupBy, sortOn)
+import qualified Data.Map as Map (delete, empty, insertWith, toList)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T (foldl', null, span, split, stripPrefix, stripSuffix)
+import qualified Data.Text.Read as T (decimal)
+import GHC.Exts (groupWith, the)
+
+hash :: Text -> Int
+hash = (.&. 255) . T.foldl' hash' 0 where hash' k c = 17 * (k + ord c)
+
+isSep :: Char -> Bool
+isSep ',' = True
+isSep c = isSpace c
+
+part1, part2 :: Text -> Int
+part1 = sum . map hash . T.split isSep
+part2 = power . foldl' go Map.empty . zip [0..] . filter (not . T.null) . T.split isSep
+  where
+    go lens (c, ins)
+      | "-" <- rest = Map.delete key lens
+      | Just (Right (n, "")) <- T.decimal <$> T.stripPrefix "=" rest
+      = Map.insertWith (\(n, _) (_, c) -> (n, c)) key (n, c) lens
+      where (key, rest) = T.span isAlphaNum ins
+    power lens = sum
+      [ (the (hash <$> key) + 1) * sum (zipWith (*) [1..] n)
+      | (key, (n, c)) <- Map.toList lens
+      , then sortOn by (hash key, c)
+      , then group by hash key using groupBy . on (==)
+      ]

hs/test/Day15Spec.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day15Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day15 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7\n"
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            part1 example `shouldBe` 1320
+    describe "part 2" $ do
+        it "examples" $ do
+            part2 example `shouldBe` 145