Advent of Code 2021 Day 4

Question

Here is my attempt at Advent of Code Day 4 using Haskell. A file contains list of number in first line. And subsequent lines have the bingo Cards

7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1

22 13 17 11  0
 8  2 23  4 24
21  9 14 16  7
 6 10  3 18  5
 1 12 20 15 19

 3 15  0  2 22
 9 18 13 17  5
19  8  7 25 23
20 11 10 24  4
14 21 16 12  6

A number(first line is the list of numbers that are drawn) is drawn at a time and is marked on the bingo Card.

Problem 1: find the Winning bingo Card.

Problem 2: Find the last Winning bingo Card.

Answer can be found by taking the winning bingo card. Adding all the numbers that were not drawn and multiplying with the last number drawn. I tried to add comments to each code block.

module Main where
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.Set as Set
-- | Tuple of cell. Contains the 
-- Parameter 1 is the number on the bingoboard
-- Parameter 2 is the bool value if the number is drawn
-- Parameter 3 is the Maybe Int of drawn number
type Cell = (Int, Bool, Maybe Int)
type BingoBoard = [[Cell]]

newline = T.pack ("\n")

-- | Parses the first line of the file into list of int
parse::T.Text -> [Int]
parse arg0 = map (read::String-> Int) $ map (T.unpack) $ T.splitOn (T.pack ",") arg0

-- | Parses the bingo board. This takes list of lines
-- and parses them into bingo board
-- 22 13 17 11  0
--  8  2 23  4 24
-- 21  9 14 16  7
--  6 10  3 18  5
--  1 12 20 15 19

--  3 15  0  2 22
--  9 18 13 17  5
-- 19  8  7 25 23
-- 20 11 10 24  4
-- 14 21 16 12  6
parsebingos ::[T.Text] -> [BingoBoard]
parsebingos value = map parsebingo value
    where 
        parsebingo::T.Text -> BingoBoard
        parsebingo arg0 = parseStringToInt (map words (map (T.unpack) (T.splitOn newline arg0)))
        parseStringToInt::[[String]] -> BingoBoard
        parseStringToInt = fmap (map cellParse)
        cellParse :: String -> Cell
        cellParse value = ((read::String -> Int) value, False, Nothing)


-- | Solution 1: find the first winner
-- findWinner takes the list of List of Bingo boards. And tries to find the winner.
-- if any  row or column's number matches the numbers that are drawn would be the winner.
findWinner::[[BingoBoard]] -> BingoBoard
findWinner [] = []
findWinner (x:xs) = 
    case findWinnerHelper x of
        Just v -> v
        _ -> findWinner xs
-- | Helper function to go through each bingo board to find the winner
findWinnerHelper :: [BingoBoard] -> Maybe BingoBoard
findWinnerHelper [] = Nothing
findWinnerHelper (g:gs) =
    case isWinner g of
        True -> Just g
        _ -> findWinnerHelper gs

-- | Solution 2 : To find the last board that wins the bingo. takes list of Bingo Boards 
solve2 :: [[BingoBoard]] -> BingoBoard  
solve2 arg0 = findWinner2 ((Set.empty), []) arg0

-- | findWinner2 takes a tuple of Set and BingoBoard accumulator
-- If the BingoBoard is not in the Set it tries to find the winner
-- if the BingoBoard is a winner it adds to accumulator and the set
-- first board in the accumulator is the Last winning
-- The idea here is to discard all the BingoBoard which already have won
findWinner2::((Set.Set String), [BingoBoard]) -> [[BingoBoard]] -> BingoBoard -- parameter 1 is accumulator for bingoboard String and bingoBoard
findWinner2 (_, (x:xs)) [] = x -- Answer is the first element of list Set is ignored
findWinner2 arg0 (x:xss) = findWinner2 (findwinner arg0 x) xss
    where 
        findwinner::(Set.Set String, [BingoBoard]) -> [BingoBoard] -> (Set.Set String, [BingoBoard])
        findwinner acc [] = acc
        findwinner (set, acc) (g:gs) = 
            case (Set.notMember f set) && (isWinner g) of
                True -> findwinner (Set.insert (makereadableBingoBoard "" g) set, (g : acc)) gs
                False -> findwinner (set, acc) gs
            where 
                f :: String
                f = makereadableBingoBoard "" g


