haskell: 2023 15 b
This commit is contained in:
parent
2a7dbfb9c8
commit
bbc271e001
|
@ -38,7 +38,8 @@ library
|
|||
build-depends:
|
||||
base ^>=4.17.2.0,
|
||||
text ^>=2.1,
|
||||
megaparsec ^>=9.6
|
||||
megaparsec ^>=9.6,
|
||||
microlens ^>=0.4.13
|
||||
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
|
@ -42,4 +42,4 @@ main = do
|
|||
--run 08 Day08.parse Day08.solveA Day08.solveB
|
||||
--run 09 Day09.parse Day09.solveA Day09.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 #-}
|
||||
module Day15 (parse, solveA) where
|
||||
module Day15 (parse, solveA, solveB) where
|
||||
|
||||
import Data.Void (Void)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
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
|
||||
input = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
||||
data Op
|
||||
= Set Text Int
|
||||
| Del Text
|
||||
deriving Show
|
||||
|
||||
type Entry = (Text, Int)
|
||||
|
||||
type Parser = Parsec Void Text
|
||||
|
||||
|
||||
parse :: Text -> Either String [Text]
|
||||
parse = Right . T.splitOn "," . T.filter (not . isSpace)
|
||||
parse :: Text -> Either String [(Text, Op)]
|
||||
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 = foldl step 0 . T.unpack
|
||||
hash = T.foldl step 0
|
||||
where
|
||||
step :: Int -> Char -> Int
|
||||
step curr = (`rem` 256) . (17 *) . (curr +) . ord
|
||||
|
||||
solveA :: [Text] -> Int
|
||||
solveA = sum . map hash
|
||||
solveA :: [(Text, Op)] -> Int
|
||||
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
|
||||
-- Right 1320
|
||||
|
||||
solveB :: [(Text, Op)] -> Int
|
||||
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 =
|
||||
let parsedA1 = Day15.parse inputA1
|
||||
parsedA2 = Day15.parse inputA2
|
||||
let parsed = Day15.parse input
|
||||
in TestList
|
||||
[ TestCase $ assertEqual "A" (Right 52) (Day15.solveA <$> parsedA1)
|
||||
, TestCase $ assertEqual "A" (Right 1320) (Day15.solveA <$> parsedA2)
|
||||
[ TestCase $ assertEqual "A" (Right 1320) (Day15.solveA <$> parsed)
|
||||
, TestCase $ assertEqual "A" (Right 145) (Day15.solveB <$> parsed)
|
||||
]
|
||||
where
|
||||
inputA1 = "HASH"
|
||||
inputA2 = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
||||
input = "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7"
|
||||
|
||||
tests :: Test
|
||||
tests = TestList
|
||||
|
|
Loading…
Reference in a new issue