{-|
Module:         Day5
Description:    <https://adventofcode.com/2021/day/5 Day 5: Hydrothermal Venture>
-}
{-# LANGUAGE FlexibleContexts, MultiWayIf, OverloadedStrings, TypeApplications, TypeFamilies #-}
module Day5 (day5a, day5b) where

import Control.Monad (guard)
import Data.Function (on)
import Data.List (tails)
import Data.Set (Set)
import qualified Data.Set as Set (fromList, size)
import Data.String (IsString)
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (MonadParsec, ParseErrorBundle, Token, Tokens, eof, parse, sepEndBy)
import Text.Megaparsec.Char (char, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)

parser :: (Num a, Ord a, MonadParsec e s m, Token s ~ Char, IsString (Tokens s)) => m [((a, a), (a, a))]
parser :: m [((a, a), (a, a))]
parser = m ((a, a), (a, a))
line m ((a, a), (a, a)) -> m Char -> m [((a, a), (a, a))]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline m [((a, a), (a, a))] -> m () -> m [((a, a), (a, a))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof where
    line :: m ((a, a), (a, a))
line = do
        (a, a)
d0 <- m (a, a)
pair m (a, a) -> m (Tokens s) -> m (a, a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
" -> "
        (a, a)
d1 <- m (a, a)
pair
        ((a, a), (a, a)) -> m ((a, a), (a, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((a, a), (a, a)) -> m ((a, a), (a, a)))
-> ((a, a), (a, a)) -> m ((a, a), (a, a))
forall a b. (a -> b) -> a -> b
$ if (a, a)
d0 (a, a) -> (a, a) -> Bool
forall a. Ord a => a -> a -> Bool
< (a, a)
d1 then ((a, a)
d0, (a, a)
d1) else ((a, a)
d1, (a, a)
d0)
    pair :: m (a, a)
pair = (,) (a -> a -> (a, a)) -> m a -> m (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal m (a -> (a, a)) -> m Char -> m (a -> (a, a))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
',' m (a -> (a, a)) -> m a -> m (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal

intersections :: (Enum a, Integral a, Ord a, Show a) => [((a, a), (a, a))] -> Set (a, a)
intersections :: [((a, a), (a, a))] -> Set (a, a)
intersections [((a, a), (a, a))]
segments = [(a, a)] -> Set (a, a)
forall a. Ord a => [a] -> Set a
Set.fromList ([(a, a)] -> Set (a, a)) -> [(a, a)] -> Set (a, a)
forall a b. (a -> b) -> a -> b
$ do
    ((a
x00, a
y00), (a
x01, a
y01)):[((a, a), (a, a))]
segments' <- [((a, a), (a, a))] -> [[((a, a), (a, a))]]
forall a. [a] -> [[a]]
tails [((a, a), (a, a))]
segments
    ((a
x10, a
y10), (a
x11, a
y11)) <- [((a, a), (a, a))]
segments'
    let m0 :: a
m0 = (a
y01 a -> a -> a
forall a. Num a => a -> a -> a
- a
y00) a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
x01 a -> a -> a
forall a. Num a => a -> a -> a
- a
x00)
        m1 :: a
m1 = (a
y11 a -> a -> a
forall a. Num a => a -> a -> a
- a
y10) a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
x11 a -> a -> a
forall a. Num a => a -> a -> a
- a
x10)
        a0 :: a
a0 = a
y00 a -> a -> a
forall a. Num a => a -> a -> a
- a
m0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x00
        a1 :: a
a1 = a
y10 a -> a -> a
forall a. Num a => a -> a -> a
- a
m1 a -> a -> a
forall a. Num a => a -> a -> a
* a
x10
    if
      | a
x00 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x01 Bool -> Bool -> Bool
&& a
x10 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x11 -> Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x00 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x10) [()] -> [(a, a)] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            [(a
x00, a
y) | a
y <- [a -> a -> a
forall a. Ord a => a -> a -> a
max a
y00 a
y10..a -> a -> a
forall a. Ord a => a -> a -> a
min a
y01 a
y11]]
      | a
x00 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x01 -> Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x10 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x00 Bool -> Bool -> Bool
&& a
x00 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x11) [()] -> [(a, a)] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            let y :: a
y = (a
y11 a -> a -> a
forall a. Num a => a -> a -> a
- a
y10) a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
x11 a -> a -> a
forall a. Num a => a -> a -> a
- a
x10) a -> a -> a
forall a. Num a => a -> a -> a
* (a
x00 a -> a -> a
forall a. Num a => a -> a -> a
- a
x10) a -> a -> a
forall a. Num a => a -> a -> a
+ a
y10
            in (a
x00, a
y) (a, a) -> [()] -> [(a, a)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
y00 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y01)
      | a
x10 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x11 -> Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x00 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x10 Bool -> Bool -> Bool
&& a
x10 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x01) [()] -> [(a, a)] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            let y :: a
y = (a
y01 a -> a -> a
forall a. Num a => a -> a -> a
- a
y00) a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
x01 a -> a -> a
forall a. Num a => a -> a -> a
- a
x00) a -> a -> a
forall a. Num a => a -> a -> a
* (a
x10 a -> a -> a
forall a. Num a => a -> a -> a
- a
x00) a -> a -> a
forall a. Num a => a -> a -> a
+ a
y00
            in (a
x10, a
y) (a, a) -> [()] -> [(a, a)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
y10 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y11)
      | a
