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

<https://adventofcode.com/2019/day/24>

-}
module Main (main) where

import Advent (getInputLines)
import Advent.Coord (Coord(..), coordLines, cardinal)
import Advent.Coord3 (Coord3(..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Map.Strict qualified as Map

-- | >>> :main
-- 12531574
-- 2033
main :: IO ()
IO ()
main =
  do Set Coord
inp <- [String] -> Set Coord
bugCoords ([String] -> Set Coord) -> IO [String] -> IO (Set Coord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO [String]
getInputLines Int
2019 Int
24
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Set Coord -> Int
biodiversity ([Set Coord] -> Set Coord
forall a. Ord a => [a] -> a
findDup ((Set Coord -> Set Coord) -> Set Coord -> [Set Coord]
forall a. (a -> a) -> a -> [a]
iterate ((Coord -> [Coord]) -> Set Coord -> Set Coord
forall a. Ord a => (a -> [a]) -> Set a -> Set a
update ((Coord -> Bool) -> [Coord] -> [Coord]
forall a. (a -> Bool) -> [a] -> [a]
filter Coord -> Bool
inside ([Coord] -> [Coord]) -> (Coord -> [Coord]) -> Coord -> [Coord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> [Coord]
cardinal)) Set Coord
inp)))

     let inp3 :: Set Coord3
inp3 = (Coord -> Coord3) -> Set Coord -> Set Coord3
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Coord -> Coord3
to3 Set Coord
inp
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Set Coord3 -> Int
forall a. Set a -> Int
Set.size ((Set Coord3 -> Set Coord3) -> Set Coord3 -> [Set Coord3]
forall a. (a -> a) -> a -> [a]
iterate ((Coord3 -> [Coord3]) -> Set Coord3 -> Set Coord3
forall a. Ord a => (a -> [a]) -> Set a -> Set a
update Coord3 -> [Coord3]
cardinal3) Set Coord3
inp3 [Set Coord3] -> Int -> Set Coord3
forall a. HasCallStack => [a] -> Int -> a
!! Int
200))

-- | Compute the part 1 biodiversity score.
biodiversity :: Set Coord -> Int
biodiversity :: Set Coord -> Int
biodiversity Set Coord
m = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
12Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
5)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x) | C Int
y Int
x <- Set Coord -> [Coord]
forall a. Set a -> [a]
Set.toList Set Coord
m]

-- | Apply automata rule to set of bug coordinates.
update :: Ord a => (a -> [a]) -> Set a -> Set a
update :: forall a. Ord a => (a -> [a]) -> Set a -> Set a
update a -> [a]
adjacents Set a
m
  = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter a -> Bool
rule
  (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
m
  (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a Int -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a Int
density
  where
    rule :: a -> Bool
rule a
k = Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Bool -> Bool -> Bool
|| Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Bool -> Bool -> Bool
&& a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember a
k Set a
m
      where n :: Int
n = Int -> a -> Map a Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 a
k Map a Int
density

    density :: Map a Int
density = (Int -> Int -> Int) -> [(a, Int)] -> Map a Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
              [(a
d, Int
1::Int) | a
c <- Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
m, a
d <- a -> [a]
adjacents a
c]

-- | Compute the coordinates of the input bugs centered around 0,0
bugCoords :: [String] -> Set Coord
bugCoords :: [String] -> Set Coord
bugCoords [String]
xs = [Coord] -> Set Coord
forall a. Ord a => [a] -> Set a
Set.fromList [Coord
k Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
- Coord
2 | (Coord
k, Char
'#') <- [String] -> [(Coord, Char)]
coordLines [String]
xs]

-- | Find the first duplicate element in a list.
findDup :: Ord a => [a] -> a
findDup :: forall a. Ord a => [a] -> a
findDup = Set a -> [a] -> a
forall {a}. Ord a => Set a -> [a] -> a
go Set a
forall a. Set a
Set.empty
  where
    go :: Set a -> [a] -> a
go Set a
_    [] = String -> a
forall a. HasCallStack => String -> a
error String
"no duplicates"
    go Set a
seen (a
x:[a]
xs)
       | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
seen = a
x
       | Bool
otherwise         = Set a -> [a] -> a
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
seen) [a]
xs

-- | Check that a coordinate is contained within the 5x5 region centered
-- around the origin.
inside :: Coord -> Bool
inside :: Coord -> Bool
inside (C Int
y Int
x) = Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
&& Int -> Int
forall a. Num a => a -> a
abs Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2

------------------------------------------------------------------------
-- 3-dimensional recursive board coordinates
------------------------------------------------------------------------

to3 :: Coord -> Coord3
to3 :: Coord -> Coord3
to3 (C Int
y Int
x) = Int -> Int -> Int -> Coord3
C3 Int
0 Int
y Int
x

toL, toR, toA :: Coord3 -> Coord3
toL :: Coord3 -> Coord3
toL (C3 Int
d Int
y Int
x) = Int -> Int -> Int -> Coord3
C3 Int
d (-Int
x) Int
y
toR :: Coord3 -> Coord3
toR (C3 Int
d Int
y Int
x) = Int -> Int -> Int -> Coord3
C3 Int
d Int
x (-Int
y)
toA :: Coord3 -> Coord3
toA (C3 Int
d Int
y Int
x) = Int -> Int -> Int -> Coord3
C3 Int
d (-Int
y) (-Int
x)

cardinal3 :: Coord3 -> [Coord3]
cardinal3 :: Coord3 -> [Coord3]
cardinal3 Coord3
c =
  [[Coord3]] -> [Coord3]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [          Coord3 -> [Coord3]
above3       Coord3
c,
          (Coord3 -> Coord3) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> [a] -> [b]
map Coord3 -> Coord3
toR ([Coord3] -> [Coord3]) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> [Coord3]
above3 (Coord3 -> [Coord3]) -> Coord3 -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> Coord3
toL Coord3
c,
          (Coord3 -> Coord3) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> [a] -> [b]
map Coord3 -> Coord3
toL ([Coord3] -> [Coord3]) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> [Coord3]
above3 (Coord3 -> [Coord3]) -> Coord3 -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> Coord3
toR Coord3
c,
          (Coord3 -> Coord3) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> [a] -> [b]
map Coord3 -> Coord3
toA ([Coord3] -> [Coord3]) -> [Coord3] -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> [Coord3]
above3 (Coord3 -> [Coord3]) -> Coord3 -> [Coord3]
forall a b. (a -> b) -> a -> b
$ Coord3 -> Coord3
toA Coord3
c]

{-# INLINE above3 #-}
above3 :: Coord3 -> [Coord3]
above3 :: Coord3 -> [Coord3]
above3 (C3 Int
d Int
1    Int
0) = [Int -> Int -> Int -> Coord3
C3 (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (  Int
2) Int
x| Int
x <- [-Int
2..Int
2]]
above3 (C3 Int
d (-2) Int
_) = [Int -> Int -> Int -> Coord3
C3 (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ( -Int
1) Int
0]
above3 (C3 Int
d Int
y    Int
x) = [Int -> Int -> Int -> Coord3
C3 (Int
d  ) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
x]