Computer Science Canada

[Haskell] Single Source All Paths

Author:  Lazy [ Tue Nov 14, 2006 3:13 pm ]
Post subject:  [Haskell] Single Source All Paths

Hi all,

This is a little program I put together to practice Haskell. The specs can be found here: http://www.doc.ic.ac.uk/~ajf/Teaching/Haskell/sampleTest2.pdf, although I deviated a little from the assignment.

It's far from perfect. The instance declaration of Finite is incomplete, and I feel that some things can be done more elegantly. Time permiting, I'll try to rewrite it as a State monad, to carry around the graph.

All comments and advice are appreciated.

code:
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 ) ]


Author:  Tyr_God_Of_War [ Sun Apr 24, 2011 9:48 am ]
Post subject:  RE:[Haskell] Single Source All Paths

The pdf is gone, could you state the problem here?

Author:  apython1992 [ Sun Apr 24, 2011 3:26 pm ]
Post subject:  RE:[Haskell] Single Source All Paths

Um...that post is about five years old.


: