Multigraphs in Mathematica 8

I just spent a couple of hours trying to convert some old code that uses Mathematica 7's GraphPlot to use the new Mathematica 8 Graph functions. It seemed sensible since the new graph drawing is much nicer and it has things like AdjacencyMatrix and KirchhoffMatrix built in.

The problem is that I can not figure out how to get graphs with multiple edges to work in Mma 8.

The Feynman graph that I use as my canonical example is the two-loop vacuum graph

GraphPlot[{1 -> 2, 1 -> 2, 1 -> 2}, MultiedgeStyle -> .5, 
          DirectedEdges -> True, VertexCoordinateRules -> {{-1, 0}, {1, 0}}]

Trying to make the similar graph in Mma 8

Graph[{DirectedEdge[1, 2], DirectedEdge[1, 2], DirectedEdge[1, 2]}, 
      VertexCoordinates -> {{-1, 0}, {1, 0}}开发者_开发技巧]

yields the error message

Graph::supp: Mixed graphs and multigraphs are not supported. >>

How can I construct (and work with) a similar graph using Mathematica 8's Graph[] objects?

Edit: This problem still exists in Mathematica 9

I went through a similar process of trying to use Graph for everything, and found that it it does not replace Combinatorica and GraphPlot. The best use for Graph is to use it as a container type to store vertices + edges + coordinates.

For example, most of the functions from "Algorithmic Graph Theory" of Combinatorica tutorial are not available for new Graph objects. When I talked with a WRI developer on Graph project, my understanding was providing all of Combinatorica functions for Graph is not a priority because the design goal is to provide methods that solve tasks in algorithmic agnostic way. For instance, you may have method to find vertex cover and graph coloring for new Graph object, but for algorithmic specific tasks like Brelaz coloring and Greedy Vertex Cover, you may always have to defer to Combinatorica.

In addition to multi-graphs, some graph layouts are not available for Graph objects. You can not fix some vertex coordinates and let automatic layout do the rest. Also, layout of LayeredGraphPlot is not available and is sometimes preferred over Graph's LayeredDrawing.

The way to get the best of 3 worlds is to use Graph objects as main vehicle for graph storage and make wrappers for GraphPlot, Combinatorica and GraphUtilities functions that accept Graph objects

Some use cases:

• You need some algorithm from Combinatorica or GraphUtilities -- make a wrapper someAlgorithm that takes Graph object, converts it to list of edges or Combinatorica graph (GraphUtilities'ToCombinatoricaGraph is helpful), runs the algorithm, converts it back to Graph object, taking care to set correct GraphStyle and VertexCoordinates from the original graph object. Because of conflicts, make sure Combinatorica and GraphUtilities are not on context path, I do it using $Pre

• You need some custom graph plot like here, or the multi-edge graph -- make a wrapper function someGraphPlot that accepts Graph object, converts it to correct representation, then uses GraphPlot or perhaps creates a temporary Graph object with custom vertex/edge shapes for the purpose of this one plot. Note that you can attach properties to edges using SetProperty so you can store your multigraphs in Graph that way.

• You want to use one of GraphPlot layouts and store coordinates in Graph -- use function like here to get vertex coordinates from GraphPlot layout, and store them in Graph object using VertexCoordinates

Here's a notebook demonstrating these use cases and a few others

The GraphPlot function still works in mma 8.

Multigraphs weren't supported in Combinatorica's functions either. Pretty difficult to implement in an adjecency matrix too. Perhaps working with EdgeWeight may work in calculations?

For drawing multiple links I can imagine that 'EdgeShapeFunction' may help you.

ef[pts_List, e_] :=
 Block[{g1 = 
    Insert[pts, (pts[[1]] + pts[[-1]])/
      2 + ({x, y}/5 /. 
        Solve[{Norm[{x, y}] == 1, (pts[[1]] - pts[[-1]]).{x, y} == 
            0}, {x, y}][[1]]), Round[(Length[pts] + 1)/2]],
   g2 = Insert[
     pts, (pts[[1]] + pts[[-1]])/
      2 + (-{x, y}/5 /. 
        Solve[{Norm[{x, y}] == 1, (pts[[1]] - pts[[-1]]).{x, y} == 
            0}, {x, y}][[1]]), Round[(Length[pts] + 1)/2]]}, {Arrow[
    BSplineCurve[g1]], Arrow[BSplineCurve[g2]], Arrow[pts]}]

Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 1},
  EdgeShapeFunction -> ef]

or for selected edges :

Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 1},
  EdgeShapeFunction -> {3 \[DirectedEdge] 1 -> ef}]

The function ef can be easily parametrized for the number of edges to draw.

These are not yet supported, I guess:

In[201]:= AdjacencyGraph[{{0, 3}, {0, 0}}]

During evaluation of In[201]:= Graph::supp: Mixed graphs and multigraphs are not supported. >>

Out[201]= AdjacencyGraph[{{0, 3}, {0, 0}}]

although this might not be the answer you hope to get.