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

<https://adventofcode.com/2021/day/22>

This solution processes commands in order and tracks the
currently lit regions with a list of disjoint cubes. When
processing a new cube, the cube is deleted from the list of
lit cubes and then added back in as a whole cube if the command
would turn lights on.

A slower, but also popular solution using the Inclusion-Exclusion Principle
can be found in 'solveInEx'.

<https://en.wikipedia.org/wiki/Inclusion%E2%80%93exclusion_principle>

-}
module Main (main) where

import Advent.Box
import Advent (format, stageTH)
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Foldable (foldl')
-- | On and off commands from the input file
data C = Con {- ^ lights on -} | Coff {- ^ lights off -}
  deriving (Int -> C -> ShowS
[C] -> ShowS
C -> String
(Int -> C -> ShowS) -> (C -> String) -> ([C] -> ShowS) -> Show C
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> C -> ShowS
showsPrec :: Int -> C -> ShowS
$cshow :: C -> String
show :: C -> String
$cshowList :: [C] -> ShowS
showList :: [C] -> ShowS
Show, C -> C -> Bool
(C -> C -> Bool) -> (C -> C -> Bool) -> Eq C
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: C -> C -> Bool
== :: C -> C -> Bool
$c/= :: C -> C -> Bool
/= :: C -> C -> Bool
Eq)

stageTH

-- | >>> :main
-- 606484
-- 1162571910364852
main :: IO ()
IO ()
main =
 do [(C, Int, Int, Int, Int, Int, Int)]
inp <- [format|2021 22 (@C x=%d..%d,y=%d..%d,z=%d..%d%n)*|]
    let dim :: Int -> Int -> Box n -> Box ('S n)
dim Int
lo Int
hi = Int -> Int -> Box n -> Box ('S n)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
Dim Int
lo (Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) -- make upper bound exclusive
        steps :: [(C, Box ('S ('S ('S 'Z))))]
steps = [ (C
c, Int -> Int -> Box ('S ('S 'Z)) -> Box ('S ('S ('S 'Z)))
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
x1 Int
x2 (Int -> Int -> Box ('S 'Z) -> Box ('S ('S 'Z))
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
y1 Int
y2 (Int -> Int -> Box 'Z -> Box ('S 'Z)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
z1 Int
z2 Box 'Z
Pt)))
                | (C
c, Int
x1, Int
x2, Int
y1, Int
y2, Int
z1, Int
z2) <- [(C, Int, Int, Int, Int, Int, Int)]
inp]
        p1dim :: Box n -> Box ('S n)
p1dim = Int -> Int -> Box n -> Box ('S n)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim (-Int
50) Int
50
        p1box :: Box ('S ('S ('S 'Z)))
p1box = Box ('S ('S 'Z)) -> Box ('S ('S ('S 'Z)))
forall {n :: Nat}. Box n -> Box ('S n)
p1dim (Box ('S 'Z) -> Box ('S ('S 'Z))
forall {n :: Nat}. Box n -> Box ('S n)
p1dim (Box 'Z -> Box ('S 'Z)
forall {n :: Nat}. Box n -> Box ('S n)
p1dim Box 'Z
Pt))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([(C, Box ('S ('S ('S 'Z))))] -> Int
forall (n :: Nat). [(C, Box n)] -> Int
solve [(C
c, Box ('S ('S ('S 'Z)))
b) | (C
c, Box ('S ('S ('S 'Z)))
-> Box ('S ('S ('S 'Z))) -> Maybe (Box ('S ('S ('S 'Z))))
forall (n :: Nat). Box n -> Box n -> Maybe (Box n)
intersectBox Box ('S ('S ('S 'Z)))
p1box -> Just Box ('S ('S ('S 'Z)))
b) <- [(C, Box ('S ('S ('S 'Z))))]
steps])
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([(C, Box ('S ('S ('S 'Z))))] -> Int
forall (n :: Nat). [(C, Box n)] -> Int
solve [(C, Box ('S ('S ('S 'Z))))]
steps)

-- | Figure out how many lights the given instructions turn on.
solve :: [(C, Box n)] -> Int
solve :: forall (n :: Nat). [(C, Box n)] -> Int
solve = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([(C, Box n)] -> [Int]) -> [(C, Box n)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Box n -> Int) -> [Box n] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Box n -> Int
forall (n :: Nat). Box n -> Int
size ([Box n] -> [Int])
-> ([(C, Box n)] -> [Box n]) -> [(C, Box n)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Box n] -> (C, Box n) -> [Box n])
-> [Box n] -> [(C, Box n)] -> [Box n]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Box n] -> (C, Box n) -> [Box n]
forall (n :: Nat). [Box n] -> (C, Box n) -> [Box n]
applyCommand []

