clearLines optimization

src/Datatypes/Board.hs

@@ -1,5 +1,7 @@
 module Datatypes.Board (Board(..), clearLines) where
 
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -11,18 +13,24 @@ empty :: Int -> Int -> Board
 empty w h = Board w h Set.empty
 
 clearLines :: Board -> (Board, Int)
-clearLines b = let (newFilled, linesDeleted) = collectGarbage yCoords 0 (filled b)
+clearLines b = let (newFilled, linesDeleted) = collectGarbage counters 0 itemsFilled
                    in (b { filled = newFilled }, linesDeleted)
                    where
-                       yCoords = Set.toList $ Set.map (\(x, y) -> y) (filled b)
-                       countInLine l items = Set.size $ Set.filter (\(x, y) -> y == l) items
-                       collectGarbage (l:ls) count items = if countInLine l items == (width b)
-                                                            then collectGarbage ls (count + 1) (deleteLine l items)
-                                                            else collectGarbage ls count items
+                       itemsFilled = filled b
+                       boardWidth = width b
+                       counters = Map.toList $ linesCounters (Set.elems itemsFilled)
+                       collectGarbage ((y, c):ls) count items = if c == boardWidth
+                                                                    then collectGarbage ls (count + 1) (deleteLine y items)
+                                                                    else collectGarbage ls count items
                        collectGarbage [] count items = (items, count)
 
 -- PRIVATE
 
+linesCounters :: [Cell] -> Map Int Int
+linesCounters filledCells = analyzeCells filledCells Map.empty where
+    analyzeCells (c:cs) m = analyzeCells cs (Map.insertWith (\_ old -> old + 1) (snd c) 1 m)
+    analyzeCells [] m = m
+
 deleteLine :: Int -> Set Cell -> Set Cell
 deleteLine l cells = let updated = Set.filter (\(x, y) -> y /= l) cells
                          in Set.map (\(x, y) -> if y < l then (x, y + 1) else (x, y)) updated