2
\$\begingroup\$

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
```
asked Jan 25, 2022 at 8:06
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

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)
    
answered Apr 3, 2022 at 8:01
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.