-- | Apply a command given a list of non-overlapping, illuminated regions.
applyCommand ::
  [Box n]    {- ^ pre-lit boxes  -} ->
  (C, Box n) {- ^ command        -} ->
  [Box n]    {- ^ post-lit boxes -}
applyCommand :: forall (n :: Nat). [Box n] -> (C, Box n) -> [Box n]
applyCommand [Box n]
ons (C
c, Box n
b) = [Box n
b | C
Con C -> C -> Bool
forall a. Eq a => a -> a -> Bool
== C
c] [Box n] -> [Box n] -> [Box n]
forall a. [a] -> [a] -> [a]
++ (Box n -> [Box n]) -> [Box n] -> [Box n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Box n -> Box n -> [Box n]
forall (n :: Nat). Box n -> Box n -> [Box n]
subtractBox Box n
b) [Box n]
ons

-- * Alternative solution

-- | This solution uses the inclusion-exclusion principle instead
-- of relying on 'subtractBox'
solveInEx :: [(C, Box n)] -> Int
solveInEx :: forall (n :: Nat). [(C, Box n)] -> Int
solveInEx [(C, Box n)]
cmds =
  [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Box n -> Int
forall (n :: Nat). Box n -> Int
size Box n
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
v | (Box n
k,Int
v) <- Map (Box n) Int -> [(Box n, Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs ((Map (Box n) Int -> (C, Box n) -> Map (Box n) Int)
-> Map (Box n) Int -> [(C, Box n)] -> Map (Box n) Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map (Box n) Int -> (C, Box n) -> Map (Box n) Int
forall (n :: Nat). Map (Box n) Int -> (C, Box n) -> Map (Box n) Int
addCommandInEx Map (Box n) Int
forall k a. Map k a
Map.empty [(C, Box n)]
cmds)]

-- | Update the inclusion and exclusion regions based on a single command.
-- This uses the same logic as 'solve' in that it turns off all the lights
-- in the given region first and then it turns them back on if the command
-- is /on/ and leaves them off if the command is /off/.
addCommandInEx ::
  Map (Box n) Int {- ^ inclusions and exclusions -} ->
  (C, Box n)      {- ^ command and region        -} ->
  Map (Box n) Int {- ^ inclusions and exclusions -}
addCommandInEx :: forall (n :: Nat). Map (Box n) Int -> (C, Box n) -> Map (Box n) Int
addCommandInEx Map (Box n) Int
boxes (C
cmd, Box n
box)
  = (Int -> Bool) -> Map (Box n) Int -> Map (Box n) Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=) -- optimization to avoid finding intersections that don't matter
  (Map (Box n) Int -> Map (Box n) Int)
-> Map (Box n) Int -> Map (Box n) Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Map (Box n) Int -> Map (Box n) Int -> Map (Box n) Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map (Box n) Int
boxes
  (Map (Box n) Int -> Map (Box n) Int)
-> Map (Box n) Int -> Map (Box n) Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [(Box n, Int)] -> Map (Box n) 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
(+)
  ([(Box n, Int)] -> Map (Box n) Int)
-> [(Box n, Int)] -> Map (Box n) Int
forall a b. (a -> b) -> a -> b
$ [(Box n
box,Int
1) | C
cmd C -> C -> Bool
forall a. Eq a => a -> a -> Bool
== C
Con] [(Box n, Int)] -> [(Box n, Int)] -> [(Box n, Int)]
forall a. [a] -> [a] -> [a]
++
    [(Box n
k, -Int
v) | (Box n -> Box n -> Maybe (Box n)
forall (n :: Nat). Box n -> Box n -> Maybe (Box n)
intersectBox Box n
box -> Just Box n
k,Int
v) <- Map (Box n) Int -> [(Box n, Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (Box n) Int
boxes]