{-|
Module      : Main
Description : Day 12 solution
Copyright   : (c) Eric Mertens, 2022
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2022/day/12>

>>> :{
:main +
    "Sabqponm\n\
    \abcryxxl\n\
    \accszExk\n\
    \acctuvwj\n\
    \abdefghi\n"
:}
31
29

-}
module Main where

import Data.Array.Unboxed (UArray, (!), assocs, amap)

import Advent (getInputArray, arrIx)
import Advent.Coord (Coord, cardinal)
import Advent.Search (bfsOnN)

-- |
-- >>> :main
-- 528
-- 522
main :: IO ()
IO ()
main =
 do UArray Coord Char
input <- Int -> Int -> IO (UArray Coord Char)
getInputArray Int
2022 Int
12
    Int -> IO ()
forall a. Show a => a -> IO ()
print (UArray Coord Char -> Char -> Int
solve UArray Coord Char
input Char
'S')
    Int -> IO ()
forall a. Show a => a -> IO ()
print (UArray Coord Char -> Char -> Int
solve UArray Coord Char
input Char
'a')

-- | Given an input map and a starting letter, return the length of the shortest
-- path to the ending letter (@E@).
solve :: UArray Coord Char -> Char -> Int
solve :: UArray Coord Char -> Char -> Int
solve UArray Coord Char
input Char
startLetter =
    [Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int
n | (Coord
e, Int
n) <- ((Coord, Int) -> Coord)
-> ((Coord, Int) -> [(Coord, Int)])
-> [(Coord, Int)]
-> [(Coord, Int)]
forall r a. Ord r => (a -> r) -> (a -> [a]) -> [a] -> [a]
bfsOnN (Coord, Int) -> Coord
forall a b. (a, b) -> a
fst (Coord, Int) -> [(Coord, Int)]
forall {b}. Num b => (Coord, b) -> [(Coord, b)]
step [(Coord, Int)]
startStates, UArray Coord Char
input UArray Coord Char -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coord
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E']
    where
        startStates :: [(Coord, Int)]
startStates = [(Coord
k, Int
0) | (Coord
k, Char
v) <- UArray Coord Char -> [(Coord, Char)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs UArray Coord Char
input, Char
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
startLetter]
        elevations :: UArray Coord Char
elevations  = (Char -> Char) -> UArray Coord Char -> UArray Coord Char
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
amap Char -> Char
elevation UArray Coord Char
input

        step :: (Coord, b) -> [(Coord, b)]
step (Coord
here, b
n) =
            [ (Coord
next, b
nb -> b -> b
forall a. Num a => a -> a -> a
+b
1)
            | Coord
next <- Coord -> [Coord]
cardinal Coord
here
            , Char
dest <- 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
elevations Coord
next
            , Char -> Char
forall a. Enum a => a -> a
succ (UArray Coord Char
elevations UArray Coord Char -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coord
here) Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
dest
            ]

-- | Compute the logical elevation by mapping start and end characters to
-- their corresponding lowercase elevation values.
elevation :: Char -> Char
elevation :: Char -> Char
elevation Char
'S' = Char
'a'
elevation Char
'E' = Char
'z'
elevation  Char
x  =  Char
x