haskell: 2023 15 b
This commit is contained in:
parent
2a7dbfb9c8
commit
bbc271e001
|
@ -38,7 +38,8 @@ library
|
||||||
build-depends:
|
build-depends:
|
||||||
base ^>=4.17.2.0,
|
base ^>=4.17.2.0,
|
||||||
text ^>=2.1,
|
text ^>=2.1,
|
||||||
megaparsec ^>=9.6
|
megaparsec ^>=9.6,
|
||||||
|
microlens ^>=0.4.13
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
|
|
@ -42,4 +42,4 @@ main = do
|
||||||
--run 08 Day08.parse Day08.solveA Day08.solveB
|
--run 08 Day08.parse Day08.solveA Day08.solveB
|
||||||
--run 09 Day09.parse Day09.solveA Day09.solveB
|
--run 09 Day09.parse Day09.solveA Day09.solveB
|
||||||
--run 10 Day10.parse Day10.solveA Day10.solveB
|
--run 10 Day10.parse Day10.solveA Day10.solveB
|
||||||
run 15 Day15.parse Day15.solveA Day15.solveA
|
run 15 Day15.parse Day15.solveA Day15.solveB
|
||||||
|
|
|
@ -1,29 +1,70 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Day15 (parse, solveA) where
|
module Day15 (parse, solveA, solveB) where
|
||||||
|
|
||||||
|
import Data.Void (Void)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Char (ord, isSpace)
|
import Data.Char (ord, isSpace)
|
||||||
|
import Data.Bifunctor (bimap)
|
||||||
|
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, sepBy, optional, eof, many, choice)
|
||||||
|
import Text.Megaparsec.Char (newline, alphaNumChar, char)
|
||||||
|
import Text.Megaparsec.Char.Lexer (decimal)
|
||||||
|
import Lens.Micro (ix, (%~))
|
||||||
|
|
||||||
|
|
||||||
input :: Text
|
data Op
|
||||||
input = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
= Set Text Int
|
||||||
|
| Del Text
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
type Entry = (Text, Int)
|
||||||
|
|
||||||
|
type Parser = Parsec Void Text
|
||||||
|
|
||||||
|
|
||||||
parse :: Text -> Either String [Text]
|
parse :: Text -> Either String [(Text, Op)]
|
||||||
parse = Right . T.splitOn "," . T.filter (not . isSpace)
|
parse text = bimap errorBundlePretty (zip . simple $ text) . runParser complex "" $ text
|
||||||
|
where
|
||||||
|
simple :: Text -> [Text]
|
||||||
|
simple = T.splitOn "," . T.filter (not . isSpace)
|
||||||
|
single :: Parser Op
|
||||||
|
single = do
|
||||||
|
label <- T.pack <$> many alphaNumChar
|
||||||
|
choice
|
||||||
|
[ Set label <$> (char '=' *> decimal)
|
||||||
|
, Del label <$ char '-'
|
||||||
|
]
|
||||||
|
complex :: Parser [Op]
|
||||||
|
complex = single `sepBy` "," <* optional newline <* eof
|
||||||
|
|
||||||
hash :: Text -> Int
|
hash :: Text -> Int
|
||||||
hash = foldl step 0 . T.unpack
|
hash = T.foldl step 0
|
||||||
where
|
where
|
||||||
step :: Int -> Char -> Int
|
step :: Int -> Char -> Int
|
||||||
step curr = (`rem` 256) . (17 *) . (curr +) . ord
|
step curr = (`rem` 256) . (17 *) . (curr +) . ord
|
||||||
|
|
||||||
solveA :: [Text] -> Int
|
solveA :: [(Text, Op)] -> Int
|
||||||
solveA = sum . map hash
|
solveA = sum . map (hash . fst)
|
||||||
|
|
||||||
|
del :: Text -> [[Entry]] -> [[Entry]]
|
||||||
|
del k = ix (hash k) %~ filter ((k /=) . fst)
|
||||||
|
|
||||||
|
set :: Text -> Int -> [[Entry]] -> [[Entry]]
|
||||||
|
set k v = ix (hash k) %~ update
|
||||||
|
where
|
||||||
|
update :: [Entry] -> [Entry]
|
||||||
|
update es
|
||||||
|
| any ((k ==) . fst) es = map (\(k', v') -> if k == k' then (k, v) else (k', v')) es
|
||||||
|
| otherwise = es <> [(k, v)]
|
||||||
|
|
||||||
-- >>> solveA <$> parse input
|
solveB :: [(Text, Op)] -> Int
|
||||||
-- Right 1320
|
solveB = sum . zipWith row [1..] . foldl (flip run) (replicate 256 []) . map snd
|
||||||
|
where
|
||||||
|
run :: Op -> [[Entry]] -> [[Entry]]
|
||||||
|
run op = case op of
|
||||||
|
Set k v -> set k v
|
||||||
|
Del k -> del k
|
||||||
|
box :: Int -> Entry -> Int
|
||||||
|
box i = (i *) . snd
|
||||||
|
row :: Int -> [Entry] -> Int
|
||||||
|
row i = (i *) . sum . zipWith box [1..]
|
||||||
|
|
|
@ -278,15 +278,13 @@ day10 =
|
||||||
|
|
||||||
day15 :: Test
|
day15 :: Test
|
||||||
day15 =
|
day15 =
|
||||||
let parsedA1 = Day15.parse inputA1
|
let parsed = Day15.parse input
|
||||||
parsedA2 = Day15.parse inputA2
|
|
||||||
in TestList
|
in TestList
|
||||||
[ TestCase $ assertEqual "A" (Right 52) (Day15.solveA <$> parsedA1)
|
[ TestCase $ assertEqual "A" (Right 1320) (Day15.solveA <$> parsed)
|
||||||
, TestCase $ assertEqual "A" (Right 1320) (Day15.solveA <$> parsedA2)
|
, TestCase $ assertEqual "A" (Right 145) (Day15.solveB <$> parsed)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
inputA1 = "HASH"
|
input = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
||||||
inputA2 = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
|
||||||
|
|
||||||
tests :: Test
|
tests :: Test
|
||||||
tests = TestList
|
tests = TestList
|
||||||
|
|
Loading…
Reference in a new issue