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

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

Search for the cheapest way to rearrange lizards in a maze
to get all the lizards back into the correct rooms.

-}
module Main (main) where

import Advent.Coord (Coord(..), coordCol, below, manhattan, cardinal)
import Advent.Input (getInputMap)
import Advent.Search (AStep(..), dfs, astar)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Char (ord, isLetter)

data Cell = Open | Amphi { Cell -> Int
amphiTarget :: !Int, Cell -> Int
amphiCost :: !Int }
  deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
/= :: Cell -> Cell -> Bool
Eq, Eq Cell
Eq Cell =>
(Cell -> Cell -> Ordering)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Cell)
-> (Cell -> Cell -> Cell)
-> Ord Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
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 :: Cell -> Cell -> Ordering
compare :: Cell -> Cell -> Ordering
$c< :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
>= :: Cell -> Cell -> Bool
$cmax :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
min :: Cell -> Cell -> Cell
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> String
show :: Cell -> String
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show)

-- | Compute all the information needed from a character in the input map.
toCell :: Char -> Maybe Cell
toCell :: Char -> Maybe Cell
toCell Char
'.' = Cell -> Maybe Cell
forall a. a -> Maybe a
Just Cell
Open
toCell Char
a | Char -> Bool
isLetter Char
a = Cell -> Maybe Cell
forall a. a -> Maybe a
Just (Cell -> Maybe Cell) -> Cell -> Maybe Cell
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Cell
Amphi (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65)) (Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Char -> Int
ord Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65))
toCell Char
_ = Maybe Cell
forall a. Maybe a
Nothing

-- | Predicate for rooms (rather than hallways)
isRoom :: Coord -> Bool
isRoom :: Coord -> Bool
isRoom (C Int
_ Int
c) = Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9

main :: IO ()
IO ()
main =
 do Map Coord Cell
inp <- (Char -> Maybe Cell) -> Map Coord Char -> Map Coord Cell
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Char -> Maybe Cell
toCell (Map Coord Char -> Map Coord Cell)
-> IO (Map Coord Char) -> IO (Map Coord Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO (Map Coord Char)
getInputMap Int
2021 Int
23
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int
cost | (Map Coord Cell
w, Int
cost) <- (Map Coord Cell -> [AStep (Map Coord Cell)])
-> Map Coord Cell -> [(Map Coord Cell, Int)]
forall a. Ord a => (a -> [AStep a]) -> a -> [(a, Int)]
astar Map Coord Cell -> [AStep (Map Coord Cell)]
step Map Coord Cell
inp, Map Coord Cell -> Bool
done Map Coord Cell
w])

-- | Step the simulation once tracking the cost of the move.
step :: Map Coord Cell -> [AStep (Map Coord Cell)]
step :: Map Coord Cell -> [AStep (Map Coord Cell)]
step Map Coord Cell
w =
  [ AStep { astepNext :: Map Coord Cell
astepNext = Coord -> Cell -> Map Coord Cell -> Map Coord Cell
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coord
c Cell
Open (Coord -> Cell -> Map Coord Cell -> Map Coord Cell
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coord
dest Cell
a Map Coord Cell
w)
          , astepCost :: Int
astepCost = Coord -> Coord -> Int
manhattan Coord
c Coord
dest Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stepCost
          , astepHeuristic :: Int
astepHeuristic = Int
0 }
  | (Coord
c, a :: Cell
a@(Amphi Int
target Int
stepCost)) <- Map Coord Cell -> [(Coord, Cell)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Coord Cell
w
  , Coord
dest <- Map Coord Cell -> Coord -> [Coord]
route Map Coord Cell
w Coord
c
  , if Coord -> Bool
isRoom Coord
c
      then Bool -> Bool
not (Coord -> Bool
isRoom Coord
dest)
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Map Coord Cell -> Int -> Bool
roomClean Map Coord Cell
w (Coord -> Int
coordCol Coord
c))
      else Coord -> Bool
isRoom Coord
dest
        Bool -> Bool -> Bool
&& Coord -> Int
coordCol Coord
dest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
target
        Bool -> Bool -> Bool
&& Map Coord Cell -> Int -> Bool
roomClean Map Coord Cell
w Int
target
        Bool -> Bool -> Bool
&& Bool -> (Cell -> Bool) -> Maybe Cell -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Cell
aCell -> Cell -> Bool
forall a. Eq a => a -> a -> Bool
==) (Coord -> Map Coord Cell -> Maybe Cell
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Coord -> Coord
below Coord
dest) Map Coord Cell
w)
  ]

-- | Check that all the amphis in a room are supposed to be there.
roomClean :: Map Coord Cell -> Int -> Bool
roomClean :: Map Coord Cell -> Int -> Bool
roomClean Map Coord Cell
w Int
c = Int -> Bool
go Int
2
  where
    go :: Int -> Bool
go Int
r =
      case Coord -> Map Coord Cell -> Maybe Cell
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> Int -> Coord
C Int
r Int
c) Map Coord Cell
w of
        Just Cell
Open -> Int -> Bool
go (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Just (Amphi Int
t Int
_) -> Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c Bool -> Bool -> Bool
&& Int -> Bool
go (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Maybe Cell
Nothing -> Bool
True

-- | Check that everything on the map is where it should be.
done :: Map Coord Cell -> Bool
done :: Map Coord Cell -> Bool
done Map Coord Cell
w =
  ((Coord, Cell) -> Bool) -> [(Coord, Cell)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Coord
k,Cell
v) ->
      case Cell
v of
        Cell
Open -> Bool
True
        Amphi Int
t Int
_ -> Coord -> Int
coordCol Coord
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
t)
  (Map Coord Cell -> [(Coord, Cell)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Coord Cell
w)

route :: Map Coord Cell -> Coord -> [Coord]
route :: Map Coord Cell -> Coord -> [Coord]
route Map Coord Cell
w = (Coord -> [Coord]) -> Coord -> [Coord]
forall a. Ord a => (a -> [a]) -> a -> [a]
dfs Coord -> [Coord]
move
  where
    move :: Coord -> [Coord]
move Coord
c = [Coord
c' | Coord
c' <- Coord -> [Coord]
cardinal Coord
c, Coord -> Map Coord Cell -> Maybe Cell
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Coord
c' Map Coord Cell
w Maybe Cell -> Maybe Cell -> Bool
forall a. Eq a => a -> a -> Bool
== Cell -> Maybe Cell
forall a. a -> Maybe a
Just Cell
Open]