{-# Language QuasiQuotes, MonadComprehensions, DataKinds, GADTs #-}
{-|
Module      : Main
Description : Day 22 solution
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

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

>>> :{
:main +
"1,0,1~1,2,1
0,0,2~2,0,2
0,2,3~2,2,3
0,0,4~0,2,4
2,0,5~2,2,5
0,1,6~2,1,6
1,1,8~1,1,9
"
:}
5
7

-}
module Main (main) where

import Advent (format, count)
import Advent.Box (intersectBox, Box(Pt, Dim), Box')
import Control.Parallel.Strategies (parList, rseq, runEval)
import Data.List (sort, tails, inits)
import Data.Maybe (isNothing)

-- | Parse the input boxes and print answers to both parts.
--
-- >>> :main
-- 441
-- 80778
main :: IO ()
IO ()
main =
 do input <- [format|2023 22 (%d,%d,%d~%d,%d,%d%n)*|]
    let sunk = [Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))]
forall a. Ord a => [a] -> [a]
sort ([Box' 3] -> [Box' 3]
lowerAll (((Int, Int, Int, Int, Int, Int) -> Box ('S ('S ('S 'Z))))
-> [(Int, Int, Int, Int, Int, Int)] -> [Box ('S ('S ('S 'Z)))]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int, Int, Int, Int) -> Box' 3
(Int, Int, Int, Int, Int, Int) -> Box ('S ('S ('S 'Z)))
toBrick [(Int, Int, Int, Int, Int, Int)]
input))
        falls = Eval [Int] -> [Int]
forall a. Eval a -> a
runEval (Strategy Int -> Strategy [Int]
forall a. Strategy a -> Strategy [a]
parList Strategy Int
forall a. Strategy a
rseq [[Box' 3] -> [Box' 3] -> Int
countFalls [Box' 3]
[Box ('S ('S ('S 'Z)))]
xs [Box' 3]
[Box ('S ('S ('S 'Z)))]
ys | ([Box ('S ('S ('S 'Z)))]
xs, Box ('S ('S ('S 'Z)))
_:[Box ('S ('S ('S 'Z)))]
ys) <- [[Box ('S ('S ('S 'Z)))]]
-> [[Box ('S ('S ('S 'Z)))]]
-> [([Box ('S ('S ('S 'Z)))], [Box ('S ('S ('S 'Z)))])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Box ('S ('S ('S 'Z)))] -> [[Box ('S ('S ('S 'Z)))]]
forall a. [a] -> [[a]]
inits [Box ('S ('S ('S 'Z)))]
sunk) ([Box ('S ('S ('S 'Z)))] -> [[Box ('S ('S ('S 'Z)))]]
forall a. [a] -> [[a]]
tails [Box ('S ('S ('S 'Z)))]
sunk)])
    print (count 0 falls)
    print (sum falls)

lowerAll :: [Box' 3] -> [Box' 3]
lowerAll :: [Box' 3] -> [Box' 3]
lowerAll = ([Box ('S ('S ('S 'Z)))]
 -> Box ('S ('S ('S 'Z))) -> [Box ('S ('S ('S 'Z)))])
-> [Box ('S ('S ('S 'Z)))]
-> [Box ('S ('S ('S 'Z)))]
-> [Box ('S ('S ('S 'Z)))]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Box ('S ('S ('S 'Z)))]
-> Box ('S ('S ('S 'Z))) -> [Box ('S ('S ('S 'Z)))]
lowerOne [] ([Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))])
-> ([Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))])
-> [Box ('S ('S ('S 'Z)))]
-> [Box ('S ('S ('S 'Z)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))]
forall a. Ord a => [a] -> [a]
sort
  where
    lowerOne :: [Box ('S ('S ('S 'Z)))]
-> Box ('S ('S ('S 'Z))) -> [Box ('S ('S ('S 'Z)))]
lowerOne [Box ('S ('S ('S 'Z)))]
xs Box ('S ('S ('S 'Z)))
x
      | Just Box' 3
x' <- Box' 3 -> Maybe (Box' 3)
lower Box' 3
Box ('S ('S ('S 'Z)))
x
      , (Box ('S ('S ('S 'Z))) -> Bool) -> [Box ('S ('S ('S 'Z)))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (Box ('S ('S ('S 'Z)))) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Box ('S ('S ('S 'Z)))) -> Bool)
-> (Box ('S ('S ('S 'Z))) -> Maybe (Box ('S ('S ('S 'Z)))))
-> Box ('S ('S ('S 'Z)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> 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' 3
Box ('S ('S ('S 'Z)))
x') [Box ('S ('S ('S 'Z)))]
xs
      = [Box ('S ('S ('S 'Z)))]
