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

<https://adventofcode.com/2018/day/20>

This solution relies on the generated maze starting from the origin.
Each door will be located at coordinates where one component of the
coordinate is odd and the other is even. Rooms will be located at
coordinates where both components are even. Coordinates where both
components are odd will always be walls.

@
    -  <->  +
   54321012345
  5###########
- 4#.|.#.|.#.#
  3#-###-#-#-#
  2#.|.|.#.#.#
^ 1#-#####-#-#
| 0#.#.#X|.#.#
v 1#-#-#####-#
  2#.#.|.|.|.#
  3#-###-###-#
+ 4#.|.|.#.|.#
  5###########
@

-}
module Main (main) where

import Advent (countBy, getInputLines)
import Advent.Coord (Coord(C), above, below, left, right, origin)
import Advent.Search (bfsOn)
import Control.Applicative (Alternative((<|>), many))
import Control.Monad (foldM)
import Data.Set (Set)
import Data.Set qualified as Set
import Text.ParserCombinators.ReadP (ReadP, between, readP_to_S, sepBy1)

-- | Cardinal directions: north south east west
data Dir = N | S | E | W
  deriving (Dir -> Dir -> Bool
(Dir -> Dir -> Bool) -> (Dir -> Dir -> Bool) -> Eq Dir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dir -> Dir -> Bool
== :: Dir -> Dir -> Bool
$c/= :: Dir -> Dir -> Bool
/= :: Dir -> Dir -> Bool
Eq, Eq Dir
Eq Dir =>
(Dir -> Dir -> Ordering)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Dir)
-> (Dir -> Dir -> Dir)
-> Ord Dir
Dir -> Dir -> Bool
Dir -> Dir -> Ordering
Dir -> Dir -> Dir
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Dir -> Dir -> Ordering
compare :: Dir -> Dir -> Ordering
$c< :: Dir -> Dir -> Bool
< :: Dir -> Dir -> Bool
$c<= :: Dir -> Dir -> Bool
<= :: Dir -> Dir -> Bool
$c> :: Dir -> Dir -> Bool
> :: Dir -> Dir -> Bool
$c>= :: Dir -> Dir -> Bool
>= :: Dir -> Dir -> Bool
$cmax :: Dir -> Dir -> Dir
max :: Dir -> Dir -> Dir
$cmin :: Dir -> Dir -> Dir
min :: Dir -> Dir -> Dir
Ord, Int -> Dir -> ShowS
[Dir] -> ShowS
Dir -> String
(Int -> Dir -> ShowS)
-> (Dir -> String) -> ([Dir] -> ShowS) -> Show Dir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dir -> ShowS
showsPrec :: Int -> Dir -> ShowS
$cshow :: Dir -> String
show :: Dir -> String
$cshowList :: [Dir] -> ShowS
showList :: [Dir] -> ShowS
Show)

-- | Regular expressions parameterized by the underlying elements
newtype Regexp a = RE [[Either a (Regexp a)]]
  deriving (Regexp a -> Regexp a -> Bool
(Regexp a -> Regexp a -> Bool)
-> (Regexp a -> Regexp a -> Bool) -> Eq (Regexp a)
forall a. Eq a => Regexp a -> Regexp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Regexp a -> Regexp a -> Bool
== :: Regexp a -> Regexp a -> Bool
$c/= :: forall a. Eq a => Regexp a -> Regexp a -> Bool
/= :: Regexp a -> Regexp a -> Bool
Eq, Eq (Regexp a)
Eq (Regexp a) =>
(Regexp a -> Regexp a -> Ordering)
-> (Regexp a -> Regexp a -> Bool)
-> (Regexp a -> Regexp a -> Bool)
-> (Regexp a -> Regexp a -> Bool)
-> (Regexp a -> Regexp a -> Bool)
-> (Regexp a -> Regexp a -> Regexp a)
-> (Regexp a -> Regexp a -> Regexp a)
-> Ord (Regexp a)
Regexp a -> Regexp a -> Bool
Regexp a -> Regexp a -> Ordering
Regexp a -> Regexp a -> Regexp a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Regexp a)
forall a. Ord a => Regexp a -> Regexp a -> Bool
forall a. Ord a => Regexp a -> Regexp a -> Ordering
forall a. Ord a => Regexp a -> Regexp a -> Regexp a
$ccompare :: forall a. Ord a => Regexp a -> Regexp a -> Ordering
compare :: Regexp a -> Regexp a -> Ordering
$c< :: forall a. Ord a => Regexp a -> Regexp a -> Bool
< :: Regexp a -> Regexp a -> Bool
$c<= :: forall a. Ord a => Regexp a -> Regexp a -> Bool
<= :: Regexp a -> Regexp a -> Bool
$c> :: forall a. Ord a => Regexp a -> Regexp a -> Bool
> :: Regexp a -> Regexp a -> Bool
$c>= :: forall a. Ord a => Regexp a -> Regexp a -> Bool
>= :: Regexp a -> Regexp a -> Bool
$cmax :: forall a. Ord a => Regexp a -> Regexp a -> Regexp a
max :: Regexp a -> Regexp a -> Regexp a
$cmin :: forall a. Ord a => Regexp a -> Regexp a -> Regexp a
min :: Regexp a -> Regexp a -> Regexp a
Ord, Int -> Regexp a -> ShowS
[Regexp a] -> ShowS
Regexp a -> String
(Int -> Regexp a -> ShowS)
-> (Regexp a -> String) -> ([Regexp a] -> ShowS) -> Show (Regexp a)
forall a. Show a => Int -> Regexp a -> ShowS
forall a. Show a => [Regexp a] -> ShowS
forall a. Show a => Regexp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Regexp a -> ShowS
showsPrec :: Int -> Regexp a -> ShowS
$cshow :: forall a. Show a => Regexp a -> String
show :: Regexp a -> String
$cshowList :: forall a. Show a => [Regexp a] -> ShowS
showList :: [Regexp a] -> ShowS
Show)

