I'm trying to understand how to handle calls error in Haskell. For example:
I have this graph
import Data.Map (Map,empty,member,insert,keys,(!))
import Graphviz
-- | A directed graph
data Graph v = Graph
{ arcsMap :: Map v [v] -- A map associating a vertex with its successors
, labelMap :: Map v String -- The Graphviz label of each node
, styleMap :: Map v String -- The Graphviz style of each node
}deriving (Show,Eq, Ord)
And I have the function
-- | Returns the successors of a vertex in a graph in ascending order
--
-- We say that `v` is a successor of `u` in a graph `G` if the arc `(u,v)`
-- belongs to `G`.
--
-- Note: Returns the empty list if the vertex does not belong to the graph.
--
-- >>> successors 1 emptyGraph
-- []
-- >>> successors 1 $ addArc (1,2) emptyGraph
-- [2]
-- >>> successors 1 $ addArcs emptyGraph [(1,2),(2,3),(1,3)]
-- [2,3]
successors :: Ord v => v -> Graph v -> [v]
successors v (Graph arcs labels styles) = arcs ! v
The documentation of the operator (!) says : "O(log n). Find the value at a key. Calls error when the element cannot be found."
I want to return an empty list [] when the element can't be found
How should I handle this ?
Thank you very much.
You can make use of the !? operator (Ord k => Map k a -> k -> Maybe a) here. This will return a Nothing in case the key does not exist, and Just v with v the value in case that exists, as specified by the documentation:
O(log n). Find the value at a key. Returns Nothing when the element can not be found.
Then we still need to convert that to an empty list. We can use fromMaybe :: a -> Maybe a -> a for that, here we first give a "default" value to use in case of a Nothing, and then we pass it a Maybe a. In case it is a Nothing, we use the default, in case it is a Just v, it will return v:
import Data.Map (Map,empty,member,insert,keys,(!?))
import Data.Maybe(fromMaybe)
successors :: Ord v => v -> Graph v -> [v]
successors v (Graph arcs _ _) = fromMaybe [] (arcs !? v)
or as #Bergi says, we can use findWithDefault :: Ord k => a -> k -> Map k a -> a:
import Data.Map (Map,empty,member,insert,keys,findWithDefault)
import Data.Maybe(fromMaybe)
successors :: Ord v => v -> Graph v -> [v]
successors v (Graph arcs _ _) = findWithDefault [] v arcs
Related
As pretext: I have, prior to this, written a function that counts the amount of times a pair of words occur in a text, this function calculates every single pair of words throughout the text.
Like so:
pairCounter = map (\x -> (head x,length x)). groupTuples . sort
This function returns: [((String, String), Int)] The first/second string being word1/2 in the pair, and the Int is how many times this can be found, or the "tally" of the pair if you will.
What I now would like to do is create a function that only returns the "neighbors" to any given word. For instance:
neighbours [(("red","car"),2),(("house","red"),1)] "red"
should return [("car",2),("house",1)] or some reordering of this list.
So basically; we have established all pairs of any given word, but now I want to single out only the neighbors to this word and a tally of its frequency.
So far, I have thought about using filters in this way:
filter (\(x, y) -> x /= c || y /= c)
--^(I have no idea if this is syntax correct but it is just to give myself an idea where to start)
However I find it hard to come up with a way to use filters and also include the tally of my neighbors, my Int argument that is.
One very idiomatic way would be via a list comprehension:
neighbours :: Eq a => [((a, a), b)] -> a -> [(a, b)]
neighbours items query =
[ (neighbor, count)
| ((s1, s2), count) <- items
, (self, neighbor) <- [(s1, s2), (s2, s1)]
, self == query
]
Actually, I'd probably put the arguments in the other order to match conventions used in existing libraries and shorten the names so that it comfortably fits on one line:
neighbours :: Eq a => a -> [((a, a), b)] -> [(a, b)]
neighbours x xs = [(x4, n) | ((x1, x2), n) <- xs, (x3, x4) <- [(x1, x2), (x2, x1)], x3 == x]
I suspect that the part where you don't care about order will come up in other parts of your code, and so additionally I would consider splitting out a part that symmetrizes. This will also be helpful if, later, you decide that pairs that occur in both orders should be normalized and their counts summed or some such thing, because you will only have to change one location to propagate that update to all consumers.
-- (s)ource, (t)arget, (u)ndirected edge, (w)eight, (w)eighted edge(s)
undirected :: [((a, a), b)] -> [((a, a), b)]
undirected ws = [(u, w) | ((s, t), w) <- ws, u <- [(s, t), (t, s)]]
neighbours :: Eq a => a -> [((a, a), b)] -> [(a, b)]
neighbours x xs = [(t, w) | ((s, t), w) <- undirected xs, s == x]
Alternately, you might decide to make the graph undirected from the very beginning.
import qualified Data.Map as M
-- export UPair the type but not UPair the constructor
data UPair a = UPair a a
deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)
-- this is strict. can also make a lazy variant
upair :: Ord a => a -> a -> UPair a
upair a a' = if a < a' then UPair a a' else UPair a' a
pairCounter :: [a] -> M.Map (UPair a) Int
pairCounter as = M.fromListWith (+) $ zipWith (\a a' -> (upair a a', 1)) as (tail as)
For a given word c you thus should retain the items for which the first String, or the second String are equal to c. We should use ((s1, s2), v) as pattern since the outer 2-tuple has as elements a 2-tuple of Strings as first item, and an Int as second item.
We can work with concatMap :: Foldable t => (a -> [b]) -> t a -> [b] and work with a function that will return [(s2, v)] if s1 matches, [(s1, v)] if s2 matches, and the empty list if none of the two elements was a match:
We thus filter with:
neighbors :: (Foldable f, Eq a) -> f ((a, a), b) -> a -> [(a, b)]
neighbors items query = concatMap f items
where f ((s1, s2), v)
| query == s1 = [(s2, v)]
| query == s2 = [(s1, v)]
| otherwise = []
I have a question about how to manipulate a function in Haskell. I have this graph:
import Data.Map (Map,empty,member,insert)
import Graphviz
-- | A directed graph
data Graph v = Graph
{ arcsMap :: Map v [v] -- A map associating a vertex with its successors
, labelMap :: Map v String -- The Graphviz label of each node
, styleMap :: Map v String -- The Graphviz style of each node
}deriving (Show,Eq, Ord)
And I have those functions
-- | Adds a vertex to a graph
addVertex :: Ord v => v -> Graph v -> Graph v
addVertex _ (Graph arcs labels styles)= (Graph arcs labels styles)
addVertex v (Graph arcs labels styles) = Graph (insert v [] arcs) labels styles
-- | Adds vertices to a graph
addVertices :: Ord v => Graph v -> [v] -> Graph v
addVertices (Graph arcs labels styles) [v] = map addVertex [v]
My problem is that I try to send all the vertices of my list to my addVertex function using map. But I do not know how to write it correctly (maybe I'm completely wrong and the map function is a very bad idea).
This is usually done with a "fold" like foldr :: Foldable f => (a -> b -> b) -> b -> f a -> b. Indeed we can add the elements of a list of vertices (or in fact a Foldable f => f of items):
addVertices :: (Foldable f, Ord v) => Graph v -> f v -> Graph v
addVertices g0 = foldr addVertex g0
For a list, you can see foldr as a way to replace the empty list [] with the base element g0, and we replace all "cons" (:) with the function addVertex here. So that means that for a list:
v1 : v2 : v3 : []
or more verbose:
(:) v1 ((:) v2 ((:) v3 []))
we will calculate the result as:
addVertex v1 (addVertex v2 (addVertex v3 g0))
and thus each time add one vertex to the graph.
We can use foldl :: Foldable f => (b -> a -> b) -> b -> f a -> b instead to pass the accumulator left-to-right:
addVertices :: (Foldable f, Ord v) => Graph v -> f v -> Graph v
addVertices g0 = foldl (flip addVertex) g0
Then we will fold the list as:
addVertex v3 (addVertex v2 (addVertex v1 g0))
Since we use a Foldable here, we can add the vertices in all sorts of data structures, like Maybe v, [v], Tree v, etc.
We can here use an η-reduction, and implement the functions as:
addVertices1 :: (Foldable f, Ord v) => Graph v -> f v -> Graph v
addVertices1 = foldr addVertex
addVertices2 :: (Foldable f, Ord v) => Graph v -> f v -> Graph v
addVertices2 = foldl (flip addVertex)
for an exercise I need to reverse a graph (reverse all edges), but I don't get anywhere.
So I need some help.
I am aware you might not want to solve the exercise for me, so that's not what I am asking for. I just need to get some advice...
So to get to it:
data Graph a = G
{ nodes :: [a]
, successors :: a -> [a] }
reverseGraph :: Eq a => Graph a -> Graph a
A graph has to parameters: a list of nodes and a function that defines the successors. This function has the type:
a -> [a]
for example:
graph1 :: Graph Int
graph1 = G [1..6] $ \case 1 -> [2,3]
2 -> []
3 -> [1,4,6]
4 -> [1]
5 -> [3,5]
6 -> [2,4,5]
the reversed graph would be:
reverseGraph graph1 ~>
2 -> [1,6]
3 -> [1,5]
1 -> [3,4]
4 -> [3,6]
6 -> [3]
5 -> [5,6]
I get that I need to check for each node in the input graph the successors and add for each the input node to the new successor list of the output node.
But i just don't get how to do this in Haskell.
Any help is appreciated!
Here is my solution for anyone who may attempt something similar:
reverseGraph :: Eq a => Graph a -> Graph a
reverseGraph (G nodes sucs) = (G nodes sucs') where
sucs' a = getVert a nodes sucs
--Makes a list of all occurrences of v in the succeccor list.
getVert :: Eq a => a -> [a] -> (a-> [a]) -> [a]
getVert v [] succs = []
getVert v (n:ns) succs = if v `elem` succs n then [n]++getVert v ns succs else getVert v ns succs
Here's a hint. Let's consider the reverse of G vertices edges.
That will be of the form G vertices' edges'.
It's obvious that vertices' = vertices.
What about edges'? Well, for any value v, edges' v must return
"the list of all the w in vertices such that edge w contains v as an element"
You can translate the above English description into Haskell code using a list comprehension. You can use x `elem` list to check whether x is an element of list.
In Haskell's Functional Graph Library (FGL), most of the graph algorithms depend on the 'match' function, which, given a Node n and a Graph g, returns c & g', where c is the Context of the n, and g' is the rest of the graph (which contains no references to n).
The only way I can see of doing this is be examining each of the contexts in g and removing any edges which refer to n and adding them to the context c. This would take linear time, I believe.
Martin Erwig, who wrote the library, suggests in this paper that this transformation can be done in constant or at least sub-linear time. Can anyone explain to me how this is accomplished?
match is defined in the Graph typeclass, so the implementation of that function depends on the datatype that implements the typeclass.
The package comes with two implementations, one using Patricia trees, one using regular trees. You can view the source for either yourself.
For example, the Patricia tree implementation:
import Data.Graph.Inductive.Graph
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.List
import Data.Maybe
import Control.Arrow(second)
newtype Gr a b = Gr (GraphRep a b)
type GraphRep a b = IntMap (Context' a b)
type Context' a b = (IntMap [b], a, IntMap [b])
type UGr = Gr () ()
instance Graph Gr where
-- ...
match = matchGr
-- ...
matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr node (Gr g)
= case IM.lookup node g of
Nothing
-> (Nothing, Gr g)
Just (p, label, s)
-> let !g1 = IM.delete node g
!p' = IM.delete node p
!s' = IM.delete node s
!g2 = clearPred g1 node (IM.keys s')
!g3 = clearSucc g2 node (IM.keys p')
in
(Just (toAdj p', node, label, toAdj s), Gr g3)
lookup and delete on IntMaps have O(min(n,W)) runtime, which is effectively constant on a given machine with a set integer width (W).
So that just leaves clearPred, clearSucc, and toAdj:
clearSucc :: GraphRep a b -> Node -> [Node] -> GraphRep a b
clearSucc g _ [] = g
clearSucc g v (p:rest) = clearSucc g' v rest
where
g' = IM.adjust f p g
f (ps, l, ss) = (ps, l, IM.delete v ss)
clearPred :: GraphRep a b -> Node -> [Node] -> GraphRep a b
clearPred g _ [] = g
clearPred g v (s:rest) = clearPred g' v rest
where
g' = IM.adjust f s g
f (ps, l, ss) = (IM.delete v ps, l, ss)
adjust is also O(min(n,W)), so we don't need to worry about that. Both clearSucc and clearPred recurse through each element in the adjacency list, though, so that's O(degree) combined.
toAdj :: IntMap [b] -> Adj b
toAdj = concatMap expand . IM.toList
where
expand (n,ls) = map (flip (,) n) ls
toAdj creates a new edge list, which is O(max(|V|,|E|)), but this is constructed lazily, so we don't need to worry about this unless it's used.
I've wrote the following code to increment the label of a given edge of a graph with FGL package, if the edge does not exist, it is created before being incremented :
import Data.Graph.Inductive
incrementEdge :: Edge -> Gr a Int -> Gr a Int
incrementEdge edge g = gmap (increment edge) g
increment :: Edge -> Context a Int -> Context a Int
increment (a,b) all#(p,n,x,v) = if a /= n then all else (p,n,x,v'')
where
v' = let (r,_) = elemNode b v in if r then v else ((0,b):v)
v'' = map (\(x,y) -> if y == b then (x+1,y) else (x,y)) v'
a :: Gr String Int
a = ([],1,"a",[]) & empty
b = ([],2,"b",[]) & a
while testing I got the following result :
*Main> incrementEdge (1,1) b
1:"a"->[(1,1)]
2:"b"->[]
*Main> incrementEdge (1,2) b
1:"a"->[(1,2)]
2:"b"->[]
*Main> incrementEdge (2,2) b
1:"a"->[]
2:"b"->[(1,2)]
But ...
*Main> incrementEdge (2,1) b
*** Exception: Edge Exception, Node: 1
what is the problem here ?
EDITION
elemNode ys [] = (False,0)
elemNode ys ((m,xs):xss) = if ys == xs then (True,m) else elemNode ys xss
I want to write a function which will add an edge to a graph from two nodes labels, the function checks that the two nodes exist, if not it create them :
- if nodes already exists the label of the edge between them is increment,
- if there is no edge between those node it is create before being incremented
Thanks for your reply
I don't think you're supposed to add edges with gmap: it folds over all the contexts in the graph in an arbitrary order and builds up the new graph by &ing the new contexts together. If a new context has a link to or from a node that hasn't been &ed yet, you get the Edge Exception.
Here's a simple example:
*Main> ([], 1, "a", [(0, 2)]) & empty :: Gr String Int
*** Exception: Edge Exception, Node: 2
I've only used FGL for a couple of little projects and am certainly no expert, but it probably makes more sense just to add new edges (with label 1) using insEdge and then do all the counting when needed:
import Data.Graph.Inductive
import qualified Data.IntMap as I
incrementEdge :: Edge -> Gr a Int -> Gr a Int
incrementEdge (a, b) = insEdge (a, b, 1)
count :: Gr a Int -> Gr a Int
count = gmap $ \(p, n, x, v) -> (countAdj p, n, x, countAdj v)
where
swap (a, b) = (b, a)
countAdj = map swap . I.toList . I.fromListWith (+) . map swap
This seems to work as desired:
*Main> count $ incrementEdge (2, 1) b
1:"a"->[]
2:"b"->[(1,1)]
*Main> count $ incrementEdge (2, 1) $ incrementEdge (2, 1) b
1:"a"->[]
2:"b"->[(2,1)]
1) A quick grep for Edge Exception in the fgl package:
cabal unpack fgl
cd fgl*
grep "Edge Exception" * -R
yields the file Data/Graph/Inductive/Tree.hs. Looking there we have the call updAdj that will throw this exception any time elemFM g v is false.
2) Could you provide runnable code? What you posted is missing elemNode (when using fgl 5.4.2.3)
3) Could you provide what version of fgl you're using? If it's old an upgrade might fix the issue.
Mapping over the graph doesn't seem like quite the right kind of traversal. The following works with the extracted context of the edge's source node.
edgeLookup :: Node -> [(a,Node)] -> Maybe ((a,Node), [(a,Node)])
edgeLookup n = aux . break ((== n) . snd)
where aux (h, []) = Nothing
aux (h, t:ts) = Just (t, h ++ ts)
incrementEdge :: Edge -> Gr a Int -> Maybe (Gr a Int)
incrementEdge (from,to) g = aux $ match from g
where aux (Nothing, _) = Nothing
aux (Just (i,n,l,o), g') = Just $ (i,n,l,checkEdge o) & g'
checkEdge outEdges =
maybe ((1,to):outEdges) incEdge $ edgeLookup to outEdges
incEdge ((cnt,n), rst) = (cnt+1,n):rst
I would probably also use a helper to go from (Maybe a, b) -> Maybe (a,b) then fmap aux over the helper composed with match. That would help to distill things down a bit better.
EDIT
To support node addition based on labels, one needs to track the bijection between labels and Node identifiers (Ints). This can be done by using a Map that is updated in parallel to the graph.
import Data.Graph.Inductive
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromJust)
-- A graph with uniquely labeled nodes.
type LGraph a b = (Map a Int, Gr a b)
-- Ensure that a node with the given label is present in the given
-- 'LGraph'. Return the Node identifier for the node, and a graph that
-- includes the node.
addNode :: Ord a => a -> LGraph a b -> (Int, LGraph a b)
addNode label (m,g) = aux $ M.lookup label m
where aux (Just nid) = (nid, (m,g))
aux Nothing = (nid', (m', g'))
[nid'] = newNodes 1 g
m' = M.insert label nid' m
g' = insNode (nid', label) g
-- Adding a context to a graph requires updating the label map.
(&^) :: Ord a => Context a b -> LGraph a b -> LGraph a b
c#(_, n, label, _) &^ (m,g) = (m', g')
where m' = M.insert label n m
g' = c & g
-- Look for a particular 'Node' in an edge list.
edgeLookup :: Node -> [(a,Node)] -> Maybe ((a,Node), [(a,Node)])
edgeLookup n = aux . break ((== n) . snd)
where aux (h, []) = Nothing
aux (h, t:ts) = Just (t, h ++ ts)
-- Increment the edge between two nodes; create a new edge if needed.
incrementEdge :: Edge -> Gr a Int -> Maybe (Gr a Int)
incrementEdge (from,to) g = fmap aux $ liftMaybe (match from g)
where aux ((i,n,l,o), g') = (i,n,l,checkEdge o) & g'
checkEdge outEdges =
maybe ((1,to):outEdges) incEdge $ edgeLookup to outEdges
incEdge ((cnt,n), rst) = (cnt+1,n):rst
liftMaybe :: (Maybe a, b) -> Maybe (a, b)
liftMaybe (Nothing, _) = Nothing
liftMaybe (Just x, y) = Just (x, y)
-- Increment an edge in an 'LGraph'. If the nodes are not part of the
-- graph, add them.
incrementLEdge :: Ord a => (a, a) -> LGraph a Int -> LGraph a Int
incrementLEdge (from,to) g = (m', fromJust $ incrementEdge' (from',to') g')
where (from', gTmp) = addNode from g
(to', (m',g')) = addNode to gTmp
-- Example
a' :: LGraph String Int
a' = ([],1,"a",[]) &^ (M.empty, empty)
b' = ([],2,"b",[]) &^ a'
test6 = incrementLEdge ("c","b") $ incrementLEdge ("b","a") b'
{-
*Main> test6
(fromList [("a",1),("b",2),("c",3)],
1:"a"->[]
2:"b"->[(1,1)]
3:"c"->[(1,2)])
-}