4
$\begingroup$

I have a graph with some multiple edges. I tried to calculate the number of triangles in it, so I used the new function FindIsomorphicSubgraph of mathematica 13. We get 64 triangles of the graph by FindIsomorphicSubgraph.

   g=AdjacencyGraph[{{0, 1, 1, 1, 1, 2, 1, 0, 1, 0, 0, 0, 0, 0}, {1, 0, 1, 
   1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0,
    1, 0, 0}, {1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0}, {1, 1, 0, 1,
    0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {2, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 
   0, 0, 0}, {1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0}, {0, 0, 1, 0, 
   0, 0, 1, 0, 1, 1, 1, 1, 1, 1}, {1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 1,
    1, 0}, {0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0}, {0, 0, 0, 0, 0,
    0, 0, 1, 0, 1, 0, 2, 1, 1}, {0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 2, 0, 
   1, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 1}, {0, 0, 0, 0, 0, 
   0, 0, 1, 0, 0, 1, 1, 1, 0}}]
t = FindIsomorphicSubgraph[g, 
  Graph[{"a" \[UndirectedEdge] "b", "b" \[UndirectedEdge] "c", 
    "c" \[UndirectedEdge] "a"}], All]
t//Length
                             64

We use the IGraphM package as an aid.

cliques = IGCliques[g, {3}] // Length

                             64

enter image description here

The above function seems to compute the triangle by treating the multiple edges as the same edge.

Let $A$ be a adjacent matrix of the graph $g$ which has no loop edges but allows multiple edges. we note that triangles with an ordering on the vertices are in 1-1 correspondence with directed, 3-step paths from each vertex to itself. So the number of triangles is equal to the trace of $A^3$ divided by $6$, since each triangle is counted twice (once in each direction) for each vertex in the triangle.

In fact, we seem to get more triangles if we use the following function to calculate.

TriangleCount[g_] := Tr[MatrixPower[AdjacencyMatrix[g], 3]]/6;
TriangleCount[g]
                           72

FindIsomorphicSubgraph seems to ignore the multiple edges. Although we can also count the lost triangles by following programming. (It's not that effective).

EdgeList /@ t; 
elist = EdgeList[g];
repeats[list_] := Select[Gather[list], Length[#] > 1 &][[1 ;;, 1]];
s = EdgeList /@ t // Flatten;
s1 = Count[s, #] & /@ repeats[elist];
Plus @@ s1

                             8

In other words, this function should state in the help documentation that it considers the simple graphs to prevent misunderstanding.

Previously useful links:

$\endgroup$
5
  • $\begingroup$ I don't reproduce your results - when I run your code I find Length[t] returns 64. What operating system are you using? $\endgroup$
    – Jason B.
    Commented Dec 28, 2021 at 12:35
  • $\begingroup$ Sorry, in my context, my variable g may have been contaminated, and I'm now rerunging it to 64. $\endgroup$
    – licheng
    Commented Dec 28, 2021 at 12:40
  • $\begingroup$ It is worth discussing, then, whether the multiple edges should be regarded as one. $\endgroup$
    – licheng
    Commented Dec 28, 2021 at 12:43
  • 3
    $\begingroup$ @licheng Since no answers have been submitted yet, Please edit the question to remove the first issue that turned out to be erroneous and focus on your second question. You will also want to edit the title accordingly. $\endgroup$
    – MarcoB
    Commented Dec 28, 2021 at 14:28
  • $\begingroup$ Ok. Thanks for reminding, I will change this post. $\endgroup$
    – licheng
    Commented Dec 29, 2021 at 2:26

1 Answer 1

2
$\begingroup$

I think the following works. It finds 64 triangles in your multigraph.

Print[Framed[<< "IGraphM`", Background -> Yellow]];
g = AdjacencyGraph[{{0, 1, 1, 1, 1, 2, 1, 0, 1, 0, 0, 0, 0, 0}, {1, 0,
      1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 1, 0, 0, 1, 1, 1,
      1, 0, 1, 0, 0}, {1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0}, {1, 
     1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {2, 1, 0, 1, 1, 0, 1, 0, 
     0, 0, 0, 0, 0, 0}, {1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 
     0}, {0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1}, {1, 0, 1, 1, 0, 
     0, 1, 1, 0, 1, 0, 1, 1, 0}, {0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 
     1, 0}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 2, 1, 1}, {0, 0, 1, 0, 
     0, 0, 0, 1, 1, 1, 2, 0, 1, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 
     1, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 0}}];
Print[Length[IGTriangles[g]]];
$\endgroup$
1
  • 1
    $\begingroup$ There are 8 triangles involved here that are ignored. $\endgroup$
    – licheng
    Commented Jun 6, 2022 at 2:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.