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

<https://adventofcode.com/2018/day/18>
-}
module Main (main) where

import Advent (getInputArray, count)
import Advent.Coord (Coord(C), neighbors)
import Data.Map qualified as Map
import Data.Map (Map)
import Data.Array.Unboxed qualified as A

-- | Represent the lumber area as an array of characters: @.|#@
type Area = A.UArray Coord Char

-- | Print the answers to day 18
--
-- >>> :main
-- 506160
-- 189168
main :: IO ()
IO ()
main =
  do Area
input <- Int -> Int -> IO Area
getInputArray Int
2018 Int
18
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Area -> Int
part1 Area
input)
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Area -> Int
part2 Area
input)

-- | Compute the resource value after 10 minutes
part1 :: Area -> Int
part1 :: Area -> Int
part1 Area
input = Area -> Int
resourceValue (Int -> Area -> Area
timesteps Int
10 Area
input)

-- | Compute the resource value after 1,000,000,000 minutes.
-- This implementation relies on the lumber area entering a cycle.
-- Once the cycle is detected with can figure out how to advance
-- forward to near the end of the target duration.
part2 :: Area -> Int
part2 :: Area -> Int
part2 Area
input = Area -> Int
resourceValue (Int -> Area -> Area
timesteps Int
cleanup Area
x)
  where
    (Int
starti, Int
repeati, Area
x) = Map Area Int -> Area -> (Int, Int, Area)
findCycle Map Area Int
forall k a. Map k a
Map.empty Area
input

    target :: Int
target    = Int
1000000000
    period :: Int
period    = Int
repeati Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
starti
    remaining :: Int
remaining = Int
target Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
repeati
    cleanup :: Int
cleanup   = Int
remaining Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
period

-- | Given a map of past areas and the current area, find the two
-- minutes that have the same state and return the state of the
-- area at those minutes.
findCycle :: Map Area Int -> Area -> (Int, Int, Area)
findCycle :: Map Area Int -> Area -> (Int, Int, Area)
findCycle Map Area Int
seen Area
x =
  case Area -> Map Area Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Area
x Map Area Int
seen of
    Just Int
prev -> (Int
prev, Map Area Int -> Int
forall k a. Map k a -> Int
Map.size Map Area Int
seen, Area
x)
    Maybe Int
Nothing   -> Map Area Int -> Area -> (Int, Int, Area)
findCycle (Area -> Int -> Map Area Int -> Map Area Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Area
x (Map Area Int -> Int
forall k a. Map k a -> Int
Map.size Map Area Int
seen) Map Area Int
seen) (Area -> Area
timestep Area
x)

-- | Multiply the number of trees in the area by the number of lumberyards.
resourceValue :: Area -> Int
resourceValue :: Area -> Int
resourceValue Area
v = Char -> [Char] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count Char
'|' [Char]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> [Char] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count Char
'#' [Char]
xs
  where
    xs :: [Char]
xs = Area -> [Char]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Area
v

-- | Linearly apply the 'timestep' function a given number of times
timesteps :: Int -> Area -> Area
timesteps :: Int -> Area -> Area
timesteps Int
0 Area
v = Area
v
timesteps Int
n Area
v = Int -> Area -> Area
timesteps (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Area -> Area) -> Area -> Area
forall a b. (a -> b) -> a -> b
$! Area -> Area
timestep Area
v

-- | Update the lumber area for one minute passing
timestep :: Area -> Area
timestep :: Area -> Area
timestep Area
v = (Coord -> Char -> Char) -> Area -> Area
forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
(i -> e -> e) -> a i e -> a i e
imap Coord -> Char -> Char
cell Area
v
  where
    test :: Char -> Coord -> Bool
test Char
c Coord
i  = Area -> Coord -> Bool
forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
a i e -> i -> Bool
inArray Area
v Coord
i Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Area
v Area -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Coord
i

    cell :: Coord -> Char -> Char
cell Coord
i Char
'.' | Int -> (Coord -> Bool) -> [Coord] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atLeast Int
3 (Char -> Coord -> Bool
test Char
'|') (Coord -> [Coord]
neighbors Coord
i) = Char
'|'
    cell Coord
i Char
'|' | Int -> (Coord -> Bool) -> [Coord] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atLeast Int
3 (Char -> Coord -> Bool
test Char
'#') (Coord -> [Coord]
neighbors Coord
i) = Char
'#'
    cell Coord
i Char
'#' | Bool -> Bool
not ((Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Coord -> Bool
test Char
'#') (Coord -> [Coord]
neighbors Coord
i))
              Bool -> Bool -> Bool
|| Bool -> Bool
not ((Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Coord -> Bool
test Char
'|') (Coord -> [Coord]
neighbors Coord
i)) = Char
'.'
    cell Coord
_ Char
c = Char
c

-- | Determine if at least a given number of elements satisfy a predicate
atLeast :: Int -> (a -> Bool) -> [a] -> Bool
atLeast :: forall a. Int -> (a -> Bool) -> [a] -> Bool
atLeast Int
0 a -> Bool
_ [a]
_      = Bool
True
atLeast Int
_ a -> Bool
_ []     = Bool
False
atLeast Int
n a -> Bool
p (a
x:[a]
xs) = Int -> (a -> Bool) -> [a] -> Bool
forall a. Int -> (a -> Bool) -> [a] -> Bool
atLeast (if a -> Bool
p a
x then Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
n) a -> Bool
p [a]
xs

-- | Test if an index is contained within an array.
inArray :: (A.Ix i, A.IArray a e) => a i e -> i -> Bool
inArray :: forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
a i e -> i -> Bool
inArray = (i, i) -> i -> Bool
forall a. Ix a => (a, a) -> a -> Bool
A.inRange ((i, i) -> i -> Bool) -> (a i e -> (i, i)) -> a i e -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a i e -> (i, i)
forall i. Ix i => a i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds

-- | Map a function over the indexes and elements of an array.
imap :: (A.Ix i, A.IArray a e) => (i -> e -> e) -> a i e -> a i e
imap :: forall i (a :: * -> * -> *) e.
(Ix i, IArray a e) =>
(i -> e -> e) -> a i e -> a i e
imap i -> e -> e
f a i e
a = (i, i) -> [e] -> a i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (a i e -> (i, i)
forall i. Ix i => a i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds a i e
a) [ i -> e -> e
f i
i e
e | (i
i, e
e) <- a i e -> [(i, e)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs a i e
a ]