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

<https://adventofcode.com/2016/day/24>

-}
module Main where

import Advent (getInputArray)
import Advent.Coord (cardinal, Coord)
import Advent.Search (bfsOn)
import Advent.SmallSet (SmallSet)
import Advent.SmallSet qualified as SBS
import Data.Array.Unboxed (UArray)
import Data.Array.Unboxed qualified as Array
import Data.Char (digitToInt, isDigit)
import Data.Maybe (mapMaybe)

data Entry = Entry {-# UNPACK #-} !Coord !SmallSet
  deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq, Eq Entry
Eq Entry =>
(Entry -> Entry -> Ordering)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Entry)
-> (Entry -> Entry -> Entry)
-> Ord Entry
Entry -> Entry -> Bool
Entry -> Entry -> Ordering
Entry -> Entry -> Entry
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 :: Entry -> Entry -> Ordering
compare :: Entry -> Entry -> Ordering
$c< :: Entry -> Entry -> Bool
< :: Entry -> Entry -> Bool
$c<= :: Entry -> Entry -> Bool
<= :: Entry -> Entry -> Bool
$c> :: Entry -> Entry -> Bool
> :: Entry -> Entry -> Bool
$c>= :: Entry -> Entry -> Bool
>= :: Entry -> Entry -> Bool
$cmax :: Entry -> Entry -> Entry
max :: Entry -> Entry -> Entry
$cmin :: Entry -> Entry -> Entry
min :: Entry -> Entry -> Entry
Ord)

-- | >>> :main
-- 498
-- 804
main :: IO ()
IO ()
main =
  do UArray Coord Char
maze <- Int -> Int -> IO (UArray Coord Char)
getInputArray Int
2016 Int
24

     let targets :: SmallSet
targets = [Int] -> SmallSet
SBS.fromList
                 ([Int] -> SmallSet) -> [Int] -> SmallSet
forall a b. (a -> b) -> a -> b
$ (Char -> Maybe Int) -> [Char] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Int
digitToInt'
                 ([Char] -> [Int]) -> [Char] -> [Int]
forall a b. (a -> b) -> a -> b
$ UArray Coord Char -> [Char]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray Coord Char
maze

         [Coord
start] = [ Coord
c | (Coord
c,Char
x) <- UArray Coord Char -> [(Coord, Char)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs UArray Coord Char
maze, Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' ]

         endings :: [(Coord, Int)]
endings =
           [ (Coord
here,Int
steps)
              | (SmallSet
seen,Coord
here,Int
steps) <-
                    ((SmallSet, Coord, Int) -> Entry)
-> ((SmallSet, Coord, Int) -> [(SmallSet, Coord, Int)])
-> (SmallSet, Coord, Int)
-> [(SmallSet, Coord, Int)]
forall r a. Ord r => (a -> r) -> (a -> [a]) -> a -> [a]
bfsOn
                      (\(SmallSet
seen,Coord
here,Int
_steps) -> Coord -> SmallSet -> Entry
Entry Coord
here SmallSet
seen)
                      (UArray Coord Char
-> (SmallSet, Coord, Int) -> [(SmallSet, Coord, Int)]
next UArray Coord Char
maze)
                      (Int -> SmallSet
SBS.singleton Int
0, Coord
start,Int
0)
              , SmallSet
seen SmallSet -> SmallSet -> Bool
forall a. Eq a => a -> a -> Bool
== SmallSet
targets ]

     Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. HasCallStack => [a] -> a
head [ Int
steps | (Coord
_  ,Int
steps) <- [(Coord, Int)]
endings ]
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. HasCallStack => [a] -> a
head [ Int
steps | (Coord
end,Int
steps) <- [(Coord, Int)]
endings, Coord
end Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
start ]

next ::
  UArray Coord Char ->
  (SmallSet, Coord, Int) ->
  [(SmallSet, Coord, Int)]
next :: UArray Coord Char
-> (SmallSet, Coord, Int) -> [(SmallSet, Coord, Int)]
next UArray Coord Char
maze (SmallSet
seen,Coord
here,Int
steps) =
  [ (SmallSet
seen',Coord
here',Int
steps')
    | let !steps' :: Int
steps' = Int
steps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    , Coord
here' <- Coord -> [Coord]
cardinal Coord
here
    , let x :: Char
x = UArray Coord Char
maze UArray Coord Char -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
Array.! Coord
here'
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#'
    , let !seen' :: SmallSet
seen' = case Char -> Maybe Int
digitToInt' Char
x of
                     Just Int
i  -> Int -> SmallSet -> SmallSet
SBS.insert Int
i SmallSet
seen
                     Maybe Int
Nothing -> SmallSet
seen
    ]

digitToInt' :: Char -> Maybe Int
digitToInt' :: Char -> Maybe Int
digitToInt' Char
x
  | Char -> Bool
isDigit Char
x = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
digitToInt Char
x)
  | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing