How to supress loops in a digraph?
Use SimpleGraph
:
SimpleGraph[g] removes all self-loops and multiple edges between the same vertices.
Manipulate[SimpleGraph[g = subgraphAbove[θ], ImageSize -> Medium, Options[g]],
{{θ, 0.001, "Threshold θ <"}, 0, 0.5, 0.01}, Alignment -> Center]
As others said, SimpleGraph
will remove both loops and multi-edges. Often this is all you need. If you need to control the removal of loops and multi-edges separately, you can use IGSimpleGraph
from IGraph/M.
Create a graph.
g = IGShorthand["1->2->3->1->2->2->1",
MultiEdges -> True, SelfLoops -> True]
Make the graph simple.
IGSimpleGraph[g]
Preserve self-loops, but not parallel edges.
IGSimpleGraph[g, SelfLoops -> True]
IGSimpleGraph[g, MultiEdges -> True]
Preserve parallel edges but not self-loops.
IGSimpleGraph
does not currently preserve graph properties such as egde weights (SimpleGraph
does, but only in M12.0+). IGraph/M also provides IGWeightedSimpleGraph
which takes the same options, but preserves edge weights, the most commonly needed edge property.
You could also use EdgeDelete
to remove self-loops. In a directed graph, use
EdgeDelete[g, x_ \[DirectedEdge] x_]
In M11.3 and earlier, EdgeDelete
was buggy and would often break the graph if it had properties (styling also counts as properties). In M12.0 it is finally fixed, therefore I can finally recommend it (for M12.0+ only!)
Another option, which is specific to your setup, is to remove the diagonal of the adjacency matrix before using AdjacencyGraph
. You can do this using IGZeroDiagonal[matrix]
(which is also part of IGraph/M).
Finally, if you have an already constructed graph with properties (such as vertex labels), you need to preserve the properties, and you have Mathematica 11.3 or earlier, then you can use IGTakeSubgraph
.
sg = subgraphAbove[.23];
IGTakeSubgraph[sg, DeleteCases[EdgeList[sg], x_ \[DirectedEdge] x_]]
The second argument of IGTakeSubgraph
can be a set of edges, or a graph. It will keep only those edges from the input graph (the first argument). IGTakeSubgraph
is quite slow, but it's the most convenient way to take a subgraph and preserve properties in Mathematica 11.3 and earlier. In Mathematica 12.0 and later, the built-in Subgraph
, VertexDelete
and EdgeDelete
already preserve properties.
myGraph = Graph[{1 -> 2, 1 -> 3, 2 -> 3, 2 -> 2}]
fixedMatrix =
Table[If[i == j, 0, AdjacencyMatrix[myGraph][[i, j]]],
{i, 1, 3},
{j, 1, 3}];
AdjacencyGraph[fixedMatrix]
Could also use:
fixedMatrix =
ReplacePart[AdjacencyMatrix[myGraph], Table[{i, i} -> 0, {i, 1, 3}]]
Or
SimpleGraph[myGraph]