[Haskell-cafe] Re: functional graphs

Mirko Rahn rahn at ira.uka.de
Mon Jan 21 11:21:07 EST 2008


Hello,

> It's a _complete_ graph, i.e. there is an edge between every two nodes.

> I want to compute the minimum spanning tree. Eventually I want to have a sub-optimal solution for the travelling salesman problem (TSP).

A direct solution for this problem would be:

-- | place a f-minimal element to the left, remember the minimal value

min_left :: Ord b => (a -> b) -> [a] -> ([a],b)
min_left _ []     = error "min_left: empty list"
min_left f (x:xs) = ms (x,f x) [] xs $ map f xs
   where ms (y,v) nonmin (z:zs) (w:ws)
           | w < v            = ms (z,w) (y:nonmin) zs ws
           | otherwise        = ms (y,v) (z:nonmin) zs ws
         ms (y,v) nonmin _ _  = (y:nonmin,v)

-- | the same for cross xs ys and a f with arity two

mins :: Ord c => (a -> b -> c) -> [a] -> [b] -> [(a, ([b],c))]
mins f xs ys =
   fst $ min_left (snd . snd) [(x,min_left (f x) ys) | x <- xs]

-- | *complete* graph

data CGraph a b = CGraph [a] (a -> a -> b)

-- | give a list of edges with weight that form a minimal spanning tree

prim :: Ord b => CGraph a b -> [(a,a,b)]
prim (CGraph [] _) = []
prim (CGraph (x:xs) w) = build [x] xs
   where build _ [] = []
         build seen open =
           let (f,(t:rest,v)):_ = mins w seen open
           in (f,t,v) : build (t:seen) rest

-- | calculate the complete round trip and its (accumulated) weight

round_trip :: (Eq a, Ord b, Num b) => CGraph a b -> [(a,a,b,b)]
round_trip = rt 0 [] . prim
  where
   rt _ []             []           = []
   rt s ((c,r,v):bs)   []           = (c,r,v,s+v) : rt (s+v) bs []
   rt s []             ((r,c,v):ys) = (r,c,v,s+v) : rt (s+v) [(c,r,v)] ys
   rt s (b@(z,t,w):bs) ((r,c,v):ys)
    | r == z    = (r,c,v,s+v) : rt (s+v) ((c,r,v):b:bs)         ys
    | otherwise = (z,t,w,s+w) : rt (s+w)            bs ((r,c,v):ys)


{-
*Main> round_trip $ CGraph [0..5] (\ x y -> mod (x+y) 4)
[(0,4,0,0),(4,5,1,1),(5,3,0,1),(3,1,0,1),(1,3,0,1),(3,2,1,2),(2,3,1,3),(3,5,0,3),(5,4,1,4),(4,0,0,4)]
-}

Have fun!

/BR, Mirko Rahn



More information about the Haskell-Cafe mailing list