How to remove "extra" edges from a multigraph?

Question

I programmatically generate many large undirected graphs. Sometimes these graphs are multigraphs, that is, they contain more than one edge between a pair of nodes. I've tried to delete the "extra" edges, to keep only one per node pair, with no success. It should be trivial, but I can't find a simple solution.

Take for instance, the following simple graph:

G0 = Graph[{a <-> b, b <-> c, c <-> a, b <-> a, b <-> c, b <-> a}, 
VertexLabels -> All]

How to keep only one edge between a and b, and one edge between c and b?

I've tried some very inefficient ways, but no success. I'd like to know if there's a simple solution (since the problem seems trivial at glance).

Note: If there are self-loops, I'd still like to keep them, therefore SimpleGraph[] is not a solution for this particular problem.

Thank you,

Pedro

Answer 1

Graph[
  DeleteDuplicates[
  Sort /@ {a <-> b, b <-> c, c <-> a, b <-> a, b <-> c, b <-> a}], 
  VertexLabels -> All]

or

Graph[
 DeleteDuplicates[
 Map[Sort, {a <-> b, b <-> c, c <-> a, b <-> a, b <-> c, b <-> a}]],
 VertexLabels -> All]

Answer 2

As others said, SimpleGraph will do this. But it will also remove self-loops.

g = Graph[{1 <-> 1, 1 <-> 2, 2 <-> 3, 2 <-> 3, 3 <-> 1}]

SimpleGraph[g]

IGraph/M has functions to deal precisely with this problem.

IGSimpleGraph has options which control the removal of self-loops and multi-edges separately. We can just turn off self-loops removal.

IGSimpleGraph[g, SelfLoops -> True]

There is also a function that merges multi-edges and combines their weights. The default combiner adds up the weights—for unweighted graphs this means counting how many edges were merged.

IGWeightedSimpleGraph[g, EdgeLabels -> "EdgeWeight"]

---

A final note: I know that you are already familiar with IGraph/M. When there is an issue like this, it is always worth checking if IGraph/M has a solution—it often does, especially when the problem is this common. IGraph/M development is driven by practical issues that come up during real-world network analysis tasks, not by mere guesses about what users might or might not need.

Answer 3

if self-loops are not needed

• SimpleGraph[g]
  removes all self-loops and multiple edges between the same vertices.

So

SimpleGraph[G0, Options @ G0]

But ...

in my case, I'd still need them if they exist.

So it is not as simple any more:

simpleGraph = Graph[First /@ Gather[Sort /@ EdgeList @ #], Options @ #] &

G1 = Graph[{a <-> b, a <-> a, a <-> a,a <-> a, b <-> c, c <-> a,
     b <-> a, b <-> c, b <-> a},  VertexLabels -> All, ImageSize -> 200];

Row[{G1, SimpleGraph[G1, Options @ G1], simpleGraph @ G1}]

Alternatively, you can also use

simpleGraph2 = EdgeDelete[#, Flatten[Rest /@ Gather[Sort /@ EdgeList @ #]]]&;
simpleGraph3 = AdjacencyGraph[VertexList @#, Unitize @ AdjacencyMatrix @ #, Options@#]&;

Answer 4

Maybe this is you after

SimpleGraph[G0]