How do I get specific subgraphs from my adjacency graph/matrix under certain conditions?

Question

I have the following set of code which creates a random symmetric matrix (elements 0 and 1) and a labeled adjacency graph. A 0 corresponds to no edge and a 1 corresponds to an edge.

m1 = SparseArray[_ :> RandomInteger[1], {10, 10}];
A = UpperTriangularize[m1] + Transpose[UpperTriangularize[m1, 1]];
MatrixForm[A];
aa = MatrixForm[A, 
  TableHeadings -> {{"A1", "A2", "A3",
      "A4", "A5", "T1", "T2", "T3", "T4", 
     "T5"}, {"A1", "A2", "A3", "A4", 
     "P5", "T1", "T2", "T3", "T4", "T5"}}]

vertexnames = {"A1", "A2", "A3", "A4", "A5", "T1", "T2", "T3", "T4", 
   "T5"};

AdjacencyGraph[vertexnames, A,
 VertexLabels -> Placed["Name", Center],
 VertexSize -> .5,
 VertexStyle -> White]

My question is essentially two-fold. I've provided two pictures to help with the explanation. First, how would I find the total number of subgraphs in my adjacency graph which consist of an A-A-T triangle. What I mean by that is if you take a look at my adjacency graph, one of these triangles can be seen amongst vertices A4-A1-T2 (Left-hand side of the graph). I would like to find a way where I can return a list of subgraphs and the number of subgraphs which are of the motif of a A-T-A triangle. It's okay if a vertex is shared in another subgraph (For example, A4 is also in another A-T-A triangle composed of A4-A5-T2).

The second part of my question involves taking those subgraphs and seeing if they fit the numbers given a distribution.

k = RandomReal[];
Dist = ProbabilityDistribution[p^k (1 - p)^(1 - k), {p, 0, 1}];
values = RandomVariate[Dist, 100];

MaxLength = 5;

For[k = 1, k < MaxLength, k++, {
   A = RandomSample[values, 5];
   T = RandomSample[values, 5];
   }];
Print[A, T]

Printing A and T gives me a list of numbers, an example would be;

{{1.10392, 0.244928, 0.135036, 0.551455, 0.136968}{0.110555, 0.247629, 0.680901, 0.420931, 0.463969}}

The position of the numbers represents a value attached to the heading on the columns/rows of the matrix (i.e. 1.10293 is the value given to A1, .244928 is the value to given to A2... etc). The same idea applies to the values for T. What I want to do is based on the subgraphs above I want to see if any of them have all three elements as the same numbers. In our example of the A1-A4-T2 triangle the assigned values given by the distribution are {1.10392,.551455,.247629}. All these are different numbers so I wouldn't be interested in that subgraph. I would only be interested in obtaining subgraphs which have all three numbers the same.

Answer 1

1.

ag = AdjacencyGraph[vertexnames, A, VertexLabels -> Placed["Name", Center],
   VertexSize -> .5, VertexStyle -> White];

You can use FindCycle to find 3-cycles and group them using GroupBy:

grouped = GroupBy[FindCycle[ag, {3}, All], StringJoin @ StringTake[#, 1] &@*VertexList]

 <|"TTT" -> {{"T1" \[UndirectedEdge] "T3", "T3" \[UndirectedEdge] "T2",
     "T2" \[UndirectedEdge] "T1"},
    {"T2" \[UndirectedEdge] "T3", "T3" \[UndirectedEdge] "T4", 
     "T4" \[UndirectedEdge] "T2"}},   
  "ATT" -> {{"A5" \[UndirectedEdge] "T3", "T3" \[UndirectedEdge] "T1", 
    "T1" \[UndirectedEdge] "A5"}, 
    {"A2" \[UndirectedEdge] "T3", "T3" \[UndirectedEdge] "T4", 
     "T4" \[UndirectedEdge] "A2"}}, 
  "AAT" -> {{"A1" \[UndirectedEdge] "A2", "A2" \[UndirectedEdge] "T3", 
    "T3" \[UndirectedEdge] "A1"},
    {"A1" \[UndirectedEdge] "A2",  "A2" \[UndirectedEdge] "T5", 
     "T5" \[UndirectedEdge] "A1"}}|>

Length /@ grouped

<|"TTT" -> 2, "ATT" -> 2, "AAT" -> 2|>

Row @ KeyValueMap[Labeled[#2, #, Top] &][
  Subgraph[ag, #, VertexSize -> .3, Options[ag], ImageSize -> Medium] & /@ grouped]

Row[Labeled[HighlightGraph[ag, Join @@ ({#, VertexList@#} & /@ grouped[#]), 
     ImageSize -> Medium], #, Top] & /@ Keys[grouped]]

vertexgroups = Map[VertexList] /@ grouped

<|"TTT" -> {{"T1", "T3", "T2"}, {"T2", "T3", "T4"}}, 
  "ATT" -> {{"A5", "T3", "T1"}, {"A2", "T3", "T4"}}, 
  "AAT" -> {{"A1", "A2", "T3"}, {"A1", "A2", "T5"}}|>

Using the function blobF from this answer we can mark the triples with blobs:

ClearAll[blobF, fC]
fC[pts_, size_: .04] := Module[{}, CommunityGraphPlot[Graph@{}, {}];
  GraphComputation`GraphCommunitiesPlotDump`generateBlobs[
    Automatic, {pts}, size][[2]]]

blobF[g_, cols_, coms_, size_: .04] := Thread[{cols, EdgeForm[{Gray, Thin}], 
  Opacity[.25], fC[PropertyValue[{g, #}, VertexCoordinates] & /@ #, size] & /@ coms}];

Row[HighlightGraph[ag, Join[grouped @ #, vertexgroups @ #], 
    PlotLabel -> #, ImageSize -> 350, 
    Prolog -> blobF[ag, RandomColor[Length @ vertexgroups @ #], 
      vertexgroups @ #, .07]] & /@ Keys[grouped]]

2.

SeedRandom[1]
vals = Round[RandomVariate[Dist, 10], .01];

rvs = AssociationThread[vertexnames, vals]

  <|A1 -> 1.05, A2 -> 0.42, A3 -> 0.49, A4 -> 0.23, A5 -> 0.79, 
 T1 -> 0.48, T2 -> 0.65, T3 -> 0.94, T4 -> 0.45, T5 -> 1.|>

Map[rvs, vertexgroups, {-1}]

  <|TTT -> {{0.48, 0.94, 0.65}, {0.65, 0.94, 0.45}}, 
 ATT -> {{0.79, 0.94, 0.48}, {0.42, 0.94, 0.45}}, 
 AAT -> {{1.05, 0.42, 0.94}, {1.05, 0.42, 1.}}|>