-- | Print the answers to day 20
--
-- >>> :main
-- 4121
-- 8636
main :: IO ()
IO ()
main =
 do [String
input] <- Int -> Int -> IO [String]
getInputLines Int
2018 Int
20
    let [(Regexp Dir
re,String
_)] = ReadP (Regexp Dir) -> ReadS (Regexp Dir)
forall a. ReadP a -> ReadS a
readP_to_S ReadP (Regexp Dir)
parseRe0 String
input 
    let (Set Coord
doors, Set Coord
_) = Set Coord -> Regexp Dir -> (Set Coord, Set Coord)
route (Coord -> Set Coord
forall a. a -> Set a
Set.singleton Coord
origin) Regexp Dir
re
    let ds :: [Int]
ds = (Coord -> [Coord]) -> Coord -> [Int]
forall a. Ord a => (a -> [a]) -> a -> [Int]
distances (Set Coord -> Coord -> [Coord]
neighbor Set Coord
doors) (Int -> Int -> Coord
C Int
0 Int
0)

    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ds)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ((Int -> Bool) -> [Int] -> Int
forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countBy (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000) [Int]
ds)

-- Regular expression parsing for each level of precedence
parseRe0 :: ReadP (Regexp Dir)
parseRe0 :: ReadP (Regexp Dir)
parseRe0 = ReadP String
-> ReadP String -> ReadP (Regexp Dir) -> ReadP (Regexp Dir)
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between ReadP String
"^" ReadP String
"$" ReadP (Regexp Dir)
parseRe1

