import List
type Id = Int
type Weight = Int
type Edge = ( Id, Id )
type Graph = [ ( Edge, Weight ) ]
data Cost = Finite Weight | Infinity
deriving ( Eq, Show )
edge = fst
cost = snd
fromId = ( fst . fst )
toId = ( snd . fst )
instance Num Cost where
Infinity + _ = Infinity
_ + Infinity = Infinity
Finite a + Finite b = Finite ( a + b )
instance Ord Cost where
Infinity <= Infinity = True
Infinity <= Finite _ = False
Finite _ <= Infinity = True
Finite a <= Finite b = a <= b
solve :: Id -> Graph -> [ ( Edge, Cost ) ]
solve s graph = solve' s ( costs s graph ) [] where
solve' :: Id -> [ ( Edge, Cost ) ] -> [ ( Edge, Cost ) ] -> [ ( Edge, Cost ) ]
solve' _ [] n = n
solve' s c acc = solve' s c' acc' where
minp = cheapest c
restp = delete minp c
c' = map ( \ x -> relax x minp graph ) restp
acc' = minp : acc
allIds :: Graph -> [ Id ]
allIds graph = nub $ concat [ ( [ fromId g ] ++ [ toId g ] ) | g <- graph ]
lookUpCost :: Edge -> Graph -> Cost
lookUpCost edge graph = let found = lookup edge graph in
case found of
Nothing -> Infinity
Just a -> Finite a
costs :: Id -> Graph -> [ ( Edge , Cost ) ]
costs s graph = [ ( ( s, x ), lookUpCost ( s, x ) graph ) | x <- allIds graph ]
cheapest :: [ ( Edge, Cost ) ] -> ( Edge, Cost )
cheapest n = minimumBy ( \ x y -> compare ( cost x ) ( cost y ) ) n
relax :: ( Edge, Cost ) -> ( Edge, Cost ) -> Graph -> ( Edge, Cost )
relax p minp graph = ( edge p, min ( cost p ) transit ) where
transit = lookUpCost (fromId p, toId minp) graph + lookUpCost (toId minp, toId p) graph
-- test data
test :: Graph
test= [ ( ( 0, 1 ), 1 ),
( ( 0, 2 ), 3 ),
( ( 0, 4 ), 6 ),
( ( 1, 2 ), 1 ),
( ( 1, 3 ), 3 ),
( ( 2, 0 ), 1 ),
( ( 2, 1 ), 2 ),
( ( 2, 3 ), 1 ),
( ( 3, 0 ), 3 ),
( ( 3, 4 ), 2 ),
( ( 4, 3 ), 1 ),
( ( 5, 2 ), 9 ) ]
|