1 files changed, 68 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)