parseRe1 :: ReadP (Regexp Dir)
parseRe1 :: ReadP (Regexp Dir)
parseRe1 = [[Either Dir (Regexp Dir)]] -> Regexp Dir
forall a. [[Either a (Regexp a)]] -> Regexp a
RE ([[Either Dir (Regexp Dir)]] -> Regexp Dir)
-> ReadP [[Either Dir (Regexp Dir)]] -> ReadP (Regexp Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP (Either Dir (Regexp Dir)) -> ReadP [Either Dir (Regexp Dir)]
forall a. ReadP a -> ReadP [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ReadP (Either Dir (Regexp Dir))
parseRe2 ReadP [Either Dir (Regexp Dir)]
-> ReadP String -> ReadP [[Either Dir (Regexp Dir)]]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy1` ReadP String
"|"

parseRe2 :: ReadP (Either Dir (Regexp Dir))
parseRe2 :: ReadP (Either Dir (Regexp Dir))
parseRe2 = Regexp Dir -> Either Dir (Regexp Dir)
forall a b. b -> Either a b
Right (Regexp Dir -> Either Dir (Regexp Dir))
-> ReadP (Regexp Dir) -> ReadP (Either Dir (Regexp Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP String
-> ReadP String -> ReadP (Regexp Dir) -> ReadP (Regexp Dir)
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between ReadP String
"(" ReadP String
")" ReadP (Regexp Dir)
parseRe1 ReadP (Either Dir (Regexp Dir))
-> ReadP (Either Dir (Regexp Dir))
-> ReadP (Either Dir (Regexp Dir))
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dir -> Either Dir (Regexp Dir)
forall a b. a -> Either a b
Left (Dir -> Either Dir (Regexp Dir))
-> ReadP Dir -> ReadP (Either Dir (Regexp Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Dir
parseDir

-- | Parse a cardinal direction
parseDir :: ReadP Dir
parseDir :: ReadP Dir
parseDir = Dir
N Dir -> ReadP String -> ReadP Dir
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"N" ReadP Dir -> ReadP Dir -> ReadP Dir
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dir
S Dir -> ReadP String -> ReadP Dir
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"S" ReadP Dir -> ReadP Dir -> ReadP Dir
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dir
E Dir -> ReadP String -> ReadP Dir
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"E" ReadP Dir -> ReadP Dir -> ReadP Dir
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dir
W Dir -> ReadP String -> ReadP Dir
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"W"

-- | Move one space giving a direction and a starting coordinate
move :: Dir -> Coord -> Coord
move :: Dir -> Coord -> Coord
move Dir
N = Coord -> Coord
above
move Dir
S = Coord -> Coord
below
move Dir
W = Coord -> Coord
left
move Dir
E = Coord -> Coord
right

-- | Given the set of doors, generate a list of rooms reachable from a
-- given room
neighbor :: Set Coord -> Coord -> [Coord]
neighbor :: Set Coord -> Coord -> [Coord]
neighbor Set Coord
doors Coord
here =
  [ Dir -> Coord -> Coord
move Dir
dir (Dir -> Coord -> Coord
move Dir
dir Coord
here)
    | Dir
dir <- [Dir
N,Dir
E,Dir
S,Dir
W]
    , Coord -> Set Coord -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Dir -> Coord -> Coord
move Dir
dir Coord
here) Set Coord
doors ]

data WithLen a = WithLen { forall a. WithLen a -> Int
dist :: !Int, forall a. WithLen a -> a
loc :: a }

-- | Given a neighbors generating function compute the minimum distances
-- to all reachable locations.
distances :: Ord a => (a -> [a]) -> a -> [Int]
distances :: forall a. Ord a => (a -> [a]) -> a -> [Int]
distances a -> [a]
next a
start = WithLen a -> Int
forall a. WithLen a -> Int
dist (WithLen a -> Int) -> [WithLen a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithLen a -> a)
-> (WithLen a -> [WithLen a]) -> WithLen a -> [WithLen a]
forall r a. Ord r => (a -> r) -> (a -> [a]) -> a -> [a]
bfsOn WithLen a -> a
forall a. WithLen a -> a
loc (\(WithLen Int
x a
y) -> Int -> a -> WithLen a
forall a. Int -> a -> WithLen a
WithLen (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (a -> WithLen a) -> [a] -> [WithLen a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
next a
y) (Int -> a -> WithLen a
forall a. Int -> a -> WithLen a
WithLen Int
0 a
start)

-- | Given a regular expression, compute a set of generated doors and end points
-- generated from the regular expression when starting at the origin.
route :: Set Coord -> Regexp Dir -> (Set Coord, Set Coord)
route :: Set Coord -> Regexp Dir -> (Set Coord, Set Coord)
route Set Coord
starts (RE [[Either Dir (Regexp Dir)]]
alts) = ([Either Dir (Regexp Dir)] -> (Set Coord, Set Coord))
-> [[Either Dir (Regexp Dir)]] -> (Set Coord, Set Coord)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Set Coord -> Either Dir (Regexp Dir) -> (Set Coord, Set Coord))
-> Set Coord -> [Either Dir (Regexp Dir)] -> (Set Coord, Set Coord)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Set Coord -> Either Dir (Regexp Dir) -> (Set Coord, Set Coord)
routeFrom Set Coord
starts) [[Either Dir (Regexp Dir)]]
alts

-- Given a set of starting points and a new direction or sub-expression
-- compute the reachable doors and the ending coordinates
routeFrom :: Set Coord -> Either Dir (Regexp Dir) -> (Set Coord, Set Coord)
routeFrom :: Set Coord -> Either Dir (Regexp Dir) -> (Set Coord, Set Coord)
routeFrom Set Coord
starts = (Dir -> (Set Coord, Set Coord))
-> (Regexp Dir -> (Set Coord, Set Coord))
-> Either Dir (Regexp Dir)
-> (Set Coord, Set Coord)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set Coord -> Dir -> (Set Coord, Set Coord)
dirStep Set Coord
starts) (Set Coord -> Regexp Dir -> (Set Coord, Set Coord)
route Set Coord
starts)

-- | Generate the door passed thorugh and the end point when taking a step from the origin
-- in the given direction.
dirStep :: Set Coord -> Dir -> (Set Coord, Set Coord)
dirStep :: Set Coord -> Dir -> (Set Coord, Set Coord)
dirStep Set Coord
starts Dir
d = ( (Coord -> Coord) -> Set Coord -> Set Coord
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (Dir -> Coord -> Coord
move Dir
d) Set Coord
starts -- doors
                   , (Coord -> Coord) -> Set Coord -> Set Coord
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (Dir -> Coord -> Coord
move Dir
d (Coord -> Coord) -> (Coord -> Coord) -> Coord -> Coord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Coord -> Coord
move Dir
d) Set Coord
starts) -- endpoint