4

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:

licheng
  • 2,029
  • 1
  • 7
  • 15
  • I don't reproduce your results - when I run your code I find Length[t] returns 64. What operating system are you using? – Jason B. Dec 28 '21 at 12:35
  • Sorry, in my context, my variable g may have been contaminated, and I'm now rerunging it to 64. – licheng Dec 28 '21 at 12:40
  • It is worth discussing, then, whether the multiple edges should be regarded as one. – licheng Dec 28 '21 at 12:43
  • 3
    @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. – MarcoB Dec 28 '21 at 14:28
  • Ok. Thanks for reminding, I will change this post. – licheng Dec 29 '21 at 02:26

1 Answers1

2

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]]];
Phillip D. Neumiller
  • 315
  • 1
  • 7