9 "{-# LANGUAGE NegativeLiterals #-}\n",
10 "{-# LANGUAGE FlexibleContexts #-}\n",
11 "{-# LANGUAGE OverloadedStrings #-}\n",
12 "{-# LANGUAGE TypeFamilies #-}\n",
13 "{-# LANGUAGE BangPatterns #-}"
22 "import Data.Text (Text)\n",
23 "import qualified Data.Text as T\n",
24 "import qualified Data.Text.IO as TIO\n",
26 "import Text.Megaparsec hiding (State)\n",
27 "import qualified Text.Megaparsec.Lexer as L\n",
28 "import Text.Megaparsec.Text (Parser)\n",
29 "import qualified Control.Applicative as CA\n",
30 "-- import Data.Functor (void)\n",
32 "import qualified Data.Map.Strict as M\n",
33 "import Data.Map.Strict ((!))\n",
35 "-- import Data.Vector ((!), (//))\n",
36 "-- import qualified Data.Vector as V\n",
38 "import Data.List \n",
39 "import qualified Data.Functor as F"
48 "type Grid = M.Map (Int, Int) Bool\n",
49 "-- type Grid = [[Char]]\n",
50 "-- type Grid = [[Bool]]\n",
52 "type ExplodedGrid = M.Map (Int, Int) Grid\n",
54 "data Rule = Rule Grid Grid deriving (Eq, Show)\n",
56 "rulePre (Rule g _) = g\n",
57 "rulePost (Rule _ g) = g"
62 "execution_count": 38,
66 "onlySpace = (char ' ') <|> (char '\\t')\n",
69 "sc = L.space (skipSome onlySpace) CA.empty CA.empty"
78 "lexeme = L.lexeme sc\n",
80 "symbol = L.symbol sc\n",
81 "rowSep = symbol \"/\"\n",
82 "ruleJoin = symbol \"=>\"\n",
84 "-- present :: Parser Bool\n",
85 "present = id True <$ symbol \"#\"\n",
87 "-- absent :: Parser Bool\n",
88 "absent = id False <$ symbol \".\"\n",
90 "rulesP = ruleP `sepBy` space\n",
91 "ruleP = Rule <$> gridP <*> (ruleJoin *> gridP)\n",
93 "gridP = gridify <$> rowP `sepBy` rowSep\n",
94 " where gridify g = M.fromList $ concat \n",
95 " [map (\\(c, v) -> ((r, c), v)) nr | \n",
96 " (r, nr) <- zip [0..] \n",
97 " [zip [0..] r | r <- g]]\n",
100 "rowP = some (present <|> absent)\n",
102 "successfulParse :: Text -> [Rule]\n",
103 "successfulParse input = \n",
104 " case parse rulesP \"input\" input of\n",
105 " Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err\n",
106 " Right instructions -> instructions"
111 "execution_count": 6,
117 "Rule (fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]) (fromList [((0,0),False),((0,1),True),((0,2),True),((1,0),False),((1,1),True),((1,2),True),((2,0),True),((2,1),False),((2,2),False)])"
121 "output_type": "display_data"
125 "parseTest ruleP \"#./.. => .##/.##/#..\""
130 "execution_count": 7,
136 "Rule (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),True),((2,0),False),((2,1),False),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),True),((0,3),False),((1,0),False),((1,1),True),((1,2),False),((1,3),False),((2,0),False),((2,1),True),((2,2),True),((2,3),False),((3,0),False),((3,1),False),((3,2),False),((3,3),True)])"
140 "output_type": "display_data"
144 "parseTest ruleP \"##./#.#/... => #.#./.#../.##./...#\""
149 "execution_count": 8,
153 "testRule = head $ successfulParse \"##./#.#/... => #.#./.#../.##./...#\""
158 "execution_count": 9,
164 "Rule (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),True),((2,0),False),((2,1),False),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),True),((0,3),False),((1,0),False),((1,1),True),((1,2),False),((1,3),False),((2,0),False),((2,1),True),((2,2),True),((2,3),False),((3,0),False),((3,1),False),((3,2),False),((3,3),True)])"
168 "output_type": "display_data"
177 "execution_count": 10,
183 "[Rule (fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]) (fromList [((0,0),False),((0,1),True),((0,2),True),((1,0),False),((1,1),True),((1,2),True),((2,0),True),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),True),((2,0),False),((2,1),False),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),True),((0,3),False),((1,0),False),((1,1),True),((1,2),False),((1,3),False),((2,0),False),((2,1),True),((2,2),True),((2,3),False),((3,0),False),((3,1),False),((3,2),False),((3,3),True)])]"
187 "output_type": "display_data"
191 "parseTest rulesP \"#./.. => .##/.##/#..\\n##./#.#/... => #.#./.#../.##./...#\""
195 "cell_type": "markdown",
198 "Rule (fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]) \n",
199 " (fromList [((0,0),False),((0,1),True),((0,2),True),((1,0),False),((1,1),True),((1,2),True),((2,0),True),((2,1),False),((2,2),False),((2,3),True),((2,4),True),((2,5),False),((3,0),True),((3,1),False),((3,2),True),((4,0),False),((4,1),False),((4,2),False)]),\n",
201 "Rule (fromList []) \n",
202 " (fromList [((0,0),True),((0,1),False),((0,2),True),((0,3),False),((1,0),False),((1,1),True),((1,2),False),((1,3),False),((2,0),False),((2,1),True),((2,2),True),((2,3),False),((3,0),False),((3,1),False),((3,2),False),((3,3),True)])"
207 "execution_count": 11,
211 "g = [[False,True,True],[False,True,True],[True,False,False]]"
216 "execution_count": 12,
222 "[((0,0),False),((0,1),True),((0,2),True),((1,0),False),((1,1),True),((1,2),True),((2,0),True),((2,1),False),((2,2),False)]"
226 "output_type": "display_data"
230 "concat [map (\\(c, v) -> ((r, c), v)) nr | (r, nr) <- zip [0..] [zip [0..] r | r <- g]]"
235 "execution_count": 53,
239 "bounds :: M.Map (Int, Int) a -> (Int, Int)\n",
240 "bounds grid = (maximum $ map fst $ M.keys grid, maximum $ map snd $ M.keys grid)"
245 "execution_count": 54,
255 "output_type": "display_data"
259 "bounds (rulePost testRule)"
264 "execution_count": 15,
268 "showGrid g = unlines [[showChar $ M.findWithDefault False (r, c) g | \n",
269 " c <- [0..cm] ] | r <- [0..rm] ]\n",
270 " where (rm, cm) = bounds g\n",
271 " showChar True = '#'\n",
272 " showChar False = '.'"
277 "execution_count": 16,
290 "output_type": "display_data"
294 "putStrLn $ showGrid $ rulePost testRule"
299 "execution_count": 17,
303 "initialGrid = case parse gridP \"\" \".#./..#/###\" of \n",
304 " Left _ -> M.empty \n",
310 "execution_count": 18,
316 "fromList [((0,0),False),((0,1),True),((0,2),False),((1,0),False),((1,1),False),((1,2),True),((2,0),True),((2,1),True),((2,2),True)]"
320 "output_type": "display_data"
329 "execution_count": 19,
341 "output_type": "display_data"
345 "putStrLn $ showGrid initialGrid"
350 "execution_count": 20,
354 "reflectH g = M.fromList [((r, c) , M.findWithDefault False (rm - r, c) g) | r <- [0..rm], c <- [0..cm] ]\n",
355 " where (rm, cm) = bounds g"
360 "execution_count": 21,
372 "output_type": "display_data"
376 "putStrLn $ showGrid $ reflectH initialGrid"
381 "execution_count": 22,
385 "reflectV g = M.fromList [((r, c) , M.findWithDefault False (r, cm - c) g) | r <- [0..rm], c <- [0..cm] ]\n",
386 " where (rm, cm) = bounds g"
391 "execution_count": 23,
403 "output_type": "display_data"
407 "putStrLn $ showGrid $ reflectV initialGrid"
412 "execution_count": 24,
416 "transpose g = M.fromList [((c, r) , M.findWithDefault False (r, c) g) | r <- [0..rm], c <- [0..cm] ]\n",
417 " where (rm, cm) = bounds g"
422 "execution_count": 25,
434 "output_type": "display_data"
438 "putStrLn $ showGrid $ transpose initialGrid"
443 "execution_count": 26,
447 "allArrangements grid = map (\\f -> f grid) [ id\n",
451 " , reflectH . transpose\n",
452 " , reflectV . transpose\n",
453 " , reflectH . reflectV . transpose\n",
454 " , reflectV . reflectH\n",
460 "execution_count": 27,
466 "[\".#.\\n..#\\n###\\n\",\"###\\n..#\\n.#.\\n\",\".#.\\n#..\\n###\\n\",\"..#\\n#.#\\n.##\\n\",\".##\\n#.#\\n..#\\n\",\"#..\\n#.#\\n##.\\n\",\"##.\\n#.#\\n#..\\n\",\"###\\n#..\\n.#.\\n\"]"
470 "output_type": "display_data"
474 "map showGrid $ allArrangements initialGrid"
479 "execution_count": 28,
489 "output_type": "display_data"
493 "sampleRulesCompact = successfulParse \"../.# => ##./#../...\\n.#./..#/### => #..#/..../..../#..#\"\n",
494 "length sampleRulesCompact"
499 "execution_count": 29,
503 "expandRule rule = [Rule l (rulePost rule) | l <- allArrangements (rulePre rule)]\n",
504 "expandRules = concatMap expandRule"
509 "execution_count": 30,
515 "[\"##.\\n#.#\\n...\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\"...\\n#.#\\n##.\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\".##\\n#.#\\n...\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\"##.\\n#..\\n.#.\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\".#.\\n#..\\n##.\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\".##\\n..#\\n.#.\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\".#.\\n..#\\n.##\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\",\"...\\n#.#\\n.##\\n=>#.#.\\n.#..\\n.##.\\n...#\\n\"]"
519 "output_type": "display_data"
523 "[showGrid (rulePre r) ++ \"=>\" ++ showGrid (rulePost r) | r <- expandRule testRule]"
528 "execution_count": 31,
538 "output_type": "display_data"
542 "length $ expandRules sampleRulesCompact"
547 "execution_count": 32,
551 "readRules = expandRules . successfulParse"
556 "execution_count": 33,
564 "[Rule (fromList [((0,0),False),((0,1),False),((1,0),False),((1,1),True)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),True),((1,0),False),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),False),((1,0),True),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),False),((1,0),False),((1,1),True)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),True),((1,0),False),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),False),((1,0),True),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]) (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),False),((2,2),False)]),Rule (fromList [((0,0),False),((0,1),True),((0,2),False),((1,0),False),((1,1),False),((1,2),True),((2,0),True),((2,1),True),((2,2),True)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),True),((0,1),True),((0,2),True),((1,0),False),((1,1),False),((1,2),True),((2,0),False),((2,1),True),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),False),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),False),((2,0),True),((2,1),True),((2,2),True)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),False),((0,1),False),((0,2),True),((1,0),True),((1,1),False),((1,2),True),((2,0),False),((2,1),True),((2,2),True)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),False),((0,1),True),((0,2),True),((1,0),True),((1,1),False),((1,2),True),((2,0),False),((2,1),False),((2,2),True)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),True),((0,1),False),((0,2),False),((1,0),True),((1,1),False),((1,2),True),((2,0),True),((2,1),True),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),True),((0,1),True),((0,2),False),((1,0),True),((1,1),False),((1,2),True),((2,0),True),((2,1),False),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)]),Rule (fromList [((0,0),True),((0,1),True),((0,2),True),((1,0),True),((1,1),False),((1,2),False),((2,0),False),((2,1),True),((2,2),False)]) (fromList [((0,0),True),((0,1),False),((0,2),False),((0,3),True),((1,0),False),((1,1),False),((1,2),False),((1,3),False),((2,0),False),((2,1),False),((2,2),False),((2,3),False),((3,0),True),((3,1),False),((3,2),False),((3,3),True)])]"
568 "output_type": "display_data"
572 "sampleRules = readRules \"../.# => ##./#../...\\n.#./..#/### => #..#/..../..../#..#\"\n",
578 "execution_count": 125,
582 "text <- TIO.readFile \"../../data/advent21.txt\"\n",
583 "rules = readRules text"
588 "execution_count": 126,
598 "output_type": "display_data"
607 "execution_count": 34,
611 "apply rules grid = rulePost thisRule\n",
612 " where ri = head $ findIndices (\\r -> rulePre r == grid) rules\n",
613 " thisRule = rules!!ri"
618 "execution_count": 37,
631 "output_type": "display_data"
635 "putStrLn $ showGrid $ apply sampleRules initialGrid"
640 "execution_count": 49,
644 "subGrid :: Int -> Grid -> Int -> Int -> Grid\n",
645 "subGrid n g bigR bigC = M.fromList [ ((r, c), \n",
646 " M.findWithDefault False (r + rStep, c + cStep) g) \n",
647 " | r <- [0..(n - 1)], c <- [0..(n - 1)]\n",
649 " where rStep = bigR * n\n",
655 "execution_count": 50,
659 "explodeGrid' :: Int -> Grid -> ExplodedGrid\n",
660 "explodeGrid' n g = M.fromList [((bigR, bigC), subGrid n g bigR bigC) | bigR <- [0..bigRm], bigC <- [0..bigCm]]\n",
661 " where (rm, cm) = bounds g\n",
662 " bigRm = (rm + 1) `div` n - 1\n",
663 " bigCm = (cm + 1) `div` n - 1"
668 "execution_count": 107,
672 "explodeGrid :: Grid -> ExplodedGrid\n",
673 "explodeGrid g = if (rm + 1) `rem` 2 == 0 \n",
674 " then explodeGrid' 2 g\n",
675 " else explodeGrid' 3 g\n",
676 " where (rm, cm) = bounds g"
681 "execution_count": 108,
687 "fromList [((0,0),\"#.\\n..\\n\"),((0,1),\".#\\n..\\n\"),((1,0),\"..\\n#.\\n\"),((1,1),\"..\\n.#\\n\")]"
691 "output_type": "display_data"
695 "testEg = explodeGrid $ apply sampleRules initialGrid\n",
696 "M.map showGrid testEg"
701 "execution_count": 77,
705 "explodedRows eg = [M.filterWithKey (\\(r, _) _ -> r == row) eg | row <- [0..rowMax] ]\n",
706 " where (rowMax, _) = bounds eg"
711 "execution_count": 78,
717 "[fromList [((0,0),fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]),((0,1),fromList [((0,0),False),((0,1),True),((1,0),False),((1,1),False)])],fromList [((1,0),fromList [((0,0),False),((0,1),False),((1,0),True),((1,1),False)]),((1,1),fromList [((0,0),False),((0,1),False),((1,0),False),((1,1),True)])]]"
721 "output_type": "display_data"
725 "explodedRows testEg"
730 "execution_count": 79,
734 "(>-<) g1 g2 = M.union g1 g2'\n",
735 " where (_, cm) = bounds g1\n",
736 " g2' = M.mapKeys (\\(r, c) -> (r, c + cm + 1)) g2"
741 "execution_count": 80,
745 "(>|<) g1 g2 = M.union g1 g2'\n",
746 " where (rm, _) = bounds g1\n",
747 " g2' = M.mapKeys (\\(r, c) -> (r + rm + 1, c)) g2"
752 "execution_count": 81,
758 "fromList [((0,0),True),((0,1),False),((1,0),False),((1,1),False)]"
762 "output_type": "display_data"
766 "M.findWithDefault M.empty (0, 0) testEg"
771 "execution_count": 82,
777 "<style>/* Styles used for the Hoogle display in the pager */\n",
780 "padding-bottom: 1.3em;\n",
781 "padding-left: 0.4em;\n",
785 "font-family: monospace;\n",
786 "white-space: pre;\n",
793 "font-weight: bold;\n",
796 "font-weight: bold;\n",
800 "margin-left: 0.4em;\n",
802 ".hoogle-package {\n",
803 "font-weight: bold;\n",
804 "font-style: italic;\n",
806 ".hoogle-module {\n",
807 "font-weight: bold;\n",
810 "font-weight: bold;\n",
814 "font-weight: bold;\n",
815 "font-family: monospace;\n",
817 "white-space: pre-wrap;\n",
821 "font-weight: bold;\n",
822 "font-family: monospace;\n",
823 "margin-left: 1em;\n",
826 "font-family: monospace;\n",
831 "font-style: italic;\n",
832 "font-family: monospace;\n",
833 "white-space: pre;\n",
838 "font-weight: bold;\n",
840 ".err-msg.in.collapse {\n",
841 "padding-top: 0.7em;\n",
843 ".highlight-code {\n",
844 "white-space: pre;\n",
845 "font-family: monospace;\n",
847 ".suggestion-warning { \n",
848 "font-weight: bold;\n",
849 "color: rgb(200, 130, 0);\n",
851 ".suggestion-error { \n",
852 "font-weight: bold;\n",
855 ".suggestion-name {\n",
856 "font-weight: bold;\n",
858 "</style><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
859 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">M.findWithDefault M.empty (0, 1) testEg >-<\n",
860 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
861 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
862 " M.findWithDefault M.empty (0, 0) testEg</div></div>"
865 "Line 1: Redundant bracket\n",
867 "(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
868 " (M.findWithDefault M.empty (0, 0) testEg)\n",
870 "M.findWithDefault M.empty (0, 1) testEg >-<\n",
871 " (M.findWithDefault M.empty (0, 0) testEg)Line 1: Redundant bracket\n",
873 "(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
874 " (M.findWithDefault M.empty (0, 0) testEg)\n",
876 "(M.findWithDefault M.empty (0, 1) testEg) >-<\n",
877 " M.findWithDefault M.empty (0, 0) testEg"
881 "output_type": "display_data"
890 "output_type": "display_data"
894 "showGrid $ (M.findWithDefault M.empty (0, 1) testEg) >-< (M.findWithDefault M.empty (0, 0) testEg)"
899 "execution_count": 83,
905 "<style>/* Styles used for the Hoogle display in the pager */\n",
908 "padding-bottom: 1.3em;\n",
909 "padding-left: 0.4em;\n",
913 "font-family: monospace;\n",
914 "white-space: pre;\n",
921 "font-weight: bold;\n",
924 "font-weight: bold;\n",
928 "margin-left: 0.4em;\n",
930 ".hoogle-package {\n",
931 "font-weight: bold;\n",
932 "font-style: italic;\n",
934 ".hoogle-module {\n",
935 "font-weight: bold;\n",
938 "font-weight: bold;\n",
942 "font-weight: bold;\n",
943 "font-family: monospace;\n",
945 "white-space: pre-wrap;\n",
949 "font-weight: bold;\n",
950 "font-family: monospace;\n",
951 "margin-left: 1em;\n",
954 "font-family: monospace;\n",
959 "font-style: italic;\n",
960 "font-family: monospace;\n",
961 "white-space: pre;\n",
966 "font-weight: bold;\n",
968 ".err-msg.in.collapse {\n",
969 "padding-top: 0.7em;\n",
971 ".highlight-code {\n",
972 "white-space: pre;\n",
973 "font-family: monospace;\n",
975 ".suggestion-warning { \n",
976 "font-weight: bold;\n",
977 "color: rgb(200, 130, 0);\n",
979 ".suggestion-error { \n",
980 "font-weight: bold;\n",
983 ".suggestion-name {\n",
984 "font-weight: bold;\n",
986 "</style><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
987 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">M.findWithDefault M.empty (0, 1) testEg >|<\n",
988 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-name\" style=\"clear:both;\">Redundant bracket</div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Found:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
989 " (M.findWithDefault M.empty (0, 0) testEg)</div></div><div class=\"suggestion-row\" style=\"float: left;\"><div class=\"suggestion-warning\">Why Not:</div><div class=\"highlight-code\" id=\"haskell\">(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
990 " M.findWithDefault M.empty (0, 0) testEg</div></div>"
993 "Line 1: Redundant bracket\n",
995 "(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
996 " (M.findWithDefault M.empty (0, 0) testEg)\n",
998 "M.findWithDefault M.empty (0, 1) testEg >|<\n",
999 " (M.findWithDefault M.empty (0, 0) testEg)Line 1: Redundant bracket\n",
1001 "(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
1002 " (M.findWithDefault M.empty (0, 0) testEg)\n",
1004 "(M.findWithDefault M.empty (0, 1) testEg) >|<\n",
1005 " M.findWithDefault M.empty (0, 0) testEg"
1009 "output_type": "display_data"
1014 "\".#\\n..\\n#.\\n..\\n\""
1018 "output_type": "display_data"
1022 "showGrid $ (M.findWithDefault M.empty (0, 1) testEg) >|< (M.findWithDefault M.empty (0, 0) testEg)"
1026 "cell_type": "code",
1027 "execution_count": 88,
1031 "contractExploded :: ExplodedGrid -> Grid\n",
1032 "contractExploded gs = foldl1 (>|<) $ map (foldl1 (>-<)) rows\n",
1033 " where rows = explodedRows gs"
1037 "cell_type": "code",
1038 "execution_count": 90,
1044 "\"#..#\\n....\\n....\\n#..#\\n\""
1048 "output_type": "display_data"
1052 "showGrid $ contractExploded testEg"
1056 "cell_type": "code",
1057 "execution_count": 94,
1072 "output_type": "display_data"
1076 "putStrLn $ showGrid $ contractExploded $ M.map (apply sampleRules) testEg"
1080 "cell_type": "code",
1081 "execution_count": 128,
1085 "applyOnce rules g = contractExploded $ M.map (apply rules) $ explodeGrid g"
1089 "cell_type": "code",
1090 "execution_count": 135,
1096 ".#.#.#.#..##..#.##\n",
1097 ".#.#...#..##....##\n",
1098 "..####..##..####..\n",
1099 "..#.#..##.###.#.#.\n",
1100 "....#..##.###...#.\n",
1101 "###..##..#..###..#\n",
1102 "..#.##..#.##.##...\n",
1103 "....##....##.##.##\n",
1104 "####..####..#..##.\n",
1105 "#.#.#.#.#.#.....#.\n",
1106 "#...#.#...#..##.#.\n",
1107 "###..####..###...#\n",
1108 "..#.##..#.##..#.##\n",
1109 "....##....##....##\n",
1110 "####..####..####..\n",
1111 "#.#.#.#.#.#.#.#.#.\n",
1112 "#...#.#...#.#...#.\n",
1113 "###..####..####..#"
1117 "output_type": "display_data"
1121 "putStrLn $ showGrid $ (!! 5) $ iterate (applyOnce rules) initialGrid"
1125 "cell_type": "code",
1126 "execution_count": 131,
1137 "output_type": "display_data"
1141 "putStrLn $ showGrid $ (!(1, 2)) $ explodeGrid $ last $ take 3 $ iterate (applyOnce rules) initialGrid"
1145 "cell_type": "code",
1146 "execution_count": 136,
1150 "countLit = M.size . M.filter id"
1154 "cell_type": "code",
1155 "execution_count": 137,
1165 "output_type": "display_data"
1169 "countLit initialGrid"
1173 "cell_type": "code",
1174 "execution_count": 142,
1189 "output_type": "display_data"
1193 "putStrLn $ showGrid $ (!! 2) $ iterate (applyOnce sampleRules) initialGrid"
1197 "cell_type": "code",
1198 "execution_count": 143,
1208 "output_type": "display_data"
1212 "countLit $ (!! 2) $ iterate (applyOnce sampleRules) initialGrid"
1216 "cell_type": "code",
1217 "execution_count": 144,
1227 "output_type": "display_data"
1231 "countLit $ (!! 5) $ iterate (applyOnce rules) initialGrid"
1235 "cell_type": "code",
1236 "execution_count": 145,
1246 "output_type": "display_data"
1250 "countLit $ (!! 18) $ iterate (applyOnce rules) initialGrid"
1254 "cell_type": "code",
1255 "execution_count": null,
1263 "display_name": "Haskell",
1264 "language": "haskell",
1268 "codemirror_mode": "ihaskell",
1269 "file_extension": ".hs",