-- | makes the string out of the bingo board number to put in the set
makereadableBingoBoard::String -> BingoBoard -> String
makereadableBingoBoard boardStr [] = boardStr
makereadableBingoBoard boardStr (x:xs) = makereadableBingoBoard (boardStr ++ makereadableCells "" x) xs
    where
        makereadableCells::String -> [Cell] -> String
        makereadableCells acc [] = acc
        makereadableCells acc ((val, _, _):gs) = makereadableCells (acc ++  show val) gs

-- | isWinner checks to see if the BingoBoard is the winner
-- It does it by checking all the rows. 
-- Then transposing the BingoBoard and checking all the rows
isWinner::BingoBoard -> Bool
isWinner arg0 = (List.any (== True) $ map isRowWinner arg0) || (List.any (== True) $ map isRowWinner $ List.transpose arg0)

-- | isRowWinner checks if all the Cells in the row are winner
isRowWinner::[Cell] -> Bool
isRowWinner arg0 = List.all (== True)  (map cell arg0)
    where 
        cell::Cell -> Bool
        cell (_, True, _) = True
        cell _ = False

-- | findAnswer Sums all the number that are marked False & multiplies it by the last drawn number
findAnswer ::BingoBoard -> Int
findAnswer value@(x:xs) = (*)  (findbaseValue x) (findFalseCell 0 value)
    where 
        findFalseCell::Int -> BingoBoard -> Int
        findFalseCell acc [] = acc
        findFalseCell acc (x:xs) =  findFalseCell (sum' acc x) xs
        sum'::Int -> [Cell] -> Int
        sum' acc [] = acc
        sum' acc ((a, False, _): gs) = sum' (acc + a) gs
        sum' acc ((_, True, _): gs) = sum' acc gs        
        findbaseValue ::[Cell] -> Int
        findbaseValue [] = 0
        findbaseValue [(_,_, Just v)] = v
        findbaseValue ((_,_,Nothing): xs) = 0
        findbaseValue ((_,_, Just v): xs) = v

-- | This creates the infinite list of Bingo boards for all the numbers that are drawn
drawBingo ::[Int] -> [BingoBoard] -> [[BingoBoard]]
drawBingo [] _ = []
drawBingo (x:xs) bingoBoards = k: drawBingo xs k
    where 
        k = updateBingoBoards x bingoBoards

-- | Creates Bingoboards for each number drawn
updateBingoBoards ::Int -> [BingoBoard] -> [BingoBoard]
updateBingoBoards draw boards = map (\x -> updateBingoBoard draw x) boards

-- | Matches each cell of the bingo board if it is found makes the Cell value true
-- and all the cell with number drawn
updateBingoBoard :: Int -> BingoBoard -> BingoBoard
updateBingoBoard arg0 arg1 = fmap (map flipcell) arg1
    where
        flipcell ::Cell -> Cell
        flipcell value@(a, b, _)  
            | a == arg0 && b == False = (a, True, Just arg0)
            | otherwise = (a, b, Just arg0)


main::IO()
main = do
    content <- readFile "input.txt"
    let input =  T.splitOn (T.pack "\n\n") $ T.pack content
    let draws = parse (head input)  
    let bingoboards = parsebingos (tail input)
    let game = drawBingo draws bingoboards
    let updated = findAnswer $ findWinner $ game
    print updated
    let winner2 =  findAnswer $ solve2  game
    print winner2
```

Answer 1

Good job! There are some things that stand immediately out though:

• the formatting is inconsistent (func ::A -> B and func :: A -> B). Consistency is key.
• some information is redundant. Repeating the same information might distract. Repeating the same information might distract. Repeating the same information might distract.
  • some type annotations are superfluous (e.g. read :: String -> Int, read's Read instance is clear from the context)
  • functions within where clauses usually don't need type signatures, unless you're working with ST or similar
• a lot of the code seems only half-polished, as if you dropped the pen as soon as the solution worked

But speaking about information, let's have a look at the very first comment:

Misleading documentation?

-- | Tuple of cell. Contains the 
-- Parameter 1 is the number on the bingoboard
-- Parameter 2 is the bool value if the number is drawn
-- Parameter 3 is the Maybe Int of drawn number
type Cell = (Int, Bool, Maybe Int)

So, I have several problems with this documentation. Parameter 1 is fine. but what does "bool value if the number is drawn" mean? I already know that it's a Bool, no need to repeat the type in the documentation. And what does Maybe Int of drawn number mean?

Also, Tuple of cell is missing a definition of a cell.

Instead, I propose the following comment:

-- | Single Bingo board cell.

type Cell = (Int       -- ^ the actual number on the bingo board
           , Bool      -- ^ whether the number is marked
           , Maybe Int -- ^ the last number that was tried against the actual number
           )

Reduce complexity and prefer library functions

Let's have a look at findAnswer:

findAnswer ::BingoBoard -> Int
findAnswer value@(x:xs) = (*)  (findbaseValue x) (findFalseCell 0 value)

And immediately stop. That's a strange way to write

findAnswer value@(x:_) = findbaseValue x * findFalseCell 0 value

While you can use parentheses to make the multiplication more obvious, I would certainly not use the prefix-variant of the operator itself.

Next, let's continue with the helpers:

        findFalseCell::Int -> BingoBoard -> Int
        findFalseCell acc [] = acc
        findFalseCell acc (x:xs) =  findFalseCell (sum' acc x) xs
        sum'::Int -> [Cell] -> Int
        sum' acc [] = acc
        sum' acc ((a, False, _): gs) = sum' (acc + a) gs
        sum' acc ((_, True, _): gs) = sum' acc gs

We need to look at them in tandem. First, let's try to simplify sum'. We summarize the number on our board, but only if it wasn't marked yet. That's a lot easier to write if we had cellMarked and cellValue helpers, but we can also just use a list comprehension:

        sum' gs = sum [a | (a, b, _) <- gs, not b]

if we had cellMarked :: Cell -> Bool and cellValue :: Cell -> Int, then we could write

        sum' = sum . map cellValue . filter (not . cellMarked)

but that's even longer.

Note that I explicitly didn't use acc within the function, since we could move the acc within

        findFalseCell acc [] = acc
        findFalseCell acc (x:xs) =  findFalseCell (sum' acc x) xs

outside of the sum' call:

        findFalseCell acc [] = acc
        findFalseCell acc (x:xs) =  acc + findFalseCell (sum' x) xs

This finally yields:

        findFalseCell xs = sum . map sum' $ xs

Next, let's have a look at findbaseValue:

        findbaseValue ::[Cell] -> Int
        findbaseValue [] = 0
        findbaseValue [(_,_, Just v)] = v
        findbaseValue ((_,_,Nothing): xs) = 0
        findbaseValue ((_,_, Just v): xs) = v

If we remember that [x] is (x:[]), we see that both v cases overlap each other and we can simplify the patterns to

        findbaseValue ((_,_, Just v): _)  = v
        findbaseValue _                   = 0

Overall, we end up with

findAnswer ::BingoBoard -> Int
findAnswer value@(x:xs) = (findBaseValue x) * (findFalseCell value)
    where 
        findFalseCell = sum . map falseCellSum

        falseCellSum gs = sum [ a | (a, b, _) <- gs, not b]

        findBaseValue ((_,_, Just v): _) = v
        findBaseValue _                  = 0

Further minor improvements

Other than that, there are mostly minor improvements. Again, many of these improvements indicate that you tinkered on the code until it worked, but didn't take additional time to clean it up, for example the unused value in flipcell value@(a, b, _).

This is a non-exhaustive list:

• findWinner is fromJust . find findWinnerHelper
• similarly, findWinnerHelper is find isWinner
• isWinner again can use List.any immediately with isRowWinner, since List.any p . map f is the same as List.any (p . f):

  isWinner arg0 = (List.any isRowWinner arg0) 
               || (List.any isRowWinner $ List.transpose arg0)
  

• updateBingoBoards's map can be simplified:

  updateBingoBoards draw boards = map (updateBingoBoard draw) boards
  

  You can also get rid of boards, but I'd personally keep it.
• flipcell within updateBingoBoard can be simplified:

  flipcell (a, b, _) = (a, b || a == arg0, Just arg0)