{-# Language ImportQualifiedPost, ViewPatterns, QuasiQuotes #-}
{-|
Module      : Main
Description : Day 21 solution
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

<http://adventofcode.com/2017/day/21>

Day 21 defines a system of rewrite rules on a grid of points that are
applied to 2x2 or 3x3 subtiles of the whole grid.

>>> :set -XQuasiQuotes
>>> let inputFile = "../.# => ##./#../...\n.#./..#/### => #..#/..../..../#..#\n"
>>> let rules = makeRules ([format|- ((.|#)+!&/ => (.|#)+!&/%n)*|] inputFile)
>>> let iterations = iterate (mapSubSquares rules) start

>>> printGrid (iterations !! 0)
.#.
..#
###

>>> printGrid (iterations !! 1)
#..#
....
....
#..#

>>> printGrid (iterations !! 2)
##.##.
#..#..
......
##.##.
#..#..
......

-}
module Main where

import Advent (chunks, count, format)
import Data.List (transpose)
import Data.Map qualified as Map

-- $setup
-- >>> let printGrid = mapM_ putStrLn

-- | Print the number of active grid cells after 5 and 18 iterations.
-- The input file can be overridden via command-line arguments.
main :: IO ()
IO ()
main =
  do [(Grid, Grid)]
input <- [format|2017 21 ((.|#)+!&/ => (.|#)+!&/%n)*|]

     let rules :: Grid -> Grid
rules      = [(Grid, Grid)] -> Grid -> Grid
makeRules [(Grid, Grid)]
input
         iterations :: [Grid]
iterations = (Grid -> Grid) -> Grid -> [Grid]
forall a. (a -> a) -> a -> [a]
iterate ((Grid -> Grid) -> Grid -> Grid
mapSubSquares Grid -> Grid
rules) Grid
start

     Int -> IO ()
forall a. Show a => a -> IO ()
print (Grid -> Int
countCells ([Grid]
iterations [Grid] -> Int -> Grid
forall a. HasCallStack => [a] -> Int -> a
!!  Int
5))
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Grid -> Int
countCells ([Grid]
iterations [Grid] -> Int -> Grid
forall a. HasCallStack => [a] -> Int -> a
!! Int
18))


type Grid = [[Char]]


-- | Initial grid value (a game of life glider).
--
-- >>> printGrid start
-- .#.
-- ..#
-- ###
start :: Grid
start :: Grid
start = [[Char]
".#.", [Char]
"..#", [Char]
"###"]


-- | Count the number of cells set in a grid.
--
-- >>> countCells start
-- 5
countCells :: Grid -> Int
countCells :: Grid -> Int
countCells = Char -> [Char] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count Char
'#' ([Char] -> Int) -> (Grid -> [Char]) -> Grid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat


-- | Generate all of the rotated and flipped versions of a grid.
--
-- >>> printGrid (Data.List.intercalate "  " <$> transpose (similarSquares start))
-- .#.  .##  ###  #..  ###  ##.  .#.  ..#
-- ..#  #.#  #..  #.#  ..#  #.#  #..  #.#
-- ###  ..#  .#.  ##.  .#.  #..  ###  .##
similarSquares :: Grid -> [Grid]
similarSquares :: Grid -> [Grid]
similarSquares Grid
x = (Grid -> [Grid]) -> [Grid] -> [Grid]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Grid] -> [Grid]
forall a. Int -> [a] -> [a]
take Int
4 ([Grid] -> [Grid]) -> (Grid -> [Grid]) -> Grid -> [Grid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Grid -> Grid) -> Grid -> [Grid]
forall a. (a -> a) -> a -> [a]
iterate Grid -> Grid
rotateCCW) [Grid
x, Grid -> Grid
forall a. [a] -> [a]
reverse Grid
x]


-- | Rotate a grid counter-clockwise.
--
-- >>> printGrid (rotateCCW start)
-- .##
-- #.#
-- ..#
rotateCCW :: Grid -> Grid
rotateCCW :: Grid -> Grid
rotateCCW = Grid -> Grid
forall a. [a] -> [a]
reverse (Grid -> Grid) -> (Grid -> Grid) -> Grid -> Grid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grid -> Grid
forall a. [[a]] -> [[a]]
transpose


-- | Apply a function to all of the subsquares of a grid.
mapSubSquares :: (Grid -> Grid) -> Grid -> Grid
mapSubSquares :: (Grid -> Grid) -> Grid -> Grid
mapSubSquares Grid -> Grid
rules Grid
xs =
  (Grid -> Grid) -> [Grid] -> Grid
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    ((Grid -> [Char]) -> [Grid] -> Grid
forall a b. (a -> b) -> [a] -> [b]
map Grid -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Grid] -> Grid) -> (Grid -> [Grid]) -> Grid -> Grid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Grid] -> [Grid]
forall a. [[a]] -> [[a]]
transpose ([Grid] -> [Grid]) -> (Grid -> [Grid]) -> Grid -> [Grid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Grid -> Grid) -> [Grid] -> [Grid]
forall a b. (a -> b) -> [a] -> [b]
map Grid -> Grid
rules ([Grid] -> [Grid]) -> (Grid -> [Grid]) -> Grid -> [Grid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Grid] -> [Grid]
forall a. [[a]] -> [[a]]
transpose ([Grid] -> [Grid]) -> (Grid -> [Grid]) -> Grid -> [Grid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Grid) -> Grid -> [Grid]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char] -> Grid
forall a. Int -> [a] -> [[a]]
chunks Int
n))
    (Int -> Grid -> [Grid]
forall a. Int -> [a] -> [[a]]
chunks Int
n Grid
xs)
  where
    n :: Int
n | Int -> Bool
forall a. Integral a => a -> Bool
even (Grid -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Grid
xs) = Int
2
      | Bool
otherwise        = Int
3


-- | Build the grid update function given the list of rules
-- loaded from the input file.
makeRules :: [(Grid,Grid)] -> Grid -> Grid
makeRules :: [(Grid, Grid)] -> Grid -> Grid
makeRules [(Grid, Grid)]
rs =
  let rulesMap :: Map Grid Grid
rulesMap = [(Grid, Grid)] -> Map Grid Grid
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Grid
k',Grid
v) | (Grid
k,Grid
v) <- [(Grid, Grid)]
rs , Grid
k' <- Grid -> [Grid]
similarSquares Grid
k ]
  in (Map Grid Grid
rulesMap Map Grid Grid -> Grid -> Grid
forall k a. Ord k => Map k a -> k -> a
Map.!)