I'm using a Data.Graph Graph to model a simulation in Haskell. The simulation is limited to a 2D grid which my graph models. A node at each point on the grid below will contain a Maybe Molecule type so there could be a molecule present or just Nothing.
1 - 2 - 3
| | |
4 - 5 - 6
| | |
7 - 8 - 9
I have set up this representation but when it comes to updating the position of a molecule I feel I'm going the long way around the issue. What I've done so far is stripped all the nodes into a list of nodes. I've written a function to swap the two items in this list of nodes. But now when I come to zip everything back together I come into problems because to generate a new graph I need a list of vertices which I obtain easily from the vertices Graph function. But I also need to zip that with the list of vertices the edge touches. Unfortunately Data.Graph's edges Graph function returns a list of tuples of type Edge which isn't immediately helpful for generating a graph as far as I can see, although I could write a function to derive the list vertices which have edges to a vertex. Doing so seems to be enough work for me to wonder am I missing the point is there a Graph function out there which does just take a graph and return a graph with an updated node?
FGL has this great "context" mechanism that lets you pattern match on a graph query. You can imagine this as tugging on a chosen vertex so that it sits to the side of the rest of the graph. This lets you look at how that that vertex is connected to the rest of the graph.
{-# LANGUAGE TupleSections #-}
import Control.Applicative
import Control.Arrow
import Data.Graph.Inductive
-- Example graph from SO question.
graph :: Gr (Maybe Int) ()
graph = mkGraph (map (id&&&Just) [1,2,3,4,5,6,7,8,9])
(map (\(x,y) -> (x,y,())) $
concatMap gridNeighbors [1..9])
where gridNeighbors n = map (n,)
. filter ((&&) <$> valid <*> not . boundary n)
$ [n-3,n-1,n+1,n+3]
valid x = x > 0 && x < 10
boundary n x = case n `rem` 3 of
0 -> x == n + 1
1 -> x == n - 1
_ -> False
-- Swap the labels of nodes 4 and 7
swapTest g = case match 4 g of
(Just c4, g') -> case match 7 g' of
(Just c7, g'') -> setLabel c4 (lab' c7) &
(setLabel c7 (lab' c4) &
g'')
_ -> error "No node 7!"
_ -> error "No node 4!"
where setLabel :: Context a b -> a -> Context a b
setLabel (inEdges, n, _, outEdges) l = (inEdges, n, l, outEdges)
You can try running swapTest graph
to see that the labels for nodes 4 and 7 in your diagram are swapped.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With