[Haskell-cafe] Newb: List of nodes in a graph - is there a prettier
way?
Torsten Otto
t-otto-news at gmx.de
Fri Sep 28 18:49:05 EDT 2007
Howdy,
I'm working towards Dijkstra's algorithm here and I have a feeling
that I could do without the helper function nodesInternal in the
following code, if I only could figure out how. Any hints would be
appreciated.
nodes::Graph->[Id] should (and actually does) return a list of all
nodes in the graph.
Thanks a bunch in advance.
Regards,
Torsten Otto
>module Route where
Datatypes for the representation of the graph:
>type Id = Int
>type Weight = Int
>type Edge = (Id,Id)
>type Graph = [ (Edge, Weight) ]
>graph::Graph
>graph = [ ((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)]
>data Cost = Finite Weight | Infinity
> deriving (Eq, Ord, Show)
>type PathCost = (Cost, Id)
Return the number of edges in the graph:
>edges :: Graph -> Int
>edges graph = length graph
Calculate the sum of all weights:
>weightTotal::Graph -> Weight
>weightTotal ((edge, weight):xs)| xs == [] = weight
> | otherwise = weight + (weightTotal xs)
List all the nodes in the graph:
>nodes::Graph -> [Id]
>nodes graph = nodesInternal [] graph
>nodesInternal::[Id]->Graph->[Id]
>nodesInternal list (((id1,id2),weight):xs)
> | (elem id1 list) && (elem id2 list) = nodesInternal list xs
> | (elem id1 list) && (not (elem id2 list)) = nodesInternal
(id2:list) xs
> | (not (elem id1 list)) && (elem id2 list) = nodesInternal
(id1:list) xs
> | (not (elem id1 list)) && (not (elem id2 list)) = nodesInternal
(id1:id2:list) xs
>nodesInternal list [] = list
Function for adding costs so that we can make use of Infinity for
impossible routes:
>addCosts::Cost -> Cost -> Cost
>addCosts Infinity Infinity = Infinity
>addCosts Infinity (Finite x) = Infinity
>addCosts (Finite x) Infinity = Infinity
>addCosts (Finite x) (Finite y) = Finite (x + y)
Return the cost of a given edge:
>lookUp::Edge -> Graph -> Cost
>lookUp (id1,id2) (((id1x,id2x),weightx):xs)
> | (id1==id1x && id2==id2x) = Finite weightx
> | xs==[] = Infinity
> | otherwise = lookUp (id1,id2) xs
More information about the Haskell-Cafe
mailing list