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

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

A brute-forced approach. First extract the graph of
intersections and then just enumerate all the possible
paths between them that reach the exit.

>>> :{
:main +
"#.#####################
#.......#########...###
#######.#########.#.###
###.....#.>.>.###.#.###
###v#####.#v#.###.#.###
###.>...#.#.#.....#...#
###v###.#.#.#########.#
###...#.#.#.......#...#
#####.#.#.#######.#.###
#.....#.#.#.......#...#
#.#####.#.#.#########v#
#.#...#...#...###...>.#
#.#.#v#######v###.###v#
#...#.>.#...>.>.#.###.#
#####v#.#.###v#.#.###.#
#.....#...#...#.#.#...#
#.#########.###.#.#.###
#...###...#...#...#.###
###.###.#.###v#####v###
#...#...#.#.>.>.#.>.###
#.###.###.#.###.#.#v###
#.....###...###...#...#
#####################.#
"
:}
94
154

-}
module Main (main) where

import Advent (getInputArray, arrIx)
import Advent.Coord (cardinal, coordRow, east, north, south, west, Coord(C))
import Data.Array.Unboxed (bounds, UArray)
import Data.List (delete)
import Data.Map (Map)
import Data.Map qualified as Map

main :: IO ()
IO ()
main =
 do input <- Int -> Int -> IO (UArray Coord Char)
getInputArray Int
2023 Int
23
    let (_, C ymax _) = bounds input
    let solve = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> ((Coord -> Char -> Bool) -> [Int])
-> (Coord -> Char -> Bool)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Coord -> Int -> Map Coord [(Coord, Int)] -> [Int]
enum Int
ymax (Int -> Int -> Coord
C Int
0 Int
1) Int
0 (Map Coord [(Coord, Int)] -> [Int])
-> ((Coord -> Char -> Bool) -> Map Coord [(Coord, Int)])
-> (Coord -> Char -> Bool)
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArray Coord Char
-> (Coord -> Char -> Bool) -> Map Coord [(Coord, Int)]
buildPaths UArray Coord Char
input

    print (solve part1)
    print (solve part2)

-- | Generate all the possible distances from the start to the end.
enum :: Int -> Coord -> Int -> Map Coord [(Coord, Int)] -> [Int]
enum :: Int -> Coord -> Int -> Map Coord [(Coord, Int)] -> [Int]
enum !Int
ymax !Coord
here !Int
dist Map Coord [(Coord, Int)]
edges
  | Coord -> Int
coordRow Coord
here Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ymax = [Int
dist]
  | Bool
otherwise =
   do let edges' :: Map Coord [(Coord, Int)]
edges' = Coord -> Map Coord [(Coord, Int)] -> Map Coord [(Coord, Int)]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coord
here Map Coord [(Coord, Int)]
edges
      (next, cost) <- [(Coord, Int)]
