{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeApplications, TypeFamilies, ViewPatterns #-}
module Day22 (day22a, day22b) where
import Control.Monad (guard)
import Data.Ix (Ix, inRange, rangeSize)
import Data.Maybe (mapMaybe)
import Data.String (IsString)
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (MonadParsec, ParseErrorBundle, Token, Tokens, (<|>), chunk, eof, parse, sepEndBy)
import Text.Megaparsec.Char (newline)
import Text.Megaparsec.Char.Lexer (decimal, signed)
parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m (Bool, ((a, a), (a, a), (a, a)))
parser :: m (Bool, ((a, a), (a, a), (a, a)))
parser = do
Bool
b <- (Bool
True Bool -> m (Tokens s) -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"on") m Bool -> m Bool -> m Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
False Bool -> m (Tokens s) -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"off")
a
x0 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
" x=" m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
a
x1 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
".." m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
a
y0 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
",y=" m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
a
y1 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
".." m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
a
z0 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
",z=" m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
a
z1 <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
".." m (Tokens s) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
(Bool, ((a, a), (a, a), (a, a)))
-> m (Bool, ((a, a), (a, a), (a, a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
b, ((a
x0, a
x1), (a
y0, a
y1), (a
z0, a
z1)))
day22 :: (Ix a, Num a) => Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
day22 :: Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
day22 Bool
on (((Bool, ((a, a), (a, a), (a, a))) -> Bool)
-> [(Bool, ((a, a), (a, a), (a, a)))]
-> [(Bool, ((a, a), (a, a), (a, a)))]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
on) (Bool -> Bool)
-> ((Bool, ((a, a), (a, a), (a, a))) -> Bool)
-> (Bool, ((a, a), (a, a), (a, a)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, ((a, a), (a, a), (a, a))) -> Bool
forall a b. (a, b) -> a
fst) -> (Bool
_, ((a
x0, a
x1), (a
y0, a
y1), (a
z0, a
z1))):[(Bool, ((a, a), (a, a), (a, a)))]
ins) =
((a, a, a), (a, a, a)) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize ((a
x0, a
y0, a
z0), (a
x1, a
y1, a
z1))
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' (Bool -> Bool
not Bool
on) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
x0 a
x1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
y0 a
y1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
z0 a
z1)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
below a
z0)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
above a
z1)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
below a
y0) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
z0 a
z1)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
above a
y1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
z0 a
z1)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
below a
x0) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
y0 a
y1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
z0 a
z1)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on (a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Num a, Alternative f) =>
a -> (a, a) -> f (a, a)
above a
x1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
y0 a
y1) (a -> a -> (a, a) -> Maybe (a, a)
forall (f :: * -> *) a.
(Ord a, Alternative f) =>
a -> a -> (a, a) -> f (a, a)
clip a
z0 a
z1)
where
day22' :: Bool
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> ((a, a) -> Maybe (a, a))
-> Int
day22' Bool
on' (a, a) -> Maybe (a, a)
f (a, a) -> Maybe (a, a)
g (a, a) -> Maybe (a, a)
h = Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
forall a.
(Ix a, Num a) =>
Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
day22 Bool
on' ([(Bool, ((a, a), (a, a), (a, a)))] -> Int)
-> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
forall a b. (a -> b) -> a -> b
$ (((Bool, ((a, a), (a, a), (a, a)))
-> Maybe (Bool, ((a, a), (a, a), (a, a))))
-> [(Bool, ((a, a), (a, a), (a, a)))]
-> [(Bool, ((a, a), (a, a), (a, a)))])
-> [(Bool, ((a, a), (a, a), (a, a)))]
-> ((Bool, ((a, a), (a, a), (a, a)))
-> Maybe (Bool, ((a, a), (a, a), (a, a))))
-> [(Bool, ((a, a), (a, a), (a, a)))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Bool, ((a, a), (a, a), (a, a)))
-> Maybe (Bool, ((a, a), (a, a), (a, a))))
-> [(Bool, ((a, a), (a, a), (a, a)))]
-> [(Bool, ((a, a), (a, a), (a, a)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(Bool, ((a, a), (a, a), (a, a)))]
ins (((Bool, ((a, a), (a, a), (a, a)))
-> Maybe (Bool, ((a, a), (a, a), (a, a))))
-> [(Bool, ((a, a), (a, a), (a, a)))])
-> ((Bool, ((a, a), (a, a), (a, a)))
-> Maybe (Bool, ((a, a), (a, a), (a, a))))
-> [(Bool, ((a, a), (a, a), (a, a)))]
forall a b. (a -> b) -> a -> b
$ \(Bool
b, ((a, a)
x, (a, a)
y, (a, a)
z)) ->
(,) Bool
b (((a, a), (a, a), (a, a)) -> (Bool, ((a, a), (a, a), (a, a))))
-> Maybe ((a, a), (a, a), (a, a))
-> Maybe (Bool, ((a, a), (a, a), (a, a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,) ((a, a) -> (a, a) -> (a, a) -> ((a, a), (a, a), (a, a)))
-> Maybe (a, a)
-> Maybe ((a, a) -> (a, a) -> ((a, a), (a, a), (a, a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a, a) -> Maybe (a, a)
f (a, a)
x Maybe ((a, a) -> (a, a) -> ((a, a), (a, a), (a, a)))
-> Maybe (a, a) -> Maybe ((a, a) -> ((a, a), (a, a), (a, a)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a, a) -> Maybe (a, a)
g (a, a)
y Maybe ((a, a) -> ((a, a), (a, a), (a, a)))
-> Maybe (a, a) -> Maybe ((a, a), (a, a), (a, a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a, a) -> Maybe (a, a)
h (a, a)
z)
above :: a -> (a, a) -> f (a, a)
above a
hi (a
u, a
v) = (a -> a -> a
forall a. Ord a => a -> a -> a
max (a
hi a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
u, a
v) (a, a) -> f () -> f (a, a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
hi)
below :: a -> (a, a) -> f (a, a)
below a
lo (a
u, a
v) = (a
u, a -> a -> a
forall a. Ord a => a -> a -> a
min (a
lo a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
v) (a, a) -> f () -> f (a, a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lo)
clip :: a -> a -> (a, a) -> f (a, a)
clip a
lo a
hi (a
u, a
v) = (a -> a -> a
forall a. Ord a => a -> a -> a
max a
lo a
u, a -> a -> a
forall a. Ord a => a -> a -> a
min a
hi a
v) (a, a) -> f () -> f (a, a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi Bool -> Bool -> Bool
&& a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo)
day22 Bool
_ [(Bool, ((a, a), (a, a), (a, a)))]
_ = Int
0
day22a :: Text -> Either (ParseErrorBundle Text Void) Int
day22a :: Text -> Either (ParseErrorBundle Text Void) Int
day22a Text
input = Bool -> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))] -> Int
forall a.
(Ix a, Num a) =>
Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
day22 @Int Bool
True ([(Bool, ((Int, Int), (Int, Int), (Int, Int)))] -> Int)
-> ([(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))])
-> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, ((Int, Int), (Int, Int), (Int, Int))) -> Bool)
-> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, ((Int, Int), (Int, Int), (Int, Int))) -> Bool
forall a b c a b c a.
(Ix a, Ix b, Ix c, Ix a, Ix b, Ix c, Num a, Num b, Num c, Num a,
Num b, Num c) =>
(a, ((a, a), (b, b), (c, c))) -> Bool
f ([(Bool, ((Int, Int), (Int, Int), (Int, Int)))] -> Int)
-> Either
(ParseErrorBundle Text Void)
[(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> String
-> Text
-> Either
(ParseErrorBundle Text Void)
[(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT
Void Text Identity (Bool, ((Int, Int), (Int, Int), (Int, Int)))
forall e s (m :: * -> *) a.
(MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) =>
m (Bool, ((a, a), (a, a), (a, a)))
parser ParsecT
Void Text Identity (Bool, ((Int, Int), (Int, Int), (Int, Int)))
-> ParsecT Void Text Identity Char
-> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" Text
input where
f :: (a, ((a, a), (b, b), (c, c))) -> Bool
f (a
_, ((a
x0, a
x1), (b
y0, b
y1), (c
z0, c
z1))) =
((a, b, c), (a, b, c)) -> (a, b, c) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange ((-a
50, -b
50, -c
50), (a
50, b
50, c
50)) (a
x0, b
y0, c
z0) Bool -> Bool -> Bool
&&
((a, b, c), (a, b, c)) -> (a, b, c) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange ((-a
50, -b
50, -c
50), (a
50, b
50, c
50)) (a
x1, b
y1, c
z1)
day22b :: Text -> Either (ParseErrorBundle Text Void) Int
day22b :: Text -> Either (ParseErrorBundle Text Void) Int
day22b Text
input = Bool -> [(Bool, ((Int, Int), (Int, Int), (Int, Int)))] -> Int
forall a.
(Ix a, Num a) =>
Bool -> [(Bool, ((a, a), (a, a), (a, a)))] -> Int
day22 @Int Bool
True ([(Bool, ((Int, Int), (Int, Int), (Int, Int)))] -> Int)
-> Either
(ParseErrorBundle Text Void)
[(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> String
-> Text
-> Either
(ParseErrorBundle Text Void)
[(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT
Void Text Identity (Bool, ((Int, Int), (Int, Int), (Int, Int)))
forall e s (m :: * -> *) a.
(MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) =>
m (Bool, ((a, a), (a, a), (a, a)))
parser ParsecT
Void Text Identity (Bool, ((Int, Int), (Int, Int), (Int, Int)))
-> ParsecT Void Text Identity Char
-> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [(Bool, ((Int, Int), (Int, Int), (Int, Int)))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" Text
input