-> Box ('S ('S ('S 'Z))) -> [Box ('S ('S ('S 'Z)))]
lowerOne [Box ('S ('S ('S 'Z)))]
xs Box' 3
Box ('S ('S ('S 'Z)))
x'

      | Bool
otherwise = Box ('S ('S ('S 'Z)))
xBox ('S ('S ('S 'Z)))
-> [Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))]
forall a. a -> [a] -> [a]
:[Box ('S ('S ('S 'Z)))]
xs

countFalls :: [Box' 3] -> [Box' 3] -> Int
countFalls :: [Box' 3] -> [Box' 3] -> Int
countFalls [Box' 3]
bot = (Int, [Box ('S ('S ('S 'Z)))]) -> Int
forall a b. (a, b) -> a
fst ((Int, [Box ('S ('S ('S 'Z)))]) -> Int)
-> ([Box ('S ('S ('S 'Z)))] -> (Int, [Box ('S ('S ('S 'Z)))]))
-> [Box ('S ('S ('S 'Z)))]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Box ('S ('S ('S 'Z)))])
 -> Box ('S ('S ('S 'Z))) -> (Int, [Box ('S ('S ('S 'Z)))]))
-> (Int, [Box ('S ('S ('S 'Z)))])
-> [Box ('S ('S ('S 'Z)))]
-> (Int, [Box ('S ('S ('S 'Z)))])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int, [Box ('S ('S ('S 'Z)))])
-> Box ('S ('S ('S 'Z))) -> (Int, [Box ('S ('S ('S 'Z)))])
forall {a}.
Num a =>
(a, [Box ('S ('S ('S 'Z)))])
-> Box ('S ('S ('S 'Z))) -> (a, [Box ('S ('S ('S 'Z)))])
lowerOne (Int
0, [Box' 3]
[Box ('S ('S ('S 'Z)))]
bot)
  where
    lowerOne :: (a, [Box ('S ('S ('S 'Z)))])
-> Box ('S ('S ('S 'Z))) -> (a, [Box ('S ('S ('S 'Z)))])
lowerOne (a
n, [Box ('S ('S ('S 'Z)))]
xs) Box ('S ('S ('S 'Z)))
x
      | Just Box' 3
x' <- Box' 3 -> Maybe (Box' 3)
lower Box' 3
Box ('S ('S ('S 'Z)))
x
      , (Box ('S ('S ('S 'Z))) -> Bool) -> [Box ('S ('S ('S 'Z)))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (Box ('S ('S ('S 'Z)))) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Box ('S ('S ('S 'Z)))) -> Bool)
-> (Box ('S ('S ('S 'Z))) -> Maybe (Box ('S ('S ('S 'Z)))))
-> Box ('S ('S ('S 'Z)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> 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' 3
Box ('S ('S ('S 'Z)))
x') [Box ('S ('S ('S 'Z)))]
xs
      = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, [Box ('S ('S ('S 'Z)))]
xs)

      | Bool
otherwise = (a
n, Box ('S ('S ('S 'Z)))
xBox ('S ('S ('S 'Z)))
-> [Box ('S ('S ('S 'Z)))] -> [Box ('S ('S ('S 'Z)))]
forall a. a -> [a] -> [a]
:[Box ('S ('S ('S 'Z)))]
xs)

lower :: Box' 3 -> Maybe (Box' 3)
lower :: Box' 3 -> Maybe (Box' 3)
lower (Dim Int
z1 Int
z2 Box n
box) = [Int -> Int -> Box n -> Box ('S n)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
Dim (Int
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
z2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Box n
box | Int
z1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1]

toBrick :: (Int, Int, Int, Int, Int, Int) -> Box' 3
toBrick :: (Int, Int, Int, Int, Int, Int) -> Box' 3
toBrick (Int
x1,Int
y1,Int
z1,Int
x2,Int
y2,Int
z2) = Int -> Int -> Box ('S ('S 'Z)) -> Box ('S ('S ('S 'Z)))
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
z1 Int
z2 (Int -> Int -> Box ('S 'Z) -> Box ('S ('S 'Z))
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
x1 Int
x2 (Int -> Int -> Box 'Z -> Box ('S 'Z)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
dim Int
y1 Int
y2 Box 'Z
Pt))
  where
    dim :: Int -> Int -> Box n -> Box ('S n)
dim Int
a Int
b = Int -> Int -> Box n -> Box ('S n)
forall (n :: Nat). Int -> Int -> Box n -> Box ('S n)
Dim (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a Int
b) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)