3 files changed, 71 insertions(+), 8 deletions(-)

R 2023/{15.hs => 15a.hs}
A 2023/15b.hs
M templates/template.hs

@@ 25,18 25,13 @@ parser :: Parser Parse
 parser = manyTill anyChar (try newline)
 
 hash :: String -> Word8
-hash = foldl' f (0 :: Word8)
+hash = foldl' f 0
   where f v c = 17 * (v + fromIntegral (ord c))
 
 partA :: Parse -> Integer
-partA is = sum $ fmap (toInteger . hash) $ splitOn "," is
-
---partB :: Parse -> Parse
---partB = id
+partA = sum . fmap (toInteger . hash) . splitOn ","
 
 main :: IO ()
 main = with parser $ do
   run' "15.example" "a example" partA 1320
   run' "15.input" "a input" partA 519603
-  --run "15.example" "b example" partB
-  --run "15.input" "b input" partB

@@ 0,0 1,68 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Main where
+
+import Qulude
+
+import Data.Array ( (!), (//) )
+import qualified Data.Array as Array
+import qualified Data.Array.ST as STArray
+import qualified Data.Either as Either
+import qualified Data.List as List
+--import Data.Map ( (!) )
+import qualified Data.Map as Map
+import qualified Data.Maybe as Maybe
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+
+type Label = String
+type FocalLength = Int
+data Op = Upsert Label FocalLength | Remove Label
+  deriving ( Show, Eq )
+
+type Parse = [Op]
+parser :: Parser Parse
+parser = (op `sepBy` (string ",")) <* newline
+  where op = do
+          label <- many1 letter
+          (char '-' $> Remove label) <|> (char '=' >> int <&> Upsert label)
+
+hash :: String -> Word8
+hash = foldl' f 0
+  where f v c = 17 * (v + fromIntegral (ord c))
+
+type Lens = (Label, FocalLength)
+type Boxes = Array Word8 (Seq Lens)
+
+empty :: Boxes
+empty = Array.array (0,255) [(i, Seq.empty) | i <- [0..255]]
+
+focusingPower :: Boxes -> Int
+focusingPower bs = sum $ fmap f $ Array.assocs bs
+  where f (b, ls) = sum $ fmap (\(i,(_,fl)) -> (succ $ fromIntegral b)*i*fl) $ zip [1..] (toList ls)
+
+partB :: Parse -> Int
+partB = focusingPower . foldl' f empty
+  where f bs (Upsert l fl) =
+          let i = hash l in
+          let b = bs ! hash l in
+          let b' = case Seq.findIndexL (hasLabel l) b of
+                     Nothing -> b |> (l, fl)
+                     Just j -> Seq.insertAt j (l, fl) (Seq.deleteAt j b)
+          in bs // [(i, b')]
+        f bs (Remove l) =
+          let i = hash l in
+          let b = bs ! hash l in
+          let b' = case Seq.findIndexL (hasLabel l) b of
+                     Nothing -> b
+                     Just j -> Seq.deleteAt j b
+          in bs // [(i, b')]
+        hasLabel l (l', _) = l == l'
+
+main :: IO ()
+main = with parser $ do
+  run' "15.example" "b example" partB 145
+  run' "15.input" "b input" partB 244342

@@ 7,7 7,7 @@ module Main where
 
 import Qulude
 
---import Data.Array ( (!) )
+--import Data.Array ( (!), (//) )
 import qualified Data.Array as Array
 import qualified Data.Array.ST as STArray
 import qualified Data.Either as Either