Day 21

Please compile this, and even then running takes about a minute
on my PC. This is a SLOW implementation, but it works.

2 files changed, 176 insertions, 0 deletions

diff --git a/2017/21.hs b/2017/21.hs
new file mode 100644
index 0000000..4abbf58
--- /dev/null
+++ b/2017/21.hs
@@ -0,0 +1,68 @@
+import Control.Monad
+import Data.List
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+
+
+repSplitAt :: Int -> [a] -> [[a]]
+repSplitAt _ [] = []
+repSplitAt n l = let (pre, post) = splitAt n l in pre : repSplitAt n post
+
+data Pattern = Pattern Int [Bool]
+  deriving (Show, Eq, Ord)
+
+parse :: String -> (Pattern, Pattern)
+parse str =
+    let [p1, "=>", p2] = words str
+    in (parsePat p1, parsePat p2)
+
+parsePat :: String -> Pattern
+parsePat str =
+    let n = length (takeWhile (/= '/') str)
+        bin = [c == '#' | c <- str, c /= '/']
+    in Pattern n bin
+
+sp :: Pattern -> String
+sp (Pattern n pat) = intercalate "\n" (go pat)
+  where go [] = []
+        go p = let (pre, post) = splitAt n p in map ((".#" !!) . fromEnum) pre : go post
+
+genequiv :: Pattern -> [Pattern]
+genequiv pat =
+    let r = take 4 (iterate rotate pat)
+    in r ++ map mirror r
+  where
+    transform f (Pattern n p) = Pattern n [p !! f n x y | y <- [0..n-1], x <- [0..n-1]]
+    rotate = transform $ \n x y -> n * x + n - 1 - y
+    mirror = transform $ \n x y -> n * y + (n - 1 - x)
+
+getimg :: Map.Map Pattern Pattern -> Pattern -> Pattern
+getimg mp pat = fromJust $ msum $ map (flip Map.lookup mp) (genequiv pat)
+
+adjoin :: [[Bool]] -> [[Bool]] -> [[Bool]]
+adjoin a b = map (uncurry (++)) (zip a b)
+
+blocks :: [[Bool]] -> [[[[Bool]]]]
+blocks grid =
+    let n = if length grid `mod` 2 == 0 then 2 else 3
+    in map transpose $ map (map (repSplitAt n)) $ repSplitAt n grid
+
+pblocks :: [[Bool]] -> [[Pattern]]
+pblocks grid =
+    let n = if length grid `mod` 2 == 0 then 2 else 3
+    in map (map (Pattern n . concat)) (blocks grid)
+
+unpblocks :: [[Pattern]] -> [[[[Bool]]]]
+unpblocks = map $ map $ \(Pattern n p) -> repSplitAt n p
+
+joinblocks :: [[[[Bool]]]] -> [[Bool]]
+joinblocks = concatMap (foldl1 adjoin)
+
+main :: IO ()
+main = do
+    mp <- liftM (Map.fromList . map parse . lines) (readFile "21.in")
+    let orig = [[False, True, False], [False, False, True], [True, True, True]]
+        iters = iterate (joinblocks . unpblocks . map (map (getimg mp)) . pblocks) orig
+    -- mapM_ (print . sum . map fromEnum . concat . (iters !!)) [0..]
+    print (sum $ map fromEnum $ concat $ iters !! 5)
+    print (sum $ map fromEnum $ concat $ iters !! 18)
diff --git a/2017/21.in b/2017/21.in
new file mode 100644
index 0000000..5ae0471
--- /dev/null
+++ b/2017/21.in
@@ -0,0 +1,108 @@
+../.. => .../.#./.#.
+#./.. => .../#../#..
+##/.. => #.#/.#./.#.
+.#/#. => ##./##./...
+##/#. => .##/###/#..
+##/## => .##/#../##.
+.../.../... => .#.#/###./##.#/###.
+#../.../... => #.#./..#./..../#.#.
+.#./.../... => #.##/..#./.#.#/####
+##./.../... => ###./.#../####/##..
+#.#/.../... => ...#/####/#.##/...#
+###/.../... => .#../..#./#..#/..#.
+.#./#../... => ###./.##./#.../..#.
+##./#../... => #.#./...#/..../.###
+..#/#../... => ..../..../##../#..#
+#.#/#../... => ..#./#..#/.#../..##
+.##/#../... => ##../.#.#/.##./...#
+###/#../... => ..../#.../#..#/#..#
+.../.#./... => ##.#/#.#./#.../#..#
+#../.#./... => ..#./#.#./.##./....
+.#./.#./... => ..##/#.../..../###.
+##./.#./... => .#../...#/.##./.#.#
+#.#/.#./... => ...#/#..#/.#../.###
+###/.#./... => ###./.###/##.#/#.##
+.#./##./... => ##.#/##../..##/..##
+##./##./... => #.##/.###/.##./###.
+..#/##./... => ##.#/.##./..##/####
+#.#/##./... => ####/####/#.##/.#..
+.##/##./... => ####/.#../####/#..#
+###/##./... => #.#./..#./###./..#.
+.../#.#/... => #.../..../.#../#.##
+#../#.#/... => ..#./###./####/..#.
+.#./#.#/... => #.##/.#../##.#/#.#.
+##./#.#/... => ###./.###/###./##..
+#.#/#.#/... => ...#/.##./.#.#/#.##
+###/#.#/... => ####/#.../###./###.
+.../###/... => ..##/#.##/.#../.#..
+#../###/... => ..../.###/.#.#/...#
+.#./###/... => #.##/.#.#/.#.#/.##.
+##./###/... => #..#/.#.#/#.##/#.#.
+#.#/###/... => #.../##../#.##/##.#
+###/###/... => .#../.#../.###/..#.
+..#/.../#.. => ...#/.##./.##./####
+#.#/.../#.. => ##.#/##../#.#./.#..
+.##/.../#.. => #..#/.##./####/.#..
+###/.../#.. => ..../..../..##/..##
+.##/#../#.. => ..##/.##./#..#/###.
+###/#../#.. => ##.#/#..#/#.../#..#
+..#/.#./#.. => #..#/##.#/.##./#..#
+#.#/.#./#.. => .#../####/..##/#.##
+.##/.#./#.. => ###./#..#/.##./###.
+###/.#./#.. => ####/###./##../..##
+.##/##./#.. => #.../####/...#/####
+###/##./#.. => .#../#.##/.##./####
+#../..#/#.. => .#../####/#.../....
+.#./..#/#.. => .#.#/...#/.###/.#.#
+##./..#/#.. => ..##/#..#/#..#/....
+#.#/..#/#.. => .###/.#.#/.##./#.#.
+.##/..#/#.. => ...#/#.##/#.../..##
+###/..#/#.. => #.##/#.##/...#/#.##
+#../#.#/#.. => #..#/..##/.#../.###
+.#./#.#/#.. => #.##/..../.##./.#..
+##./#.#/#.. => #.#./..#./.#.#/.#..
+..#/#.#/#.. => ...#/#..#/###./##..
+#.#/#.#/#.. => ##.#/##.#/.#.#/.#..
+.##/#.#/#.. => #..#/#..#/##../.#..
+###/#.#/#.. => #.##/..##/##.#/....
+#../.##/#.. => ##.#/.##./...#/.#.#
+.#./.##/#.. => .##./.###/###./.#.#
+##./.##/#.. => #.#./#.##/..##/.#..
+#.#/.##/#.. => ..#./.##./..##/.#..
+.##/.##/#.. => ##../..##/#..#/#...
+###/.##/#.. => ###./#..#/##.#/..#.
+#../###/#.. => .###/#.../####/#.#.
+.#./###/#.. => #.#./.###/#..#/....
+##./###/#.. => ..#./.#.#/#.../#...
+..#/###/#.. => ...#/..#./##../#..#
+#.#/###/#.. => .#.#/###./.#../##..
+.##/###/#.. => .#../###./..#./##..
+###/###/#.. => .#../..##/#.../#...
+.#./#.#/.#. => ##.#/..../##../.#..
+##./#.#/.#. => #.../#.##/.###/#.##
+#.#/#.#/.#. => ...#/..##/##.#/#.##
+###/#.#/.#. => ...#/.#.#/###./#..#
+.#./###/.#. => ...#/...#/##../#.##
+##./###/.#. => ###./###./.#.#/..##
+#.#/###/.#. => ..../#..#/..##/#..#
+###/###/.#. => .#.#/.#.#/##../.###
+#.#/..#/##. => .##./..#./##../....
+###/..#/##. => ####/...#/.#.#/#...
+.##/#.#/##. => ..#./...#/###./.#..
+###/#.#/##. => ..../.#../.#../#.#.
+#.#/.##/##. => .##./..../#.../.#.#
+###/.##/##. => ..../#..#/...#/#...
+.##/###/##. => #.##/##.#/#.../..#.
+###/###/##. => .#../.###/###./##.#
+#.#/.../#.# => .#.#/..../#..#/.#..
+###/.../#.# => ##../#.##/##.#/..#.
+###/#../#.# => .#.#/..../.#.#/.###
+#.#/.#./#.# => ...#/..../##.#/#...
+###/.#./#.# => ####/.###/#.#./#.##
+###/##./#.# => #..#/.###/...#/###.
+#.#/#.#/#.# => #.##/...#/.###/.##.
+###/#.#/#.# => #.../.#.#/.#.#/.###
+#.#/###/#.# => ##.#/##../###./#...
+###/###/#.# => .##./.###/.#../..##
+###/#.#/### => #.##/###./#..#/#..#
+###/###/### => #.../..../#..#/#...