6
$\begingroup$

I'm sort of new to Mathematica and have been working on a project that involves simulating newtwork changes in the form of matrices. I have the following lines of code:

k = 10;
m = 10;
m1 = SparseArray[_ :> RandomInteger[1], {k, m}];
A = UpperTriangularize[m1] + Transpose[UpperTriangularize[m1, 1]];
MatrixForm[A];
aa = MatrixForm[A, 
  TableHeadings -> {{"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", 
     "V4", "V5"}, {"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", 
     "V4", "V5"}}]

This creates a "randomly" generated matrix consisting of elements 1 or 0.
I have included a picture to help explain my question. It's just a randomly generated matrix from the code above but it would be easier to see visualize the next part if I included colors.
Randomly generated symmetric matrix

I'm trying to create a SINGLE adjacency graph which shows the relationships between A-A (blue), A-V (pink), and V-V (red). The V-A connection shown in black is just the transpose of the pink quadrant and is unnecessary for me to show. The headings of A and V just represent different molecules. The matrix elements indicate where there is an edge between two molecules. A 1 means there is an edge, a 0 means no edge. As an example A1-A1 has a 0 as its element, therefore there is no edge.

What I managed to do so far is create two adjacency matrices, one for the A-A interactions and one of the V-V interactions. That is represented by the code below. The quadrants are in reference to the same found in a Cartesian coordinate graph (Top right = 1, then go counter clockwise for the other quadrants).

(*Pulls out the submatrix in Q1 *)
sm1 = A[[1 ;; 5, 6 ;; 10]];
ns1 = Normal[sm1]

(*Pull out the submatrix in Q2*)
sm2 = A[[1 ;; 5, 1 ;; 5]];
ns2 = Normal[sm2]

(*Pulls out the submatrix in Q4*)
sm3 = A[[6 ;; 10, 6 ;; 10]];
ns3 = Normal[sm3]

(*Vertex Labels*)
vlabel2 = {A1, A2, A3, A4, A5};
vlabel3 = {V1, V2, V3, V4, V5};

