R 2023/15.hs => 2023/15a.hs +2 -7
@@ 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
A 2023/15b.hs => 2023/15b.hs +68 -0
@@ 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
M templates/template.hs => templates/template.hs +1 -1
@@ 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