-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathDay4.hs
38 lines (35 loc) · 1.58 KB
/
Day4.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
{-|
Module: Day4
Description: <https://adventofcode.com/2023/day/4 Day 4: Scratchcards>
-}
{-# LANGUAGE NondecreasingIndentation, OverloadedStrings #-}
module Day4 (part1, part2) where
import Common (readEntire)
import Data.Bits (shiftL, shiftR)
import Data.Char (isDigit)
import Data.Set (Set)
import qualified Data.Set as Set (empty, insert, intersection, size)
import Data.Text (Text)
import qualified Data.Text as T (lines, null, span, stripPrefix, stripStart)
import Data.Text.Read (Reader)
readCard :: Reader (Set Text)
readCard input = do
input1 <- maybe (Left "parse error") Right $ T.stripPrefix "Card" input
let (n, input2) = T.span isDigit $ T.stripStart input1
if T.null n then Left "parse error" else do
input3 <- maybe (Left "parse error") Right $ T.stripPrefix ":" input2
let (left, input4) = readNumbers Set.empty input3
input5 <- maybe (Left "parse error") Right . T.stripPrefix "|" $ T.stripStart input4
let (right, input6) = readNumbers Set.empty input5
pure (Set.intersection left right, input6)
where
readNumbers k input
| T.null word = (k, input)
| otherwise = readNumbers (Set.insert word k) input'
where (word, input') = T.span isDigit $ T.stripStart input
part1, part2 :: Text -> Either String Int
part1 = fmap (sum . map score) . mapM (readEntire readCard) . T.lines where
score card = 1 `shiftL` Set.size card `shiftR` 1
part2 = fmap (sum . map head . init . scanl score (repeat 1)) .
mapM (readEntire readCard) . T.lines where
score (x:xs) card = zipWith (+) xs $ replicate (Set.size card) x ++ repeat 0