advent04/Main.hs

   1 import Data.Text ()
   2 import qualified Data.Text.IO as TIO
   3
   4 import Data.Attoparsec.Text
   5 import Control.Applicative
   6
   7 import Data.List
   8
   9 type Square = [[Int]]
  10 type BingoSquare = [[BingoNum]]
  11 data BingoNum = BingoNum Int Bool
  12   deriving (Eq, Show)
  13 data BingoState = BingoState Int [BingoSquare]
  14   deriving (Eq, Show)
  15
  16
  17
  18 main :: IO ()
  19 main =
  20   do  text <- TIO.readFile "data/advent04.txt"
  21       let (nums, rawSquares) = successfulParse text
  22       let squares = map mkSquare rawSquares
  23       print $ part1 nums squares
  24       print $ part2 nums squares
  25
  26 part1 :: [Int] -> [BingoSquare] -> Int
  27 part1 callNums squares = finalCalled * winningSum
  28   where allSteps = scanl' bingoStep (BingoState 0 squares) callNums
  29         BingoState finalCalled finalSquares = head $ dropWhile (not . hasCompletedSquare) allSteps
  30         winningSquare = head $ filter completed finalSquares
  31         winningSum = unmarkedSum winningSquare
  32
  33 part2 :: [Int] -> [BingoSquare] -> Int
  34 part2 callNums squares = finalCalled * winningSum
  35   where allSteps = scanl' pruningBingoStep (BingoState 0 squares) callNums
  36         BingoState finalCalled finalSquares =
  37           head $ dropWhile (not . hasCompletedSquare)
  38                $ dropWhile manyRemainingSquares allSteps
  39         winningSquare = head finalSquares
  40         winningSum = unmarkedSum winningSquare
  41
  42
  43 bingoStep :: BingoState -> Int -> BingoState
  44 bingoStep (BingoState _ squares) caller = BingoState caller squares'
  45   where squares' = map (callSquare caller) squares
  46
  47 pruningBingoStep :: BingoState -> Int -> BingoState
  48 pruningBingoStep (BingoState _ squares) caller = BingoState caller squares''
  49   where squares' = filter (not . completed) squares
  50         squares'' = map (callSquare caller) squares'
  51
  52 hasCompletedSquare :: BingoState -> Bool
  53 hasCompletedSquare (BingoState _n squares) = any completed squares
  54
  55
  56 unmarkedSum :: BingoSquare -> Int
  57 unmarkedSum bingoSquare =
  58   sum [value bn | r <- bingoSquare, bn <- r, (not $ isCalled bn)]
  59
  60 manyRemainingSquares :: BingoState -> Bool
  61 manyRemainingSquares (BingoState _ squares) = (length squares) > 1
  62
  63
  64 mkBingoNum :: Int -> BingoNum
  65 mkBingoNum n = BingoNum n False
  66
  67 forceCall :: BingoNum -> BingoNum
  68 forceCall (BingoNum n _) = BingoNum n True
  69
  70 call :: Int -> BingoNum -> BingoNum
  71 call num (BingoNum target called)
  72   | num == target = BingoNum target True
  73   | otherwise = BingoNum target called
  74
  75 isCalled :: BingoNum -> Bool
  76 isCalled (BingoNum _ c) = c
  77
  78 value :: BingoNum -> Int
  79 value (BingoNum n _) = n
  80
  81 mkSquare :: Square -> BingoSquare
  82 mkSquare = map (map mkBingoNum)
  83
  84 callSquare :: Int -> BingoSquare -> BingoSquare
  85 callSquare n = map (map (call n))
  86
  87 completed :: BingoSquare -> Bool
  88 completed sq = (any completedRow sq) || (any completedRow $ transpose sq)
  89
  90 completedRow :: [BingoNum] -> Bool
  91 completedRow = all isCalled
  92
  93 -- Parse the input file
  94
  95 bingoP = (,) <$> calledP <*> (blankLines *> squaresP)
  96
  97 calledP = decimal `sepBy` ","
  98
  99 squaresP = squareP `sepBy` blankLines
 100 squareP = rowP `sepBy` endOfLine
 101 rowP = paddedDecimal `sepBy1` " "
 102
 103 -- paddedDecimal :: Parser Text Int
 104 paddedDecimal = (many " ") *> decimal
 105
 106 blankLines = many1 endOfLine
 107
 108 -- successfulParse :: Text -> (Integer, [Maybe Integer])
 109 successfulParse input =
 110   case parseOnly bingoP input of
 111     Left  _err -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
 112     Right bingo -> bingo