Added type annotations and a more parallel version

[advent-of-code-17.git] / src / advent21 / advent21.hs

diff --git a/src/advent21/advent21.hs b/src/advent21/advent21.hs
index 62b5b5c5c42cdeae3de3f22c555339055a43c081..a4a092bb755b69d943df6ae998c9257e59065147 100644 (file)
--- a/src/advent21/advent21.hs
+++ b/src/advent21/advent21.hs
@@ -42,21 +42,34 @@ main = do
         print $ countLit $ nthApplication rules 18
 
 
+-- Read the rules, and expand them to all equivalent left hand sides
 readRules :: Text -> [Rule]
 readRules = expandRules . successfulParse
 
+
+expandRules :: [Rule] -> [Rule]
 expandRules = concatMap expandRule
+
+expandRule :: Rule -> [Rule]
 expandRule rule = [Rule l (rulePost rule) | l <- allArrangements (rulePre rule)]
 
+
+reflectH :: Grid -> Grid
 reflectH g = M.fromList [((r, c) , M.findWithDefault False (rm - r, c) g) | r <- [0..rm], c <- [0..cm] ]
     where (rm, cm) = bounds g
 
+reflectV :: Grid -> Grid
 reflectV g = M.fromList [((r, c) , M.findWithDefault False (r, cm - c) g) | r <- [0..rm], c <- [0..cm] ]
     where (rm, cm) = bounds g
 
+-- awkward naming to avoid clashing with Prelude
+transposeG :: Grid -> Grid
 transposeG g = M.fromList [((c, r) , M.findWithDefault False (r, c) g) | r <- [0..rm], c <- [0..cm] ]
     where (rm, cm) = bounds g
 
+
+-- Find all the arrangments of a grid, including reflection and rotation.
+allArrangements :: Grid -> [Grid]
 allArrangements grid = map (\f -> f grid) [ id
                                           , reflectH
                                           , reflectV
@@ -69,32 +82,32 @@ allArrangements grid = map (\f -> f grid) [ id
 
 
 
-
+-- Count number of lit pixels
+countLit :: Grid -> Int
 countLit = M.size . M.filter id
 
-
-applyOnce rules g = contractExploded $ M.map (apply rules) $ explodeGrid g
-
+-- apply the rules _n_ times
+nthApplication :: [Rule] -> Int -> Grid
 nthApplication rules n = (!! n) $ iterate (applyOnce rules) initialGrid
 
+-- Apply one step of the expansion
+applyOnce :: [Rule] -> Grid -> Grid
+applyOnce rules g = contractExploded $ M.map (apply rules) $ explodeGrid g
 
-
+-- find the appropriate rule and apply it to a grid
+apply :: [Rule] -> Grid -> Grid
 apply rules grid = rulePost thisRule
     where ri = head $ findIndices (\r -> rulePre r == grid) rules
           thisRule = rules!!ri
 
 
+-- create the appropriate subgrids of a grid
 explodeGrid :: Grid -> ExplodedGrid
 explodeGrid g = if (rm + 1) `rem` 2 == 0 
                 then explodeGrid' 2 g
                 else explodeGrid' 3 g
     where (rm, cm) = bounds g
 
-contractExploded :: ExplodedGrid -> Grid
-contractExploded gs = foldl1 (>|<) $ map (foldl1 (>-<)) rows
-    where rows = explodedRows gs
-
-
 explodeGrid' :: Int -> Grid -> ExplodedGrid
 explodeGrid' n g = M.fromList [((bigR, bigC), subGrid n g bigR bigC) | bigR <- [0..bigRm], bigC <- [0..bigCm]]
     where (rm, cm) = bounds g
@@ -110,14 +123,24 @@ subGrid n g bigR bigC = M.fromList [ ((r, c),
     where rStep = bigR * n
           cStep = bigC * n
 
+-- merge a set of subgrids into one
+contractExploded :: ExplodedGrid -> Grid
+contractExploded gs = foldl1 (>|<) $ map (foldl1 (>-<)) rows
+    where rows = explodedRows gs
 
+-- find the rows of an exploded grid
+explodedRows :: ExplodedGrid -> [ExplodedGrid]
 explodedRows eg = [M.filterWithKey (\(r, _) _ -> r == row) eg | row <- [0..rowMax] ]
     where (rowMax, _) = bounds eg
 
+-- merge two grids horizontally
+(>-<) :: Grid -> Grid -> Grid
 (>-<) g1 g2 = M.union g1 g2'
     where (_, cm) = bounds g1
           g2' = M.mapKeys (\(r, c) -> (r, c + cm + 1)) g2
 
+-- merge two grids vertically
+(>|<) :: Grid -> Grid -> Grid
 (>|<) g1 g2 = M.union g1 g2'
     where (rm, _) = bounds g1
           g2' = M.mapKeys (\(r, c) -> (r + rm + 1, c)) g2      
@@ -125,11 +148,11 @@ explodedRows eg = [M.filterWithKey (\(r, _) _ -> r == row) eg | row <- [0..rowMa
 
 
 
-
 bounds :: M.Map (Int, Int) a -> (Int, Int)
 bounds grid = (maximum $ map fst $ M.keys grid, maximum $ map snd $ M.keys grid)
 
 
+showGrid :: Grid -> String
 showGrid g = unlines [[showGChar $ M.findWithDefault False (r, c) g | 
                 c <- [0..cm] ] | r <- [0..rm] ]
     where (rm, cm) = bounds g
@@ -137,6 +160,8 @@ showGrid g = unlines [[showGChar $ M.findWithDefault False (r, c) g |
           showGChar False = '.'
 
 
+
+-- really persuade Megaparsec not to include newlines in how it consume spaces.
 onlySpace = (char ' ') <|> (char '\t')
 
 sc :: Parser ()
@@ -152,7 +177,7 @@ present = id True <$ symbol "#"
 absent = id False <$ symbol "."
 
 rulesP = ruleP `sepBy` space
-ruleP = Rule <$> gridP <*> (ruleJoin *> gridP)
+ruleP = Rule <$> gridP <* ruleJoin <*> gridP
 
 gridP = gridify <$> rowP `sepBy` rowSep
     where gridify g = M.fromList $ concat