53 lines
2.3 KiB
Haskell
53 lines
2.3 KiB
Haskell
module Commons where
|
||
|
||
import GHC.IO.Handle (isEOF)
|
||
import Data.Set (Set, insert, notMember, empty)
|
||
import Data.Array (Array, listArray)
|
||
import Data.Char (digitToInt)
|
||
import qualified Data.PQueue.Prio.Min as P
|
||
import qualified Data.Map as M
|
||
|
||
|
||
data Direction = North | East | South | West deriving (Ord, Eq, Show)
|
||
type Node = ((Int, Int), Direction, Int)
|
||
type City = Array (Int, Int) Int
|
||
|
||
|
||
parseLine :: String -> [Int]
|
||
parseLine = map digitToInt
|
||
|
||
parseCity :: IO [[Int]]
|
||
parseCity = do done <- isEOF
|
||
if done
|
||
then return []
|
||
else do line <- getLine
|
||
let cityLine = parseLine line
|
||
city <- parseCity
|
||
return (cityLine: city)
|
||
|
||
parse :: IO City
|
||
parse = do city <- parseCity
|
||
return $ listArray ((1, 1), (length city, length $ head city)) $ concat city
|
||
|
||
|
||
astarEstimation :: Node -> Node -> Int
|
||
astarEstimation ((yF, xF), _, _) ((y, x), _, _) = abs (yF - y) + abs (xF - x)
|
||
|
||
astarIteration :: Ord node => (node -> [(node, Int)]) -> (node -> node -> Int) -> node ->
|
||
P.MinPQueue Int (node, Int) -> Set node -> M.Map node Int -> Maybe Int
|
||
astarIteration next estimation goal open closed costs
|
||
| null open = Nothing
|
||
| otherwise = let ((_, (node, cost)), openNoMin) = P.deleteFindMin open
|
||
newClosed = insert node closed
|
||
nextNodes = filter (\ (n, c) -> (n `notMember` closed)
|
||
&& (n `M.notMember` costs || costs M.! n > c + cost)) $ next node
|
||
estNextNodes = map (\ (n, c) -> (n, c + cost, estimation n goal)) nextNodes
|
||
newOpen = foldl (\ open (n, c, e) -> P.insert (c + e) (n, c) open) openNoMin estNextNodes
|
||
newCosts = foldl (\ costs (n, c, _) -> M.insert n c costs) costs estNextNodes
|
||
in if node == goal then Just cost
|
||
else astarIteration next estimation goal newOpen newClosed newCosts
|
||
|
||
astar :: Ord node => node -> node -> (node -> [(node, Int)]) -> (node -> node -> Int) -> Maybe Int
|
||
astar start end next estimation = astarIteration next estimation end (P.singleton (estimation start end) (start, 0))
|
||
empty $ M.singleton start 0
|