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

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

-}
module Main where

import Advent (format, arrIx)
import Advent.Coord (Coord(..), manhattan, cardinal, boundingBox, origin)
import Advent.Search (AStep(AStep), astar)
import Data.Array (Array)
import Data.Array qualified as Array

data Node = Node { Node -> Int
nodeSize, Node -> Int
nodeUsed :: !Int }
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show)

-- Hardcode a constant I computed for my particular input.
-- This problem doesn't favor a general solution, so I didn't
-- bother encoding my analysis of what constitutes an immobile
-- node into my program

cutoff :: Int
cutoff :: Int
cutoff = Int
100

main :: IO ()
IO ()
main =
 do [(Int, Int, Int, Int, Int, Int)]
input <- [format|2016 22
      root%@ebhq-gridcenter# df -h%n
      Filesystem              Size  Used  Avail  Use%%%n
      (/dev/grid/node-x%u-y%u *%uT *%uT *%uT *%u%%%n)*
      |]
    let grid :: Array Coord Node
grid = [(Coord, Node)] -> Array Coord Node
forall a. [(Coord, a)] -> Array Coord a
toArray [(Int -> Int -> Coord
C Int
y Int
x, Int -> Int -> Node
Node Int
sz Int
use) | (Int
x,Int
y,Int
sz,Int
use,Int
_,Int
_) <- [(Int, Int, Int, Int, Int, Int)]
input]
    let start :: Coord
start = Array Coord Node -> Coord
forall e. Array Coord e -> Coord
findStart Array Coord Node
grid
        hole :: Coord
hole  = Array Coord Node -> Coord
findHole Array Coord Node
grid
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Array Coord Node -> Int
viable Array Coord Node
grid
    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
cost | (SearchState
ss, Int
cost) <- (SearchState -> [AStep SearchState])
-> SearchState -> [(SearchState, Int)]
forall a. Ord a => (a -> [AStep a]) -> a -> [(a, Int)]
astar (Array Coord Node -> SearchState -> [AStep SearchState]
next Array Coord Node
grid) (Coord -> Coord -> SearchState
SearchState Coord
start Coord
hole)
                  , SearchState -> Coord
searchGoal SearchState
ss Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
origin
                  ]

