Ttdfjt

I have the following Code working nicely (Part of this code has been developed by users in this forum).

Clear[vLabels, selectAbove, subgraphAbove];
mm = RandomReal[0.5, 10, 10];
vLabels = 1 -> AGR, 2 -> FIS, 3 -> CO1, 4 -> CO2, 5 -> MA1, 6 -> MA2,
7 -> EGW, 8 -> CST, 9 -> WHS, 10 -> HOT;

selectAbove[[Theta]_] := BoolEval[[Theta] < mm];
subgraphAbove[[Theta]_] := AdjacencyGraph[selectAbove[[Theta]],
PlotLabel -> [Theta] < Subscript[m, ij], VertexSize -> 0.3, 
VertexLabels -> vLabels , ImagePadding -> 20, ImageSize -> 150];
Manipulate[
subgraphAbove[[Theta]], [Theta], 0.001, "Threshold [Theta] <", 
0, 0.5, 0.01]

I simply do not want to see the loops in this digraph. I looked for a command to suppress the loops, but to my surprise no single command exists. Or I could find it in my search.

I will appreciate if you suggest me a way to suppress the loops.

• EDIT 1

I face a puzzle here. The Code given above simply counts the number of edges in an interval theta1 and theta2. If I keep the maximum range to find the maximum number of edges in the entire graph, it gives me a puzzling result. To see the puzzle, let us just look at the following three maps.

The first graph indicates that in the range given, the number of linkages or edges is 136. (Keep in mind that histogram is giving the right and consistent answer.)

The second graph indicates that in the range given, the number of linkages or edges is 271, which is correct. (Keep in mind that histogram is giving the right and consistent answer again.)

The puzzle is that, although I reduce the range, expecting that I will get a smaller number of edges compared to the range covering the entire graph, I receive a larger number that 136.

Can somebody tell me what I am missing here or Mathematica is doing something that I cannot see. The additional puzzle is that Histogram always gives the correct number (I checked it through almost all ranges.) but a simple command EdgeCount does not behave in the expected manner.

See the following full Code to replicate the situation, where the mm matrix is large and hence you may check it with random numbers between 0-0.5:

Clear[selectBetween, subgraphBetween];
selectBetween[[Theta]1_, [Theta]2_] := 
BoolEval[[Theta]1 <= mm <= [Theta]2];
subgraphBetween[[Theta]1_, [Theta]2_] := 
AdjacencyGraph[selectBetween[[Theta]1, [Theta]2],
PlotLabel -> [Theta]1 <= Subscript[m, ij] <= [Theta]2, 
VertexSize -> 0.3, VertexLabels -> vLabels , ImagePadding -> 20, 
ImageSize -> 150];
Manipulate[Grid[
"Digraph within the range for " <> 
 ToString[Subscript[m, ij], TraditionalForm], 
 "Total number of edges in the interval", 
 "Histogram", subgraphBetween[[Theta]1, [Theta]2], 
 EdgeCount[subgraphBetween[[Theta]1, [Theta]2]], 
 Histogram[0, binlims = 
 Range[[Theta]1, [Theta]2, ([Theta]2 - [Theta]1)/
 nbars], (EdgeCount[subgraphBetween[##]] & @@@ 
 Partition[binlims, 2, 1] &), LabelingFunction -> Above] // 
Transpose
],
[Theta]1, 0.00001, 
"Threshold [Theta]1 < " <> 
ToString[Subscript[m, ij], TraditionalForm], 0.00001, 0.5, 
0.005, [Theta]2, 0.0001, 
ToString[Subscript[m, ij], TraditionalForm] <> 
" < Threshold [Theta]2", [Theta]1 + 0.00001, 0.5, 0.005,
nbars, 10, 1, 100, 1
]

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]