How to choose three vertices having maximum number of interconnecting edges?
You can use FindCycle and Subgraph:
g = Graph[UndirectedEdge @@@ edges];
Convert it to a simple graph since multiplicity doesn't necessary for this.
triangles = FindCycle[SimpleGraph[g], {3}, All];
subgraphs = Subgraph[g, #, AnnotationRules -> None] & /@ triangles;
VertexList[First[MaximalBy[subgraph, EdgeCount]]]
{5, 53, 61}
or
MaximalBy[triangles,
EdgeCount[Subgraph[g, #, AnnotationRules -> None]] &]
{{5 \[UndirectedEdge] 53, 53 \[UndirectedEdge] 61, 61 \[UndirectedEdge] 5}}
I would do it like this with IGraph/M:
Create a graph:
g = Graph[UndirectedEdge @@@ edges];
Merge parallel edges and record the multiplicities as edge weights:
wg = IGWeightedSimpleGraph[g];
Now we find the maximum total edge weight triangle:
MaximalBy[
IGTriangles[g],
Total@IGEdgeProp[EdgeWeight]@IGWeightedSubgraph[wg, #] &
]
(* {{5, 61, 53}} *)
This will work in Mathematica 10.0 and later.
In Mathematica 12.0 or later, you can use Subgraph
instead of IGWeightedSubgraph
, as it does preserve weights.
A bit more complicated than @halmir's version, but I wanted to show how to work with edge weights. The main advantage of this answer is that IGTriangles
is faster than FindCycle
(because it is more specialized).
Note: You may be thinking of this problem as finding maximum-weight 3-cliques. IGraph/M does have a function called IGWeightedCliques
, but it works with vertex-weights, not edge-weights. I am noting this just to avoid confusion.
You can employ Szabolcs' package "IGraphM`"
to find all triangles first (if there are any). Then finding the a triangle with maximal number of edges attached to it is straight-forward:
Needs["IGraphM`"]
G = Graph[Range[Max[edges]], UndirectedEdge @@@ edges];
triangles = IGTriangles[G];
i = Ordering[Total[Partition[VertexDegree[G][[Flatten[triangles]]], 3], {2}], -1][[1]];
triangles[[i]]