From ba9f86ef7ce4cdf131f4fd8e36adaea15d0edf4c Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 21 Dec 2017 23:10:52 +0100
Subject: Day 21

Please compile this, and even then running takes about a minute
on my PC. This is a SLOW implementation, but it works.
---
 2017/21.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 68 insertions(+)
 create mode 100644 2017/21.hs

(limited to '2017/21.hs')

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)
-- 
cgit v1.2.3-54-g00ecf