{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ToySolver.Graph.ShortestPath
(
Graph
, Edge
, OutEdge
, InEdge
, Fold (..)
, monoid'
, monoid
, unit
, pair
, path
, firstOutEdge
, lastInEdge
, cost
, Path (..)
, pathFrom
, pathTo
, pathCost
, pathEmpty
, pathAppend
, pathEdges
, pathEdgesBackward
, pathEdgesSeq
, pathVertexes
, pathVertexesBackward
, pathVertexesSeq
, pathFold
, pathMin
, bellmanFord
, dijkstra
, floydWarshall
, bellmanFordDetectNegativeCycle
) where
import Control.Monad
import Control.Monad.ST
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Data.Hashable
import qualified Data.HashTable.Class as H
import qualified Data.HashTable.ST.Cuckoo as C
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Heap as Heap
import Data.List (foldl')
import Data.Monoid
import Data.Ord
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.STRef
type Graph cost label = IntMap [OutEdge cost label]
type Vertex = Int
type Edge cost label = (Vertex, Vertex, cost, label)
type OutEdge cost label = (Vertex, cost, label)
type InEdge cost label = (Vertex, cost, label)
data Path cost label
= Empty Vertex
| Singleton (Edge cost label)
| Append (Path cost label) (Path cost label) !cost
deriving (Path cost label -> Path cost label -> Bool
(Path cost label -> Path cost label -> Bool)
-> (Path cost label -> Path cost label -> Bool)
-> Eq (Path cost label)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall cost label.
(Eq cost, Eq label) =>
Path cost label -> Path cost label -> Bool
/= :: Path cost label -> Path cost label -> Bool
$c/= :: forall cost label.
(Eq cost, Eq label) =>
Path cost label -> Path cost label -> Bool
== :: Path cost label -> Path cost label -> Bool
$c== :: forall cost label.
(Eq cost, Eq label) =>
Path cost label -> Path cost label -> Bool
Eq, Int -> Path cost label -> ShowS
[Path cost label] -> ShowS
Path cost label -> String
(Int -> Path cost label -> ShowS)
-> (Path cost label -> String)
-> ([Path cost label] -> ShowS)
-> Show (Path cost label)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall cost label.
(Show cost, Show label) =>
Int -> Path cost label -> ShowS
forall cost label.
(Show cost, Show label) =>
[Path cost label] -> ShowS
forall cost label.
(Show cost, Show label) =>
Path cost label -> String
showList :: [Path cost label] -> ShowS
$cshowList :: forall cost label.
(Show cost, Show label) =>
[Path cost label] -> ShowS
show :: Path cost label -> String
$cshow :: forall cost label.
(Show cost, Show label) =>
Path cost label -> String
showsPrec :: Int -> Path cost label -> ShowS
$cshowsPrec :: forall cost label.
(Show cost, Show label) =>
Int -> Path cost label -> ShowS
Show)
pathFrom :: Path cost label -> Vertex
pathFrom :: Path cost label -> Int
pathFrom (Empty Int
v) = Int
v
pathFrom (Singleton (Int
from,Int
_,cost
_,label
_)) = Int
from
pathFrom (Append Path cost label
p1 Path cost label
_ cost
_) = Path cost label -> Int
forall cost label. Path cost label -> Int
pathFrom Path cost label
p1
pathTo :: Path cost label -> Vertex
pathTo :: Path cost label -> Int
pathTo (Empty Int
v) = Int
v
pathTo (Singleton (Int
_,Int
to,cost
_,label
_)) = Int
to
pathTo (Append Path cost label
_ Path cost label
p2 cost
_) = Path cost label -> Int
forall cost label. Path cost label -> Int
pathTo Path cost label
p2
pathCost :: Num cost => Path cost label -> cost
pathCost :: Path cost label -> cost
pathCost (Empty Int
_) = cost
0
pathCost (Singleton (Int
_,Int
_,cost
c,label
_)) = cost
c
pathCost (Append Path cost label
_ Path cost label
_ cost
c) = cost
c
pathEmpty :: Vertex -> Path cost label
pathEmpty :: Int -> Path cost label
pathEmpty = Int -> Path cost label
forall cost label. Int -> Path cost label
Empty
pathAppend :: (Num cost) => Path cost label -> Path cost label -> Path cost label
pathAppend :: Path cost label -> Path cost label -> Path cost label
pathAppend Path cost label
p1 Path cost label
p2
| Path cost label -> Int
forall cost label. Path cost label -> Int
pathTo Path cost label
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Path cost label -> Int
forall cost label. Path cost label -> Int
pathFrom Path cost label
p2 = String -> Path cost label
forall a. HasCallStack => String -> a
error String
"ToySolver.Graph.ShortestPath.pathAppend: pathTo/pathFrom mismatch"
| Bool
otherwise =
case (Path cost label
p1, Path cost label
p2) of
(Empty Int
_, Path cost label
_) -> Path cost label
p2
(Path cost label
_, Empty Int
_) -> Path cost label
p1
(Path cost label, Path cost label)
_ -> Path cost label -> Path cost label -> cost -> Path cost label
forall cost label.
Path cost label -> Path cost label -> cost -> Path cost label
Append Path cost label
p1 Path cost label
p2 (Path cost label -> cost
forall cost label. Num cost => Path cost label -> cost
pathCost Path cost label
p1 cost -> cost -> cost
forall a. Num a => a -> a -> a
+ Path cost label -> cost
forall cost label. Num cost => Path cost label -> cost
pathCost Path cost label
p2)
pathEdges :: Path cost label -> [Edge cost label]
pathEdges :: Path cost label -> [Edge cost label]
pathEdges Path cost label
p = Path cost label -> [Edge cost label] -> [Edge cost label]
forall cost label.
Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p []
where
f :: Path cost label -> [Edge cost label] -> [Edge cost label]
f (Empty Int
_) [Edge cost label]
xs = [Edge cost label]
xs
f (Singleton Edge cost label
e) [Edge cost label]
xs = Edge cost label
e Edge cost label -> [Edge cost label] -> [Edge cost label]
forall a. a -> [a] -> [a]
: [Edge cost label]
xs
f (Append Path cost label
p1 Path cost label
p2 cost
_) [Edge cost label]
xs = Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p1 (Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p2 [Edge cost label]
xs)
pathEdgesBackward :: Path cost label -> [Edge cost label]
pathEdgesBackward :: Path cost label -> [Edge cost label]
pathEdgesBackward Path cost label
p = Path cost label -> [Edge cost label] -> [Edge cost label]
forall cost label.
Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p []
where
f :: Path cost label -> [Edge cost label] -> [Edge cost label]
f (Empty Int
_) [Edge cost label]
xs = [Edge cost label]
xs
f (Singleton Edge cost label
e) [Edge cost label]
xs = Edge cost label
e Edge cost label -> [Edge cost label] -> [Edge cost label]
forall a. a -> [a] -> [a]
: [Edge cost label]
xs
f (Append Path cost label
p1 Path cost label
p2 cost
_) [Edge cost label]
xs = Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p2 (Path cost label -> [Edge cost label] -> [Edge cost label]
f Path cost label
p1 [Edge cost label]
xs)
pathEdgesSeq :: Path cost label -> Seq (Edge cost label)
pathEdgesSeq :: Path cost label -> Seq (Edge cost label)
pathEdgesSeq (Empty Int
_) = Seq (Edge cost label)
forall a. Seq a
Seq.empty
pathEdgesSeq (Singleton Edge cost label
e) = Edge cost label -> Seq (Edge cost label)
forall a. a -> Seq a
Seq.singleton Edge cost label
e
pathEdgesSeq (Append Path cost label
p1 Path cost label
p2 cost
_) = Path cost label -> Seq (Edge cost label)
forall cost label. Path cost label -> Seq (Edge cost label)
pathEdgesSeq Path cost label
p1 Seq (Edge cost label)
-> Seq (Edge cost label) -> Seq (Edge cost label)
forall a. Semigroup a => a -> a -> a
<> Path cost label -> Seq (Edge cost label)
forall cost label. Path cost label -> Seq (Edge cost label)
pathEdgesSeq Path cost label
p2
pathVertexes :: Path cost label -> [Vertex]
pathVertexes :: Path cost label -> [Int]
pathVertexes Path cost label
p = Path cost label -> Int
forall cost label. Path cost label -> Int
pathFrom Path cost label
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Path cost label -> [Int] -> [Int]
forall cost label. Path cost label -> [Int] -> [Int]
f Path cost label
p []
where
f :: Path cost label -> [Int] -> [Int]
f (Empty Int
_) [Int]
xs = [Int]
xs
f (Singleton (Int
_,Int
v2,cost
_,label
_)) [Int]
xs = Int
v2 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
xs
f (Append Path cost label
p1 Path cost label
p2 cost
_) [Int]
xs = Path cost label -> [Int] -> [Int]
f Path cost label
p1 (Path cost label -> [Int] -> [Int]
f Path cost label
p2 [Int]
xs)
pathVertexesBackward :: Path cost label -> [Vertex]
pathVertexesBackward :: Path cost label -> [Int]
pathVertexesBackward Path cost label
p = Path cost label -> Int
forall cost label. Path cost label -> Int
pathTo Path cost label
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Path cost label -> [Int] -> [Int]
forall cost label. Path cost label -> [Int] -> [Int]
f Path cost label
p []
where
f :: Path cost label -> [Int] -> [Int]
f (Empty Int
_) [Int]
xs = [Int]
xs
f (Singleton (Int
v1,Int
_,cost
_,label
_)) [Int]
xs = Int
v1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
xs
f (Append Path cost label
p1 Path cost label
p2 cost
_) [Int]
xs = Path cost label -> [Int] -> [Int]
f Path cost label
p2 (Path cost label -> [Int] -> [Int]
f Path cost label
p1 [Int]
xs)
pathVertexesSeq :: Path cost label -> Seq Vertex
pathVertexesSeq :: Path cost label -> Seq Int
pathVertexesSeq Path cost label
p = Bool -> Path cost label -> Seq Int
forall cost label. Bool -> Path cost label -> Seq Int
f Bool
True Path cost label
p
where
f :: Bool -> Path cost label -> Seq Int
f Bool
True (Empty Int
v) = Int -> Seq Int
forall a. a -> Seq a
Seq.singleton Int
v
f Bool
False (Empty Int
_) = Seq Int
forall a. Monoid a => a
mempty
f Bool
True (Singleton (Int
v1,Int
v2,cost
_,label
_)) = [Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int
v1, Int
v2]
f Bool
False (Singleton (Int
v1,Int
_,cost
_,label
_)) = Int -> Seq Int
forall a. a -> Seq a
Seq.singleton Int
v1
f Bool
b (Append Path cost label
p1 Path cost label
p2 cost
_) = Bool -> Path cost label -> Seq Int
f Bool
False Path cost label
p1 Seq Int -> Seq Int -> Seq Int
forall a. Semigroup a => a -> a -> a
<> Bool -> Path cost label -> Seq Int
f Bool
b Path cost label
p2
pathMin :: (Num cost, Ord cost) => Path cost label -> Path cost label -> Path cost label
pathMin :: Path cost label -> Path cost label -> Path cost label
pathMin Path cost label
p1 Path cost label
p2
| Path cost label -> cost
forall cost label. Num cost => Path cost label -> cost
pathCost Path cost label
p1 cost -> cost -> Bool
forall a. Ord a => a -> a -> Bool
<= Path cost label -> cost
forall cost label. Num cost => Path cost label -> cost
pathCost Path cost label
p2 = Path cost label
p1
| Bool
otherwise = Path cost label
p2
pathFold :: Fold cost label a -> Path cost label -> a
pathFold :: Fold cost label a -> Path cost label -> a
pathFold (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC a -> a
fD) Path cost label
p = a -> a
fD (Path cost label -> a
h Path cost label
p)
where
h :: Path cost label -> a
h (Empty Int
v) = Int -> a
fV Int
v
h (Singleton Edge cost label
e) = Edge cost label -> a
fE Edge cost label
e
h (Append Path cost label
p1 Path cost label
p2 cost
_) = a -> a -> a
fC (Path cost label -> a
h Path cost label
p1) (Path cost label -> a
h Path cost label
p2)
data Pair a b = Pair !a !b
data Fold cost label r
= forall a. Fold (Vertex -> a) (Edge cost label -> a) (a -> a -> a) (a -> r)
instance Functor (Fold cost label) where
{-# INLINE fmap #-}
fmap :: (a -> b) -> Fold cost label a -> Fold cost label b
fmap a -> b
f (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC a -> a
fD) = (Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> b)
-> Fold cost label b
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC (a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
fD)
instance Applicative (Fold cost label) where
{-# INLINE pure #-}
pure :: a -> Fold cost label a
pure a
a = (Int -> ())
-> (Edge cost label -> ())
-> (() -> () -> ())
-> (() -> a)
-> Fold cost label a
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold (\Int
_ -> ()) (\Edge cost label
_ -> ()) (\()
_ ()
_ -> ()) (a -> () -> a
forall a b. a -> b -> a
const a
a)
{-# INLINE (<*>) #-}
Fold Int -> a
fV1 Edge cost label -> a
fE1 a -> a -> a
fC1 a -> a -> b
fD1 <*> :: Fold cost label (a -> b) -> Fold cost label a -> Fold cost label b
<*> Fold Int -> a
fV2 Edge cost label -> a
fE2 a -> a -> a
fC2 a -> a
fD2 =
(Int -> Pair a a)
-> (Edge cost label -> Pair a a)
-> (Pair a a -> Pair a a -> Pair a a)
-> (Pair a a -> b)
-> Fold cost label b
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold (\Int
v -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (Int -> a
fV1 Int
v) (Int -> a
fV2 Int
v))
(\Edge cost label
e -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (Edge cost label -> a
fE1 Edge cost label
e) (Edge cost label -> a
fE2 Edge cost label
e))
(\(Pair a
a1 a
b1) (Pair a
a2 a
b2) -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (a -> a -> a
fC1 a
a1 a
a2) (a -> a -> a
fC2 a
b1 a
b2))
(\(Pair a
a a
b) -> a -> a -> b
fD1 a
a (a -> a
fD2 a
b))
monoid' :: Monoid m => (Edge cost label -> m) -> Fold cost label m
monoid' :: (Edge cost label -> m) -> Fold cost label m
monoid' Edge cost label -> m
f = (Int -> m)
-> (Edge cost label -> m)
-> (m -> m -> m)
-> (m -> m)
-> Fold cost label m
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold (\Int
_ -> m
forall a. Monoid a => a
mempty) Edge cost label -> m
f m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m -> m
forall a. a -> a
id
monoid :: Monoid m => Fold cost m m
monoid :: Fold cost m m
monoid = (Edge cost m -> m) -> Fold cost m m
forall m cost label.
Monoid m =>
(Edge cost label -> m) -> Fold cost label m
monoid' (\(Int
_,Int
_,cost
_,m
m) -> m
m)
unit :: Fold cost label ()
unit :: Fold cost label ()
unit = (Edge cost label -> ()) -> Fold cost label ()
forall m cost label.
Monoid m =>
(Edge cost label -> m) -> Fold cost label m
monoid' (\Edge cost label
_ -> ())
pair :: Fold cost label a -> Fold cost label b -> Fold cost label (a,b)
pair :: Fold cost label a -> Fold cost label b -> Fold cost label (a, b)
pair (Fold Int -> a
fV1 Edge cost label -> a
fE1 a -> a -> a
fC1 a -> a
fD1) (Fold Int -> a
fV2 Edge cost label -> a
fE2 a -> a -> a
fC2 a -> b
fD2) =
(Int -> Pair a a)
-> (Edge cost label -> Pair a a)
-> (Pair a a -> Pair a a -> Pair a a)
-> (Pair a a -> (a, b))
-> Fold cost label (a, b)
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold (\Int
v -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (Int -> a
fV1 Int
v) (Int -> a
fV2 Int
v))
(\Edge cost label
e -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (Edge cost label -> a
fE1 Edge cost label
e) (Edge cost label -> a
fE2 Edge cost label
e))
(\(Pair a
a1 a
b1) (Pair a
a2 a
b2) -> a -> a -> Pair a a
forall a b. a -> b -> Pair a b
Pair (a -> a -> a
fC1 a
a1 a
a2) (a -> a -> a
fC2 a
b1 a
b2))
(\(Pair a
a a
b) -> (a -> a
fD1 a
a, a -> b
fD2 a
b))
path :: (Num cost) => Fold cost label (Path cost label)
path :: Fold cost label (Path cost label)
path = (Int -> Path cost label)
-> (Edge cost label -> Path cost label)
-> (Path cost label -> Path cost label -> Path cost label)
-> (Path cost label -> Path cost label)
-> Fold cost label (Path cost label)
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold Int -> Path cost label
forall cost label. Int -> Path cost label
pathEmpty Edge cost label -> Path cost label
forall cost label. Edge cost label -> Path cost label
Singleton Path cost label -> Path cost label -> Path cost label
forall cost label.
Num cost =>
Path cost label -> Path cost label -> Path cost label
pathAppend Path cost label -> Path cost label
forall a. a -> a
id
cost :: Num cost => Fold cost label cost
cost :: Fold cost label cost
cost = (Int -> cost)
-> (Edge cost label -> cost)
-> (cost -> cost -> cost)
-> (cost -> cost)
-> Fold cost label cost
forall cost label r a.
(Int -> a)
-> (Edge cost label -> a)
-> (a -> a -> a)
-> (a -> r)
-> Fold cost label r
Fold (\Int
_ -> cost
0) (\(Int
_,Int
_,cost
c,label
_) -> cost
c) cost -> cost -> cost
forall a. Num a => a -> a -> a
(+) cost -> cost
forall a. a -> a
id
firstOutEdge :: Fold cost label (First (OutEdge cost label))
firstOutEdge :: Fold cost label (First (OutEdge cost label))
firstOutEdge = (Edge cost label -> First (OutEdge cost label))
-> Fold cost label (First (OutEdge cost label))
forall m cost label.
Monoid m =>
(Edge cost label -> m) -> Fold cost label m
monoid' (\(Int
_,Int
v,cost
c,label
l) -> Maybe (OutEdge cost label) -> First (OutEdge cost label)
forall a. Maybe a -> First a
First (OutEdge cost label -> Maybe (OutEdge cost label)
forall a. a -> Maybe a
Just (Int
v,cost
c,label
l)))
lastInEdge :: Fold cost label (Last (InEdge cost label))
lastInEdge :: Fold cost label (Last (InEdge cost label))
lastInEdge = (Edge cost label -> Last (InEdge cost label))
-> Fold cost label (Last (InEdge cost label))
forall m cost label.
Monoid m =>
(Edge cost label -> m) -> Fold cost label m
monoid' (\(Int
v,Int
_,cost
c,label
l) -> Maybe (InEdge cost label) -> Last (InEdge cost label)
forall a. Maybe a -> Last a
Last (InEdge cost label -> Maybe (InEdge cost label)
forall a. a -> Maybe a
Just (Int
v,cost
c,label
l)))
bellmanFord
:: Real cost
=> Fold cost label a
-> Graph cost label
-> [Vertex]
-> IntMap (cost, a)
bellmanFord :: Fold cost label a -> Graph cost label -> [Int] -> IntMap (cost, a)
bellmanFord (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC a -> a
fD) Graph cost label
g [Int]
ss = (forall s. ST s (IntMap (cost, a))) -> IntMap (cost, a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (IntMap (cost, a))) -> IntMap (cost, a))
-> (forall s. ST s (IntMap (cost, a))) -> IntMap (cost, a)
forall a b. (a -> b) -> a -> b
$ do
let n :: Int
n = Graph cost label -> Int
forall a. IntMap a -> Int
IntMap.size Graph cost label
g
HashTable s Int (Pair cost a)
d <- Int -> ST s (HashTable s Int (Pair cost a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
n
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
ss ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
s -> HashTable s Int (Pair cost a) -> Int -> Pair cost a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s Int (Pair cost a)
d Int
s (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair cost
0 (Int -> a
fV Int
s))
STRef s IntSet
updatedRef <- IntSet -> ST s (STRef s IntSet)
forall a s. a -> ST s (STRef s a)
newSTRef ([Int] -> IntSet
IntSet.fromList [Int]
ss)
Either () ()
_ <- ExceptT () (ST s) () -> ST s (Either () ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT () (ST s) () -> ST s (Either () ()))
-> ExceptT () (ST s) () -> ST s (Either () ())
forall a b. (a -> b) -> a -> b
$ Int -> ExceptT () (ST s) () -> ExceptT () (ST s) ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (ExceptT () (ST s) () -> ExceptT () (ST s) ())
-> ExceptT () (ST s) () -> ExceptT () (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
IntSet
us <- ST s IntSet -> ExceptT () (ST s) IntSet
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s IntSet -> ExceptT () (ST s) IntSet)
-> ST s IntSet -> ExceptT () (ST s) IntSet
forall a b. (a -> b) -> a -> b
$ STRef s IntSet -> ST s IntSet
forall s a. STRef s a -> ST s a
readSTRef STRef s IntSet
updatedRef
Bool -> ExceptT () (ST s) () -> ExceptT () (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IntSet -> Bool
IntSet.null IntSet
us) (ExceptT () (ST s) () -> ExceptT () (ST s) ())
-> ExceptT () (ST s) () -> ExceptT () (ST s) ()
forall a b. (a -> b) -> a -> b
$ () -> ExceptT () (ST s) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ()
ST s () -> ExceptT () (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> ExceptT () (ST s) ())
-> ST s () -> ExceptT () (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
STRef s IntSet -> IntSet -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s IntSet
updatedRef IntSet
IntSet.empty
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntSet -> [Int]
IntSet.toList IntSet
us) ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
u -> do
Just (Pair cost
du a
a) <- HashTable s Int (Pair cost a) -> Int -> ST s (Maybe (Pair cost a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s Int (Pair cost a)
d Int
u
[OutEdge cost label] -> (OutEdge cost label -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([OutEdge cost label]
-> Int -> Graph cost label -> [OutEdge cost label]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
u Graph cost label
g) ((OutEdge cost label -> ST s ()) -> ST s ())
-> (OutEdge cost label -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
v, cost
c, label
l) -> do
Maybe (Pair cost a)
m <- HashTable s Int (Pair cost a) -> Int -> ST s (Maybe (Pair cost a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s Int (Pair cost a)
d Int
v
case Maybe (Pair cost a)
m of
Just (Pair cost
c0 a
_) | cost
c0 cost -> cost -> Bool
forall a. Ord a => a -> a -> Bool
<= cost
du cost -> cost -> cost
forall a. Num a => a -> a -> a
+ cost
c -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe (Pair cost a)
_ -> do
HashTable s Int (Pair cost a) -> Int -> Pair cost a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s Int (Pair cost a)
d Int
v (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair (cost
du cost -> cost -> cost
forall a. Num a => a -> a -> a
+ cost
c) (a
a a -> a -> a
`fC` Edge cost label -> a
fE (Int
u,Int
v,cost
c,label
l)))
STRef s IntSet -> (IntSet -> IntSet) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s IntSet
updatedRef (Int -> IntSet -> IntSet
IntSet.insert Int
v)
(IntMap (Pair cost a) -> IntMap (cost, a))
-> ST s (IntMap (Pair cost a)) -> ST s (IntMap (cost, a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Pair cost a -> (cost, a))
-> IntMap (Pair cost a) -> IntMap (cost, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair cost
c a
x) -> (cost
c, a -> a
fD a
x))) (ST s (IntMap (Pair cost a)) -> ST s (IntMap (cost, a)))
-> ST s (IntMap (Pair cost a)) -> ST s (IntMap (cost, a))
forall a b. (a -> b) -> a -> b
$ HashTable s Int (Pair cost a) -> ST s (IntMap (Pair cost a))
forall (h :: * -> * -> * -> *) s v.
HashTable h =>
h s Int v -> ST s (IntMap v)
freezeHashTable HashTable s Int (Pair cost a)
d
freezeHashTable :: H.HashTable h => h s Int v -> ST s (IntMap v)
freezeHashTable :: h s Int v -> ST s (IntMap v)
freezeHashTable h s Int v
h = (IntMap v -> (Int, v) -> ST s (IntMap v))
-> IntMap v -> h s Int v -> ST s (IntMap v)
forall (h :: * -> * -> * -> *) a k v s.
HashTable h =>
(a -> (k, v) -> ST s a) -> a -> h s k v -> ST s a
H.foldM (\IntMap v
m (Int
k,v
v) -> IntMap v -> ST s (IntMap v)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap v -> ST s (IntMap v)) -> IntMap v -> ST s (IntMap v)
forall a b. (a -> b) -> a -> b
$! Int -> v -> IntMap v -> IntMap v
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k v
v IntMap v
m) IntMap v
forall a. IntMap a
IntMap.empty h s Int v
h
bellmanFordDetectNegativeCycle
:: forall cost label a. Real cost
=> Fold cost label a
-> Graph cost label
-> IntMap (cost, Last (InEdge cost label))
-> Maybe a
bellmanFordDetectNegativeCycle :: Fold cost label a
-> Graph cost label
-> IntMap (cost, Last (InEdge cost label))
-> Maybe a
bellmanFordDetectNegativeCycle (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC a -> a
fD) Graph cost label
g IntMap (cost, Last (InEdge cost label))
d = (a -> Maybe a) -> (() -> Maybe a) -> Either a () -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
fD) (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (Either a () -> Maybe a) -> Either a () -> Maybe a
forall a b. (a -> b) -> a -> b
$ do
[(Int, (cost, Last (InEdge cost label)))]
-> ((Int, (cost, Last (InEdge cost label))) -> Either a ())
-> Either a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntMap (cost, Last (InEdge cost label))
-> [(Int, (cost, Last (InEdge cost label)))]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (cost, Last (InEdge cost label))
d) (((Int, (cost, Last (InEdge cost label))) -> Either a ())
-> Either a ())
-> ((Int, (cost, Last (InEdge cost label))) -> Either a ())
-> Either a ()
forall a b. (a -> b) -> a -> b
$ \(Int
u,(cost
du,Last (InEdge cost label)
_)) ->
[InEdge cost label]
-> (InEdge cost label -> Either a ()) -> Either a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([InEdge cost label]
-> Int -> Graph cost label -> [InEdge cost label]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
u Graph cost label
g) ((InEdge cost label -> Either a ()) -> Either a ())
-> (InEdge cost label -> Either a ()) -> Either a ()
forall a b. (a -> b) -> a -> b
$ \(Int
v, cost
c, label
l) -> do
let (cost
dv,Last (InEdge cost label)
_) = IntMap (cost, Last (InEdge cost label))
d IntMap (cost, Last (InEdge cost label))
-> Int -> (cost, Last (InEdge cost label))
forall a. IntMap a -> Int -> a
IntMap.! Int
v
Bool -> Either a () -> Either a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (cost
du cost -> cost -> cost
forall a. Num a => a -> a -> a
+ cost
c cost -> cost -> Bool
forall a. Ord a => a -> a -> Bool
< cost
dv) (Either a () -> Either a ()) -> Either a () -> Either a ()
forall a b. (a -> b) -> a -> b
$ do
let d' :: IntMap (cost, Last (InEdge cost label))
d' = Int
-> (cost, Last (InEdge cost label))
-> IntMap (cost, Last (InEdge cost label))
-> IntMap (cost, Last (InEdge cost label))
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
v (cost
du cost -> cost -> cost
forall a. Num a => a -> a -> a
+ cost
c, Maybe (InEdge cost label) -> Last (InEdge cost label)
forall a. Maybe a -> Last a
Last (InEdge cost label -> Maybe (InEdge cost label)
forall a. a -> Maybe a
Just (Int
u, cost
c, label
l))) IntMap (cost, Last (InEdge cost label))
d
parent :: Int -> Int
parent Int
u = do
case Int
-> IntMap (cost, Last (InEdge cost label))
-> Maybe (cost, Last (InEdge cost label))
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
u IntMap (cost, Last (InEdge cost label))
d' of
Just (cost
_, Last (Just (Int
v,cost
_,label
_))) -> Int
v
Maybe (cost, Last (InEdge cost label))
_ -> Int
forall a. HasCallStack => a
undefined
u0 :: Int
u0 = Int -> Int -> Int
go (Int -> Int
parent (Int -> Int
parent Int
v)) (Int -> Int
parent Int
v)
where
go :: Int -> Int -> Int
go Int
hare Int
tortoise
| Int
hare Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tortoise = Int
hare
| Bool
otherwise = Int -> Int -> Int
go (Int -> Int
parent (Int -> Int
parent Int
hare)) (Int -> Int
parent Int
tortoise)
let go :: Int -> a -> a
go Int
u a
result = do
let Just (cost
_, Last (Just (Int
v,cost
c,label
l))) = Int
-> IntMap (cost, Last (InEdge cost label))
-> Maybe (cost, Last (InEdge cost label))
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
u IntMap (cost, Last (InEdge cost label))
d'
if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u0 then
a -> a -> a
fC (Edge cost label -> a
fE (Int
v,Int
u,cost
c,label
l)) a
result
else
Int -> a -> a
go Int
v (a -> a -> a
fC (Edge cost label -> a
fE (Int
v,Int
u,cost
c,label
l)) a
result)
a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
go Int
u0 (Int -> a
fV Int
u0)
dijkstra
:: forall cost label a. Real cost
=> Fold cost label a
-> Graph cost label
-> [Vertex]
-> IntMap (cost, a)
dijkstra :: Fold cost label a -> Graph cost label -> [Int] -> IntMap (cost, a)
dijkstra (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC (a -> a
fD :: x -> a)) Graph cost label
g [Int]
ss =
(Pair cost a -> (cost, a))
-> IntMap (Pair cost a) -> IntMap (cost, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair cost
c a
x) -> (cost
c, a -> a
fD a
x)) (IntMap (Pair cost a) -> IntMap (cost, a))
-> IntMap (Pair cost a) -> IntMap (cost, a)
forall a b. (a -> b) -> a -> b
$
Heap (Entry cost (Pair Int a))
-> IntMap (Pair cost a) -> IntMap (Pair cost a)
loop ([Entry cost (Pair Int a)] -> Heap (Entry cost (Pair Int a))
forall a. Ord a => [a] -> Heap a
Heap.fromList [cost -> Pair Int a -> Entry cost (Pair Int a)
forall p a. p -> a -> Entry p a
Heap.Entry cost
0 (Int -> a -> Pair Int a
forall a b. a -> b -> Pair a b
Pair Int
s (Int -> a
fV Int
s)) | Int
s <- [Int]
ss]) IntMap (Pair cost a)
forall a. IntMap a
IntMap.empty
where
loop
:: Heap.Heap (Heap.Entry cost (Pair Vertex x))
-> IntMap (Pair cost x)
-> IntMap (Pair cost x)
loop :: Heap (Entry cost (Pair Int a))
-> IntMap (Pair cost a) -> IntMap (Pair cost a)
loop Heap (Entry cost (Pair Int a))
q IntMap (Pair cost a)
visited =
case Heap (Entry cost (Pair Int a))
-> Maybe (Entry cost (Pair Int a), Heap (Entry cost (Pair Int a)))
forall a. Heap a -> Maybe (a, Heap a)
Heap.viewMin Heap (Entry cost (Pair Int a))
q of
Maybe (Entry cost (Pair Int a), Heap (Entry cost (Pair Int a)))
Nothing -> IntMap (Pair cost a)
visited
Just (Heap.Entry cost
c (Pair Int
v a
a), Heap (Entry cost (Pair Int a))
q')
| Int
v Int -> IntMap (Pair cost a) -> Bool
forall a. Int -> IntMap a -> Bool
`IntMap.member` IntMap (Pair cost a)
visited -> Heap (Entry cost (Pair Int a))
-> IntMap (Pair cost a) -> IntMap (Pair cost a)
loop Heap (Entry cost (Pair Int a))
q' IntMap (Pair cost a)
visited
| Bool
otherwise ->
let q2 :: Heap (Entry cost (Pair Int a))
q2 = [Entry cost (Pair Int a)] -> Heap (Entry cost (Pair Int a))
forall a. Ord a => [a] -> Heap a
Heap.fromList
[ cost -> Pair Int a -> Entry cost (Pair Int a)
forall p a. p -> a -> Entry p a
Heap.Entry (cost
ccost -> cost -> cost
forall a. Num a => a -> a -> a
+cost
c') (Int -> a -> Pair Int a
forall a b. a -> b -> Pair a b
Pair Int
ch (a
a a -> a -> a
`fC` Edge cost label -> a
fE (Int
v,Int
ch,cost
c',label
l)))
| (Int
ch,cost
c',label
l) <- [(Int, cost, label)]
-> Int -> Graph cost label -> [(Int, cost, label)]
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault [] Int
v Graph cost label
g
, Bool -> Bool
not (Int
ch Int -> IntMap (Pair cost a) -> Bool
forall a. Int -> IntMap a -> Bool
`IntMap.member` IntMap (Pair cost a)
visited)
]
in Heap (Entry cost (Pair Int a))
-> IntMap (Pair cost a) -> IntMap (Pair cost a)
loop (Heap (Entry cost (Pair Int a))
-> Heap (Entry cost (Pair Int a)) -> Heap (Entry cost (Pair Int a))
forall a. Heap a -> Heap a -> Heap a
Heap.union Heap (Entry cost (Pair Int a))
q' Heap (Entry cost (Pair Int a))
q2) (Int -> Pair cost a -> IntMap (Pair cost a) -> IntMap (Pair cost a)
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
v (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair cost
c a
a) IntMap (Pair cost a)
visited)
floydWarshall
:: forall cost label a. Real cost
=> Fold cost label a
-> Graph cost label
-> IntMap (IntMap (cost, a))
floydWarshall :: Fold cost label a -> Graph cost label -> IntMap (IntMap (cost, a))
floydWarshall (Fold Int -> a
fV Edge cost label -> a
fE a -> a -> a
fC (a -> a
fD :: x -> a)) Graph cost label
g =
(IntMap (Pair cost a) -> IntMap (cost, a))
-> IntMap (IntMap (Pair cost a)) -> IntMap (IntMap (cost, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pair cost a -> (cost, a))
-> IntMap (Pair cost a) -> IntMap (cost, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pair cost
c a
x) -> (cost
c, a -> a
fD a
x))) (IntMap (IntMap (Pair cost a)) -> IntMap (IntMap (cost, a)))
-> IntMap (IntMap (Pair cost a)) -> IntMap (IntMap (cost, a))
forall a b. (a -> b) -> a -> b
$
(IntMap (Pair cost a)
-> IntMap (Pair cost a) -> IntMap (Pair cost a))
-> IntMap (IntMap (Pair cost a))
-> IntMap (IntMap (Pair cost a))
-> IntMap (IntMap (Pair cost a))
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith ((Pair cost a -> Pair cost a -> Pair cost a)
-> IntMap (Pair cost a)
-> IntMap (Pair cost a)
-> IntMap (Pair cost a)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Pair cost a -> Pair cost a -> Pair cost a
minP) ((IntMap (IntMap (Pair cost a))
-> Int -> IntMap (IntMap (Pair cost a)))
-> IntMap (IntMap (Pair cost a))
-> [Int]
-> IntMap (IntMap (Pair cost a))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntMap (IntMap (Pair cost a))
-> Int -> IntMap (IntMap (Pair cost a))
f IntMap (IntMap (Pair cost a))
tbl0 [Int]
vs) IntMap (IntMap (Pair cost a))
paths0
where
vs :: [Int]
vs = Graph cost label -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys Graph cost label
g
paths0 :: IntMap (IntMap (Pair cost x))
paths0 :: IntMap (IntMap (Pair cost a))
paths0 = (Int -> [OutEdge cost label] -> IntMap (Pair cost a))
-> Graph cost label -> IntMap (IntMap (Pair cost a))
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey (\Int
v [OutEdge cost label]
_ -> Int -> Pair cost a -> IntMap (Pair cost a)
forall a. Int -> a -> IntMap a
IntMap.singleton Int
v (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair cost
0 (Int -> a
fV Int
v))) Graph cost label
g
tbl0 :: IntMap (IntMap (Pair cost x))
tbl0 :: IntMap (IntMap (Pair cost a))
tbl0 = (Int -> [OutEdge cost label] -> IntMap (Pair cost a))
-> Graph cost label -> IntMap (IntMap (Pair cost a))
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey (\Int
v [OutEdge cost label]
es -> (Pair cost a -> Pair cost a -> Pair cost a)
-> [(Int, Pair cost a)] -> IntMap (Pair cost a)
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith Pair cost a -> Pair cost a -> Pair cost a
minP [(Int
u, (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair cost
c (Edge cost label -> a
fE (Int
v,Int
u,cost
c,label
l)))) | (Int
u,cost
c,label
l) <- [OutEdge cost label]
es]) Graph cost label
g
minP :: Pair cost x -> Pair cost x -> Pair cost x
minP :: Pair cost a -> Pair cost a -> Pair cost a
minP = (Pair cost a -> Pair cost a -> Ordering)
-> Pair cost a -> Pair cost a -> Pair cost a
forall a. (a -> a -> Ordering) -> a -> a -> a
minBy ((Pair cost a -> cost) -> Pair cost a -> Pair cost a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Pair cost
c a
_) -> cost
c))
f :: IntMap (IntMap (Pair cost x))
-> Vertex
-> IntMap (IntMap (Pair cost x))
f :: IntMap (IntMap (Pair cost a))
-> Int -> IntMap (IntMap (Pair cost a))
f IntMap (IntMap (Pair cost a))
tbl Int
vk =
case Int
-> IntMap (IntMap (Pair cost a)) -> Maybe (IntMap (Pair cost a))
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
vk IntMap (IntMap (Pair cost a))
tbl of
Maybe (IntMap (Pair cost a))
Nothing -> IntMap (IntMap (Pair cost a))
tbl
Just IntMap (Pair cost a)
hk -> (IntMap (Pair cost a) -> IntMap (Pair cost a))
-> IntMap (IntMap (Pair cost a)) -> IntMap (IntMap (Pair cost a))
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map IntMap (Pair cost a) -> IntMap (Pair cost a)
h IntMap (IntMap (Pair cost a))
tbl
where
h :: IntMap (Pair cost x) -> IntMap (Pair cost x)
h :: IntMap (Pair cost a) -> IntMap (Pair cost a)
h IntMap (Pair cost a)
m =
case Int -> IntMap (Pair cost a) -> Maybe (Pair cost a)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
vk IntMap (Pair cost a)
m of
Maybe (Pair cost a)
Nothing -> IntMap (Pair cost a)
m
Just (Pair cost
c1 a
x1) -> (Pair cost a -> Pair cost a -> Pair cost a)
-> IntMap (Pair cost a)
-> IntMap (Pair cost a)
-> IntMap (Pair cost a)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Pair cost a -> Pair cost a -> Pair cost a
minP IntMap (Pair cost a)
m ((Pair cost a -> Pair cost a)
-> IntMap (Pair cost a) -> IntMap (Pair cost a)
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (\(Pair cost
c2 a
x2) -> (cost -> a -> Pair cost a
forall a b. a -> b -> Pair a b
Pair (cost
c1cost -> cost -> cost
forall a. Num a => a -> a -> a
+cost
c2) (a -> a -> a
fC a
x1 a
x2))) IntMap (Pair cost a)
hk)
minBy :: (a -> a -> Ordering) -> a -> a -> a
minBy :: (a -> a -> Ordering) -> a -> a -> a
minBy a -> a -> Ordering
f a
a a
b =
case a -> a -> Ordering
f a
a a
b of
Ordering
LT -> a
a
Ordering
EQ -> a
a
Ordering
GT -> a
b