100 lines
12 KiB
Haskell
100 lines
12 KiB
Haskell
|
checkBingo :: [[Integer]] -> Bool
|
||
|
|
checkBingo st
|
||
|
|
| checkHorzBingo st = True
|
||
|
|
| checkHorzBingo (transpose st) = True
|
||
|
|
| otherwise = False
|
||
|
|
|
||
|
|
checkHorzBingo :: [[Integer]] -> Bool
|
||
|
|
checkHorzBingo [] = False
|
||
|
|
checkHorzBingo st
|
||
|
|
| checkLine (head st) = True
|
||
|
|
| otherwise = checkHorzBingo (tail st)
|
||
|
|
|
||
|
|
checkLine :: [Integer] -> Bool
|
||
|
|
checkLine [] = True
|
||
|
|
checkLine xs
|
||
|
|
| x == -1 = checkLine (tail xs)
|
||
|
|
| otherwise = False
|
||
|
|
where x = head xs
|
||
|
|
|
||
|
|
transpose :: [[a]] -> [[a]]
|
||
|
|
transpose [] = []
|
||
|
|
transpose ([] : xss) = transpose xss
|
||
|
|
transpose ((x : xs) : xss) = combine x hds xs tls
|
||
|
|
where
|
||
|
|
(hds, tls) = unzip [(hd, tl) | hd : tl <- xss]
|
||
|
|
combine y h ys t = (y:h) : transpose (ys:t)
|
||
|
|
|
||
|
|
winRank :: [[Integer]] -> [Integer] -> Integer
|
||
|
|
winRank board input = winRank' board input 0
|
||
|
|
|
||
|
|
winRank' :: [[Integer]] -> [Integer] -> Integer -> Integer
|
||
|
|
winRank' _ [] _ = -1
|
||
|
|
winRank' board inputList rank
|
||
|
|
| checkBingo modifiedBoard = rank
|
||
|
|
| otherwise = winRank' modifiedBoard (tail inputList) (rank + 1)
|
||
|
|
where input = head inputList
|
||
|
|
modifiedBoard = modifyBoard board input
|
||
|
|
|
||
|
|
calcScore :: [[Integer]] -> [Integer] -> Integer
|
||
|
|
calcScore _ [] = 0
|
||
|
|
calcScore board inputList
|
||
|
|
| checkBingo modifiedBoard = calcScore' modifiedBoard input
|
||
|
|
| otherwise = calcScore modifiedBoard (tail inputList)
|
||
|
|
where input = head inputList
|
||
|
|
modifiedBoard = modifyBoard board input
|
||
|
|
|
||
|
|
calcScore' :: [[Integer]] -> Integer -> Integer
|
||
|
|
calcScore' board lastNum = (sumUnmarkedBoard board) * lastNum
|
||
|
|
|
||
|
|
sumUnmarkedBoard :: [[Integer]] -> Integer
|
||
|
|
sumUnmarkedBoard [] = 0
|
||
|
|
sumUnmarkedBoard x = sumUnmarkedLine (head x) + sumUnmarkedBoard (tail x)
|
||
|
|
|
||
|
|
sumUnmarkedLine :: [Integer] -> Integer
|
||
|
|
sumUnmarkedLine [] = 0
|
||
|
|
sumUnmarkedLine line
|
||
|
|
| x == -1 = 0 + sumUnmarkedLine (tail line)
|
||
|
|
| otherwise = x + sumUnmarkedLine (tail line)
|
||
|
|
where x = (head line)
|
||
|
|
|
||
|
|
modifyBoard :: [[Integer]] -> Integer -> [[Integer]]
|
||
|
|
modifyBoard board match = [[if x == match then -1 else x | x <- row] | row <- board]
|
||
|
|
|
||
|
|
calcWinList :: [[[Integer]]] -> [Integer] -> [Integer]
|
||
|
|
calcWinList [] _ = []
|
||
|
|
calcWinList boards input = winRank (head boards) input : calcWinList (tail boards) input
|
||
|
|
|
||
|
|
calcBoards :: [[[Integer]]] -> [Integer] -> Integer
|
||
|
|
calcBoards boards input = calcScore (head (drop (findMinIndex (calcWinList boards input)) boards)) input
|
||
|
|
|
||
|
|
calcBoardsLoser :: [[[Integer]]] -> [Integer] -> Integer
|
||
|
|
calcBoardsLoser boards input = calcScore (head (drop (findMaxIndex (calcWinList boards input)) boards)) input
|
||
|
|
|
||
|
|
findMinIndex :: [Integer] -> Int
|
||
|
|
findMinIndex x = findMinIndex' x 10000000 0 0
|
||
|
|
|
||
|
|
findMinIndex' :: [Integer] -> Integer -> Int -> Int -> Int
|
||
|
|
findMinIndex' [] _ x _ = x
|
||
|
|
findMinIndex' list currentMin minIndex currentIndex
|
||
|
|
| current < currentMin = findMinIndex' (tail list) current currentIndex (currentIndex + 1)
|
||
|
|
| otherwise = findMinIndex' (tail list) currentMin minIndex (currentIndex + 1)
|
||
|
|
where current = (head list)
|
||
|
|
|
||
|
|
findMaxIndex :: [Integer] -> Int
|
||
|
|
findMaxIndex x = findMaxIndex' x 0 0 0
|
||
|
|
|
||
|
|
findMaxIndex' :: [Integer] -> Integer -> Int -> Int -> Int
|
||
|
|
findMaxIndex' [] _ x _ = x
|
||
|
|
findMaxIndex' list currentMax maxIndex currentIndex
|
||
|
|
| current > currentMax = findMaxIndex' (tail list) current currentIndex (currentIndex + 1)
|
||
|
|
| otherwise = findMaxIndex' (tail list) currentMax maxIndex (currentIndex + 1)
|
||
|
|
where current = (head list)
|
||
|
|
|
||
|
|
inputList1 = [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]
|
||
|
|
inputBoards1 = [[[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]],[[14,21,17,24,4],[10,16,15,9,19],[18,8,23,26,20],[22,11,13,6,5],[2,0,12,3,7]]]
|
||
|
|
|
||
|
|
inputList2 = [4,75,74,31,76,79,27,19,69,46,98,59,83,23,90,52,87,6,11,92,80,51,43,5,94,17,15,67,25,30,48,47,62,71,85,58,60,1,72,99,3,35,42,10,96,49,37,36,8,44,70,40,45,39,0,63,2,78,68,53,50,77,20,55,38,86,54,93,26,88,12,91,95,34,9,14,33,66,41,13,28,57,29,73,56,22,89,21,64,61,32,65,97,84,18,82,81,7,16,24]
|
||
|
|
|
||
|
|
inputBoards2 = [[[30,46,94,20, 2],[53,67,69,75,65],[27,24,85,28,60],[57,58,42,36,78],[35,98,87,91,93]],[[72,71,91,73,19],[ 2,13,14, 8,74],[42,34,31,56, 9],[82,59,44,67,79],[49, 6,98,10,30]],[[95,24,25,11,34],[57,65,41,92, 8],[91,26, 1,62,38],[47,93, 4,37, 0],[15,44,33,20,97]],[[24,69,55, 7,25],[45,64,56,71,18],[94,10,62,19,36],[53,74,49,61,80],[50,68,60,76,84]],[[86,78,29, 1,71],[ 2, 9,24,34,96],[47,75,61,13,26],[10,66,28,83,14],[91,63,45,76,50]],[[61,60,22,11,95],[25,81,13,15,53],[59,89,65,18,39],[58,50, 1,47,52],[48,16,29,75,56]],[[62, 0,93,41,53],[69,47,29,50,46],[81, 8,20,38,23],[ 4,64, 5,37,27],[32,75,48,33,15]],[[97,75,15,55,36],[98,77,76, 3,69],[11,39,88,18,93],[94,99,59,50,63],[33,26,35,58,14]],[[58,91, 7,36,81],[44,90,46,57,93],[16,35,28,61,34],[60, 3,96,65,14],[24,49,94,11,77]],[[ 5,91,53,85,36],[ 6,64,41, 7,50],[87,94,96,15,49],[18,78,37,52,75],[28,34,16,71,48]],[[75,14, 2,52,49],[79,37,13,53,12],[91,73,94,72,36],[48,54, 3,93, 5],[40,85,42, 9,50]],[[26,53,24,58,95],[15,54,65,80,30],[90,72,27,40,47],[81,22,57, 1,17],[82,46,20,94,49]],[[60,25,86,18,92],[ 2,85,89, 5,55],[12,71,74,46,68],[33,52,82,84,29],[76,43,40,11,31]],[[21,23,93,46,60],[99,20,75,55, 4],[73, 9,74,92,16],[25,35, 0,70,90],[27,86,42,94,15]],[[69,73,42,46,53],[ 5,71,50, 6,74],[14,44,99,62,87],[54,84,86,94,21],[29,51,38,67, 8]],[[43,28,24,46,22],[61,15, 4,52,17],[62,77,18,56,85],[93,60,33,71,41],[63, 2, 6,68,92]],[[60,92,52,36,38],[66,34,26,19,25],[24,65,90,39,74],[17,97,96, 7,48],[50,55,57,73,64]],[[19,77,60,66,16],[41,54, 5,49, 6],[69,61,94,86,98],[67,37,87,71,72],[44,96,90,40,74]],[[90,49,68,74,32],[31,85,42,65,53],[76,43,41,36,20],[16,75,46,47,86],[54,44,95,13,23]],[[56, 0,88,99,76],[10,42,96,30,14],[67,73,16,21,35],[80,41,64,40,78],[13,19, 4,24,20]],[[79,98,28,58,41],[24,97,85,22,89],[12,81,68,50,47],[ 2,34,16, 6,95],[64,51,11,43,26]],[[ 6,39,79,95, 3],[82, 9,61,80,33],[94,87,13,70,11],[ 0, 8,37,35,19],[62,75,84,55,93]],[[44,51,54,27,94],[77,32,81,71,62],[98,91,68,41,89],[ 6,39,40,56,53],[73,88, 5,49,80]],[[97,29,15,61,83],[46,69,51,71,17],[40,94,49,14,66],[52,20,57,62,80],[19,72,75,84,36]],[[27,26,95,78,92],[98,18,31,51,45],[39,43,94,33,13],[50,16,71,30,22],[70,81,36,38,64]],[[90, 7,71,11,63],[25,39,61,17,46],[51,86,56,81,84],[14,33,37,23,60],[52,64, 8,65,29]],[[41,92,40,71,33],[90, 2,24,37,25],[ 0,94,74,53,69],[81,61, 1,70,88],[44,34,99,29,75]],[[63,39,44, 3,82],[68,95,67,28,49],[22,53,76,81,47],[15,75, 0,54, 6],[86,37,65,52,77]],[[11,64,39,47,72],[97,59,83,19,58],[12,65,92,89,28],[ 9,78,40,79,99],[17,50,71,18,68]],[[31,78,27,32,18],[97,20,60,68,88],[12, 5,99,49,82],[35, 6,87, 2,61],[70,53,63,36,93]],[[89, 4,50,54,80],[85,36,17, 5,71],[44,95,57,73,60],[46,92,25, 8,59],[98,82,21,93,99]],[[27,12,82,95,47],[ 8,21,69,83,64],[11, 7,88,26,30],[70,96,18,75,53],[28,22,56,52,29]],[[56, 1,30,13,53],[37,86,98,19, 9],[ 3,67,16,71,85],[83,79,48,54,14],[47,62,44,95,65]],[[51,18,87,35,55],[52,85,79,56,82],[83,26,24,29,43],[80,76, 4,45,13],[11,12,99,94,47]],[[14, 1,52,95,63],[54,27,67,92,98],[34,61,26,32,33],[76,77,49,83, 2],[97,59,12,71,80]],[[78,16,59,44, 5],[73,21,53,37,50],[25,86,88,61,74],[80,30,69,56,57],[98,39,26,58,51]],[[71,48,28,14,81],[69,67, 6,77,47],[94,83, 8,40,20],[30,58, 9,99,76],[51,24,91,21,52]],[[84,76,33,14,72],[37,36,25,12,34],[39,54,89,81,30],[ 2,15,46,10,22],[41,75,27,66,69]],[[ 8,20,53,16,86],[38,99, 4,11,60],[55,14,47, 1,48],[51,50,69,52,37],[ 3,56,32,79,68]],[[69,40,17,70,98],[12,86,41,35,50],[60,44, 8,20,81],[14,82,25,55, 4],[87,67,85, 3, 5]],[[72,90,14,78,94],[ 2,85,91,97,42],[84, 9,27,70,95],[55,56,74,73, 1],[11,59,13,67,18]],[[ 5,84,21,73,13],[11,46,35,79,99],[57,25,48,52, 2],[51,70,56,54,94],[37,62,47,43,41]],[[99,30,74,11,51],[48,90, 1,27,76],[71,63,28,86,10],[52, 5,83,16,69],[70,93,92,73,43]],[[52,70,58,95,82],[74,18,90,99,39],[12,51,71,48,47],[92,11,91,16,61],[41,62,97,68, 0]],[[20,32,76,50,55],[ 4,70,14,36,82],[74,10,97,26,87],[61,83,56,98,71],[64,38, 8,65,92]],[[63,68,84,36,41],[71,44,12,77,50],[18,92,54,58,23],[89,98,72,69,25],[62,38,42, 5,52]],[[59,65,60,84,49],[51,69,12,15,38],[70, 1,79,22,35],[66,88,85,83,32],[ 3,33,7
|