aoc2023

advent of code 2023
Log | Files | Refs | Feed | README

day4.hs (2300B)


      1 -- AOC 2023: Day 4 - Scratchcards
      2 --
      3 -- Suppose you have a list of prescratched scratchcards and thus
      4 -- know both the numbers on the card and the list of winning numbers
      5 -- for the card. The data looks like:
      6 --
      7 -- Card 1: 41 48 83 86 17 | 83 86  6 31 17  9 48 53
      8 -- Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19
      9 -- Card 3:  1 21 53 59 44 | 69 82 63 72 16 21 14  1
     10 -- Card 4: 41 92 73 84 69 | 59 84 76 51 58  5 54 83
     11 -- Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36
     12 -- Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11
     13 --
     14 -- Task 1: A cards score starts at 0 and is doubled for each winning
     15 -- number (in this case 0 * 2 = 1) i.e. after the first win left shift
     16 -- the result once for each additional win. Provide the sum of scores.
     17 -- Test Output: 13
     18 --
     19 -- Task 2: Each win gives you more of the subsequent scratchcards.
     20 -- Card 1 (4 winning numbers) gives you an additional copy of each of
     21 -- Cards 2-5. Sum up the total number of cards by the end.
     22 -- Test Output: 30
     23 --
     24 {-# LANGUAGE OverloadedStrings #-}
     25 
     26 import qualified Data.Text as T
     27 import qualified Data.Text.IO as TI
     28 import Text.Printf (printf)
     29 
     30 shiftsum :: Num a => [a] -> a
     31 shiftsum [] = 0
     32 shiftsum (x:xs) = foldl (\a _ -> a * 2) 1 xs
     33 
     34 tointlists :: ([T.Text], [T.Text]) -> ([Int], [Int])
     35 tointlists (h, t) =
     36     let f = map (\x -> read x :: Int) . filter (/= "") . tail . map T.unpack
     37      in (f h, f t)
     38 
     39 numpairs :: T.Text -> ([Int], [Int])
     40 numpairs =
     41     tointlists . span (/= "|") . T.splitOn " " . T.tail . T.dropWhile (/= ':')
     42 
     43 gamescore :: T.Text -> Int
     44 gamescore st =
     45     let (w, n) = numpairs st
     46      in shiftsum $ filter (`elem` w) n
     47 
     48 countcards :: [(Int, Int)] -> [(Int, Int)]
     49 countcards [] = []
     50 countcards c =
     51     let h = head c
     52         t = tail c
     53         p =
     54             zip
     55                 ((replicate (snd h) (fst h)) ++ (repeat 0))
     56                 (replicate (length t) 0)
     57         nt = zipWith (\x y -> ((fst x) + (fst y), snd y)) p t
     58      in [h] ++ (countcards nt)
     59 
     60 gamewins :: [T.Text] -> [Int]
     61 gamewins = map (\(a, b) -> length $ filter (`elem` a) b) . map numpairs
     62 
     63 main = do
     64     contents <- TI.getContents
     65     let games = T.lines contents
     66     printf "Task 1: %8d\n" (sum $ map gamescore games)
     67     let cardcount = map fst $ countcards $ zip (repeat 1) $ gamewins games
     68     printf "Task 2: %8d\n" (sum cardcount)