viable :: Array Coord Node -> Int
viable :: Array Coord Node -> Int
viable Array Coord Node
grid = [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  [() | (Coord
c1,Node
n1) <- Array Coord Node -> [(Coord, Node)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array Coord Node
grid
      , (Coord
c2,Node
n2) <- Array Coord Node -> [(Coord, Node)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array Coord Node
grid
      , Coord
c1 Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
/= Coord
c2
      , Node -> Int
nodeUsed Node
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
      , Node -> Int
nodeUsed Node
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Node -> Int
nodeSize Node
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node -> Int
nodeUsed Node
n2 ]

findStart :: Array Coord e -> Coord
findStart :: forall e. Array Coord e -> Coord
findStart Array Coord e
grid =
  [Coord] -> Coord
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int -> Int -> Coord
C Int
0 Int
x | C Int
0 Int
x <- (Coord, Coord) -> [Coord]
forall a. Ix a => (a, a) -> [a]
Array.range (Array Coord e -> (Coord, Coord)
forall i e. Array i e -> (i, i)
Array.bounds Array Coord e
grid)]

findHole :: Array Coord Node -> Coord
findHole :: Array Coord Node -> Coord
findHole Array Coord Node
grid = [Coord] -> Coord
forall a. HasCallStack => [a] -> a
head [ Coord
c | (Coord
c,Node
n) <- Array Coord Node -> [(Coord, Node)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array Coord Node
grid, Node -> Int
nodeUsed Node
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ]

data SearchState = SearchState
  { SearchState -> Coord
searchGoal, SearchState -> Coord
searchHole :: !Coord }
  deriving (SearchState -> SearchState -> Bool
(SearchState -> SearchState -> Bool)
-> (SearchState -> SearchState -> Bool) -> Eq SearchState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchState -> SearchState -> Bool
== :: SearchState -> SearchState -> Bool
$c/= :: SearchState -> SearchState -> Bool
/= :: SearchState -> SearchState -> Bool
Eq, Eq SearchState
Eq SearchState =>
(SearchState -> SearchState -> Ordering)
-> (SearchState -> SearchState -> Bool)
-> (SearchState -> SearchState -> Bool)
-> (SearchState -> SearchState -> Bool)
-> (SearchState -> SearchState -> Bool)
-> (SearchState -> SearchState -> SearchState)
-> (SearchState -> SearchState -> SearchState)
-> Ord SearchState
SearchState -> SearchState -> Bool
SearchState -> SearchState -> Ordering
SearchState -> SearchState -> SearchState
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 :: SearchState -> SearchState -> Ordering
compare :: SearchState -> SearchState -> Ordering
$c< :: SearchState -> SearchState -> Bool
< :: SearchState -> SearchState -> Bool
$c<= :: SearchState -> SearchState -> Bool
<= :: SearchState -> SearchState -> Bool
$c> :: SearchState -> SearchState -> Bool
> :: SearchState -> SearchState -> Bool
$c>= :: SearchState -> SearchState -> Bool
>= :: SearchState -> SearchState -> Bool
$cmax :: SearchState -> SearchState -> SearchState
max :: SearchState -> SearchState -> SearchState
$cmin :: SearchState -> SearchState -> SearchState
min :: SearchState -> SearchState -> SearchState
Ord, ReadPrec [SearchState]
ReadPrec SearchState
Int -> ReadS SearchState
ReadS [SearchState]
(Int -> ReadS SearchState)
-> ReadS [SearchState]
-> ReadPrec SearchState
-> ReadPrec [SearchState]
-> Read SearchState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SearchState
readsPrec :: Int -> ReadS SearchState
$creadList :: ReadS [SearchState]
readList :: ReadS [SearchState]
$creadPrec :: ReadPrec SearchState
readPrec :: ReadPrec SearchState
$creadListPrec :: ReadPrec [SearchState]
readListPrec :: ReadPrec [SearchState]
Read, Int -> SearchState -> ShowS
[SearchState] -> ShowS
SearchState -> String
(Int -> SearchState -> ShowS)
-> (SearchState -> String)
-> ([SearchState] -> ShowS)
-> Show SearchState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchState -> ShowS
showsPrec :: Int -> SearchState -> ShowS
$cshow :: SearchState -> String
show :: SearchState -> String
$cshowList :: [SearchState] -> ShowS
showList :: [SearchState] -> ShowS
Show)

next :: Array Coord Node -> SearchState -> [AStep SearchState]
next :: Array Coord Node -> SearchState -> [AStep SearchState]
next Array Coord Node
grid SearchState{Coord
searchGoal :: SearchState -> Coord
searchHole :: SearchState -> Coord
searchGoal :: Coord
searchHole :: Coord
..} =
  [ SearchState -> Int -> Int -> AStep SearchState
forall a. a -> Int -> Int -> AStep a
AStep (Coord -> Coord -> SearchState
SearchState Coord
newGoal Coord
newHole) Int
1 Int
h
     | Coord
newHole <- Coord -> [Coord]
cardinal Coord
searchHole
     , Node
node <- Array Coord Node -> Coord -> [Node]
forall (a :: * -> * -> *) e i (f :: * -> *).
(IArray a e, Ix i, Alternative f) =>
a i e -> i -> f e
arrIx Array Coord Node
grid Coord
newHole
     , Node -> Int
nodeSize Node
node Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cutoff
     , let newGoal :: Coord
newGoal
             | Coord
searchGoal Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
newHole = Coord
searchHole
             | Bool
otherwise             = Coord
searchGoal

           h :: Int
h = Coord -> Coord -> Int
manhattan Coord
newGoal Coord
origin
             Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Coord -> Coord -> Int
manhattan Coord
newHole Coord
newGoal
             Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ]

toArray :: [(Coord, a)] -> Array Coord a
toArray :: forall a. [(Coord, a)] -> Array Coord a
toArray [(Coord, a)]
xs = (Coord, Coord) -> [(Coord, a)] -> Array Coord a
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
Array.array (Coord, Coord)
bnds [(Coord, a)]
xs
  where
    Just (Coord, Coord)
bnds = [Coord] -> Maybe (Coord, Coord)
forall (f :: * -> *). Foldable f => f Coord -> Maybe (Coord, Coord)
boundingBox (((Coord, a) -> Coord) -> [(Coord, a)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, a) -> Coord
forall a b. (a, b) -> a
fst [(Coord, a)]
xs)