{g2, g3} = (AdjacencyGraph @@@ {{vlabel2, ns2}, {vlabel3, ns3}})
Row[Labeled[
    SetProperty[#, {VertexShapeFunction -> "Name", 
      ImageSize -> 200}], #2, Top] & @@@ {{g2, "g2"}, {g3, "g3"}}]

The above code generates two adjacency matrices, one for the A-A interactions (blue region) and one for the V-V interactions (red region). In included how to pull out the submatrix for Q1 since I think that would be necessary in helping me solve my problem. The main issue I'm having is incorporating the V-A interactions (pink region). I'm lost as to how I would go about incorporating the third adjacency matrix in order to connect the two that I currently have.

Any help would be greatly appreciate!

$\endgroup$
7
$\begingroup$

Maybe something like:

k = 10;
m = 10;
SeedRandom[1]
m1 = SparseArray@RandomInteger[1, {k, m}];
A = UpperTriangularize[m1] + Transpose[UpperTriangularize[m1, 1]];
labels = {"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", "V4", "V5"};

To get the four submatrices from A you can use Partition and to get A from the four matrices you can use ArrayFlatten:

partitionedA = {{AA, AV}, {VA, VV}} = Partition[A, {5, 5}];

Row[Riffle[MatrixForm /@ {A, partitionedA, ArrayFlatten@partitionedA}, 
   {RawBoxes @ StyleBox[UnderoverscriptBox["\[LongRightArrow]", "", 
      RowBox[{"   ", "Partition", "   "}]], 20], 
    RawBoxes @ StyleBox[UnderoverscriptBox["\[LongRightArrow]", "", 
      RowBox[{"   ", "ArrayFlatten", "   "}]], 20]}], Spacer[10]]

enter image description here

You can use labels as the first argument and A as the second argument to AdjacencyGraph and style each edge based on the matrix blocks its endpoints belong:

style = MapThread[Map[Function[x, Style[x, #2]], #, {-1}] &, {##},  2] &;
styledAM = MatrixForm[ArrayFlatten@ 
    style[partitionedA, {{Blue, Magenta}, {Black, Red}}], 
   TableHeadings -> {labels, labels}];

ag = AdjacencyGraph[labels, A, DirectedEdges -> True, 
   GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {5, 5}},
    VertexLabels -> Placed["Name", Center], VertexSize -> Large, 
   EdgeStyle -> {e_ :>  Switch[StringTake[List @@ e, 1], 
     {"A", "A"}, Blue, {"V", "V"}, Red, {"A", "V"}, Magenta, _, Black]}, 
   ImageSize -> Large];

Row[{ag, styledAM}]

enter image description here

You can select the edges associated with each matrix block and construct a separate graph for each block:

colors = AssociationThread[{"A - A", "A - V", "V - V", "V - A"}, 
   PropertyValue[{ag, #}, EdgeStyle] & /@ 
 {"A1" \[DirectedEdge] "A1", "A1" \[DirectedEdge] "V3", 
  "V1" \[DirectedEdge] "V1", "V1" \[DirectedEdge] "A5"}];

{gAA, gAV, gVA, gVV} = Graph[Select[EdgeList[ag], 
      Function[e, PropertyValue[{ag, e}, EdgeStyle] == colors@#]], 
     EdgeStyle -> colors@#, ImageSize -> Medium, 
     VertexLabels -> Placed["Name", Center], VertexSize -> Large, 
     VertexCoordinates -> {v_ :> vCoords[v]}] & /@ Keys[colors];

Row@MapThread[Labeled[##, Top] &, {{gAA, gAV, gVA, gVV}, Style[#, 16] & /@ Keys[colors]}] 

enter image description here

Finally, to get from graphs gAA, gAV, gVA and gVV to the combined graph ag you can use GraphUnion:

GraphUnion[gAA, gAV, gVA, gVV, ## & @@ Options[ag]]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ That's an interesting approach to my problem, thank you for showing me that. $\endgroup$ – D'Angelo Mar 29 at 18:26
3
$\begingroup$

You do not need to disassemble the adjacency matrix. You can assign colour within a single graph.

names = {"A1", "A2", "A3", "A4", "A5", "V1", "V2", "V3", "V4", "V5"};

type = StringTake[#, 1] &; (* what type of node? A or V? *)

colorRules = {
   {"A", "A"} -> Blue,
   {"V", "V"} -> Red,
   {"A", "V"} -> Purple
   };

AdjacencyGraph[{"A1","A2","A3","A4","A5","V1","V2","V3","V4","V5"},A,
    EdgeStyle -> { Thick, UndirectedEdge[u_, v_] :> Replace[Sort@{type[u],type[v]}, colorRules] },
    GraphStyle -> "IndexLabeled" (* this is a misnomer--it labels by name, not index *)
]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Hey, quick question, when I tried to run the same code I got the same type of graph, the only difference being my vertex labels are labeled "normally" (i.e. there is a dot representing the vertex and the vertex label is slightly offset the dot). How do I have my vertex labeled like the ones you have shown in your image? $\endgroup$ – D'Angelo Mar 29 at 17:18
  • $\begingroup$ @D'Angelo What version of Mathematica do you have? $\endgroup$ – Szabolcs Mar 29 at 18:02
  • $\begingroup$ Ahh I figured that could have been the issue, I have 11.3 $\endgroup$ – D'Angelo Mar 29 at 18:19
  • $\begingroup$ @D'Angelo 11.3 doesn't have GraphStyle -> "IndexLabeled". You need to construct it directly with something like VertexSize -> chooseAGoodSize, VertexStyle -> White, VertexLabels -> Placed["Name", Center] $\endgroup$ – Szabolcs Mar 29 at 18:24
  • $\begingroup$ Okay I was messing around with that before. Thank you $\endgroup$ – D'Angelo Mar 29 at 18:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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