7
$\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$

2 Answers 2

8
$\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

$\endgroup$
1
  • $\begingroup$ That's an interesting approach to my problem, thank you for showing me that. $\endgroup$ Commented Mar 29, 2020 at 18:26
4
$\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

$\endgroup$
6
  • $\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$ Commented Mar 29, 2020 at 17:18
  • $\begingroup$ @D'Angelo What version of Mathematica do you have? $\endgroup$ Commented Mar 29, 2020 at 18:02
  • $\begingroup$ Ahh I figured that could have been the issue, I have 11.3 $\endgroup$ Commented Mar 29, 2020 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$ Commented Mar 29, 2020 at 18:24
  • $\begingroup$ Okay I was messing around with that before. Thank you $\endgroup$ Commented Mar 29, 2020 at 18:25

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.