m0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m1 -> Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
a0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a1) [()] -> [(a, a)] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            [(a
x, a
m0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a0) | a
x <- [a -> a -> a
forall a. Ord a => a -> a -> a
max a
x00 a
x10..a -> a -> a
forall a. Ord a => a -> a -> a
min a
x01 a
x11]]
      | (a
x, a
0) <- (a
a0 a -> a -> a
forall a. Num a => a -> a -> a
- a
a1) a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` (a
m1 a -> a -> a
forall a. Num a => a -> a -> a
- a
m0)
      , a -> a -> a
forall a. Ord a => a -> a -> a
max a
x00 a
x10 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a -> a
forall a. Ord a => a -> a -> a
min a
x01 a
x11 ->
            [(a
x, a
m0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a0)]
      | Bool
otherwise -> [(a, a)]
forall a. Monoid a => a
mempty

day5a :: Text -> Either (ParseErrorBundle Text Void) Int
day5a :: Text -> Either (ParseErrorBundle Text Void) Int
day5a Text
input = do
    [((Int, Int), (Int, Int))]
segments <- Parsec Void Text [((Int, Int), (Int, Int))]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [((Int, Int), (Int, Int))]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a e s (m :: * -> *).
(Num a, Ord a, MonadParsec e s m, Token s ~ Char,
 IsString (Tokens s)) =>
m [((a, a), (a, a))]
forall e s (m :: * -> *).
(Num Int, Ord Int, MonadParsec e s m, Token s ~ Char,
 IsString (Tokens s)) =>
m [((Int, Int), (Int, Int))]
parser @Int) String
"" Text
input
    Int -> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either (ParseErrorBundle Text Void) Int)
-> Int -> Either (ParseErrorBundle Text Void) Int
forall a b. (a -> b) -> a -> b
$ Set (Int, Int) -> Int
forall a. Set a -> Int
Set.size (Set (Int, Int) -> Int) -> Set (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [((Int, Int), (Int, Int))] -> Set (Int, Int)
forall a.
(Enum a, Integral a, Ord a, Show a) =>
[((a, a), (a, a))] -> Set (a, a)
intersections ([((Int, Int), (Int, Int))] -> Set (Int, Int))
-> [((Int, Int), (Int, Int))] -> Set (Int, Int)
forall a b. (a -> b) -> a -> b
$
        (((Int, Int), (Int, Int)) -> Bool)
-> [((Int, Int), (Int, Int))] -> [((Int, Int), (Int, Int))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> (((Int, Int), (Int, Int)) -> Bool)
-> ((Int, Int), (Int, Int))
-> Bool
-> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Int) -> (Int, Int) -> Bool)
-> ((Int, Int), (Int, Int)) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Int) -> Int
forall a b. (a, b) -> a
fst) (((Int, Int), (Int, Int)) -> Bool -> Bool)
-> (((Int, Int), (Int, Int)) -> Bool)
-> ((Int, Int), (Int, Int))
-> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int, Int) -> (Int, Int) -> Bool)
-> ((Int, Int), (Int, Int)) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Int) -> Int
forall a b. (a, b) -> b
snd)) [((Int, Int), (Int, Int))]
segments

day5b :: Text -> Either (ParseErrorBundle Text Void) Int
day5b :: Text -> Either (ParseErrorBundle Text Void) Int
day5b Text
input = do
    [((Int, Int), (Int, Int))]
segments <- Parsec Void Text [((Int, Int), (Int, Int))]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [((Int, Int), (Int, Int))]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall a e s (m :: * -> *).
(Num a, Ord a, MonadParsec e s m, Token s ~ Char,
 IsString (Tokens s)) =>
m [((a, a), (a, a))]
forall e s (m :: * -> *).
(Num Int, Ord Int, MonadParsec e s m, Token s ~ Char,
 IsString (Tokens s)) =>
m [((Int, Int), (Int, Int))]
parser @Int) String
"" Text
input
    Int -> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either (ParseErrorBundle Text Void) Int)
-> Int -> Either (ParseErrorBundle Text Void) Int
forall a b. (a -> b) -> a -> b
$ Set (Int, Int) -> Int
forall a. Set a -> Int
Set.size (Set (Int, Int) -> Int) -> Set (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [((Int, Int), (Int, Int))] -> Set (Int, Int)
forall a.
(Enum a, Integral a, Ord a, Show a) =>
[((a, a), (a, a))] -> Set (a, a)
intersections [((Int, Int), (Int, Int))]
segments