-> Coord -> Map Coord [(Coord, Int)] -> [(Coord, Int)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Coord
here Map Coord [(Coord, Int)]
edges
      enum ymax next (dist + cost) edges'

-- | Build a map of locations and distances reachable from each key.
buildPaths ::
  UArray Coord Char       {- ^ input grid        -} ->
  (Coord -> Char -> Bool) {- ^ adjacency rule    -} ->
  Map Coord [(Coord, Int)]
buildPaths :: UArray Coord Char
-> (Coord -> Char -> Bool) -> Map Coord [(Coord, Int)]
buildPaths UArray Coord Char
input Coord -> Char -> Bool
isOpen = Map Coord [(Coord, Int)] -> Coord -> Map Coord [(Coord, Int)]
forall {b}.
Num b =>
Map Coord [(Coord, b)] -> Coord -> Map Coord [(Coord, b)]
go Map Coord [(Coord, Int)]
forall k a. Map k a
Map.empty (Int -> Int -> Coord
C Int
0 Int
1)
  where
    (Coord
_, C Int
ymax Int
_) = UArray Coord Char -> (Coord, Coord)
forall i. Ix i => UArray i Char -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Coord Char
input

    go :: Map Coord [(Coord, b)] -> Coord -> Map Coord [(Coord, b)]
go Map Coord [(Coord, b)]
acc Coord
c
      | Coord -> Map Coord [(Coord, b)] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Coord
c Map Coord [(Coord, b)]
acc = Map Coord [(Coord, b)]
acc -- already computed, skip
      | Bool
otherwise = (Map Coord [(Coord, b)] -> Coord -> Map Coord [(Coord, b)])
-> Map Coord [(Coord, b)] -> [Coord] -> Map Coord [(Coord, b)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Coord [(Coord, b)] -> Coord -> Map Coord [(Coord, b)]
go (Coord
-> [(Coord, b)] -> Map Coord [(Coord, b)] -> Map Coord [(Coord, b)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coord
c [(Coord, b)]
reachable Map Coord [(Coord, b)]
acc) (((Coord, b) -> Coord) -> [(Coord, b)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, b) -> Coord
forall a b. (a, b) -> a
fst [(Coord, b)]
reachable)
      where
        reachable :: [(Coord, b)]
reachable = (Coord -> (Coord, b)) -> [Coord] -> [(Coord, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b -> Coord -> Coord -> (Coord, b)
forall {b}. Num b => b -> Coord -> Coord -> (Coord, b)
walk b
1 Coord
c) (UArray Coord Char -> (Coord -> Char -> Bool) -> Coord -> [Coord]
adj UArray Coord Char
input Coord -> Char -> Bool
isOpen Coord
c)

    -- find the next intersection in this direction and track the distance to it
    walk :: b -> Coord -> Coord -> (Coord, b)
walk b
dist Coord
prev Coord
cur
      | Coord -> Int
coordRow Coord
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ymax                         -- not the terminal location
      , [Coord
next] <- Coord -> [Coord] -> [Coord]
forall a. Eq a => a -> [a] -> [a]
delete Coord
prev (UArray Coord Char -> (Coord -> Char -> Bool) -> Coord -> [Coord]
adj UArray Coord Char
input Coord -> Char -> Bool
isOpen Coord
cur) -- only one next location
      = b -> Coord -> Coord -> (Coord, b)
walk (b
dist b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) Coord
cur Coord
next                     -- keep walking

      | Bool
otherwise = (Coord
cur, b
dist)                      -- record interesting location

-- | Return all the coordinates that are adjacent to this one.
adj :: UArray Coord Char -> (Coord -> Char -> Bool) -> Coord -> [Coord]
adj :: UArray Coord Char -> (Coord -> Char -> Bool) -> Coord -> [Coord]
adj UArray Coord Char
input Coord -> Char -> Bool
isOpen Coord
cur =
  [ Coord
next
  | Coord
next <- Coord -> [Coord]
cardinal Coord
cur
  , Char
char <- UArray Coord Char -> Coord -> [Char]
forall (a :: * -> * -> *) e i (f :: * -> *).
(IArray a e, Ix i, Alternative f) =>
a i e -> i -> f e
arrIx UArray Coord Char
input Coord
next
  , Coord -> Char -> Bool
isOpen (Coord
next Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
- Coord
cur) Char
char
  ]

-- | Adjacency rule that respects slope characters.
part1 :: Coord -> Char -> Bool
part1 :: Coord -> Char -> Bool
part1 Coord
dir = \case
  Char
'#' -> Bool
False
  Char
'>' -> Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east
  Char
'v' -> Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
south
  Char
'^' -> Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
north
  Char
'<' -> Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west
  Char
_   -> Bool
True

-- | Adjacency rule that ignores slope characters.
part2 :: Coord -> Char -> Bool
part2 :: Coord -> Char -> Bool
part2 Coord
_ = (Char
'#' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)