3
$\begingroup$

Given a database in matrix format:

SeedRandom[6];
mat = RandomInteger[5, {27, 30}];
mat[[1, All]] = {"", a1, a2, a3, a4, a5, b1, b2, b3, b4, b5, c1, c2, 
   c3, c4, c5, d1, d2, d3, d4, d5, afd1, afd2, bfd1, bfd2, cfd1, cfd2,
   dfd1, dfd2, TD};
mat[[All, 1]] = {"", a1, a2, a3, a4, a5, b1, b2, b3, b4, b5, c1, c2, 
   c3, c4, c5, d1, d2, d3, d4, d5, aT, bT, cT, dT, VA, TS};

Each row and column has a name, e.g., a1, a2, .... Suppose the following operations on mat.

  1. Drop the columns {a1, a3, b1, b2, c4, c5, d2, d5} and the rows with the same names.
  2. Create a weighted directed graph using the columns {a2, a4, a5, b3, b4, b5, c1, c2, c3, d1, d3, d4} and the rows with the same names.

My question is not about the operations referred to in 1 and 2. I like to know how to keep the linkage between a string vertex name and a numeric vertex name. String names for the list in 2 are {a2, a4, a5, b3, b4, b5, c1, c2, c3, d1, d3, d4} and the associated numeric names are {2, 4, 5, 8, 9, 10, 11, 12, 13, 16, 18, 19}.

Because my original matrix is large, with the operation in item 1, I lose the linkage between numeric and string names, which I need in later stages of output formatting. For example, I can easily find Cliques with numeric vertex names but I need to know the string names linked to the numeric vertices.

Any suggestion?

EDIT 1

Suppose that

mat1 = Drop[Take[mat,21,21], {3,15},{3,15}];
MatrixForm@mat1

enter image description here

Using mat1, a directed graph given below is constructed by:

select[matrix_, lB_, uB_] := 
  matrix*Map[Boole[lB <= # <= uB] &, matrix,{-1}]; (*due to @KGLR*)
mat2 = Abs[Inverse[Drop[mat1, 1, 1]]] // N;
sa = SparseArray[select[mat2, .1, .6]];
weightedG = Graph[sa["NonzeroPositions"],  EdgeWeight -> sa["NonzeroValues"],DirectedEdges -> True];
GraphPlot[weightedG]

enter image description here

Even if I use VertexLabels->"Name" in Graph[...], the names (vertex numbers do not appear) on the graph. Most important of all, I like to use the column names a1, c5, d1,... as vertex names.

  1. How can I make the entire process described above an automatic procedure? That is to say: when I plot the directed graph after row/column elimination, I like to keep track of the vertex string names and see those names on the final graph.

  2. A more difficult task is: assigning the string column names to group names such as G1={a1,c5,d1}, G2={d2,d3}, G3={d4,d5} and zoom in the part of the graph including only selected groups such as {G1, G3}, meaning that group 2 G2 is excluded from the final digraph.

$\endgroup$
2
  • 2
    $\begingroup$ if the list of string names (names) is duplicate-free, then you can create mappings: nameToIndex = AssociationThread[names, Range@Length@names] and/or indexToName = AssociationThread[Range@Length@names, names] ? $\endgroup$
    – kglr
    Jan 30, 2021 at 3:39
  • $\begingroup$ @kglr: I edited my question to bring clarity to my questions (new). Creating pre-defined groups of vertices with string names make the graph formation more flexible and analysis of linkages easier. With such flexibility, one can play with subgraphs of specific geographic regions (groups) and focus on binary regional interactions rather than using the entire graph. $\endgroup$ Jan 30, 2021 at 16:51

1 Answer 1

1
$\begingroup$
select[matrix_, lB_, uB_] := matrix  Map[Boole[lB <= # <= uB] &, matrix, {-1}];

mat1 = {{"", a1, c5, d1, d2, d3, d4, d5}, 
   {a1, 2, 0, 5, 3, 1, 5, 5}, 
   {c5, 1, 3, 1, 5, 0, 5, 4},
   {d1, 2, 3, 3, 5, 1, 4, 5},
   {d2, 2, 0, 5, 1, 5, 0, 4}, 
   {d3, 5, 0, 5, 5, 1, 2, 4}, 
   {d4, 2, 0, 4, 0, 1, 0, 4},
   {d5, 3, 2, 0, 4, 0, 1, 5}};

vnames = Rest[mat1[[1]]]
{a1, c5, d1, d2, d3, d4, d5}

1. You can construct a WeightedAdjacencyMatrix from mat2 replacing 0.s with :

mat2 = Abs[Inverse[Drop[mat1, 1, 1]]] // N;

wam = select[mat2, .1, .6] /. 0. -> ∞;

MatrixForm @ wam

enter image description here

Use wam with WeightedAdjacencyGraph with vnames as the first argument:

wag = WeightedAdjacencyGraph[vnames, wam,
  VertexLabels -> "Name", EdgeLabels -> "EdgeWeight"]

enter image description here

2. "zoom in the part of the graph including only selected groups":

{G1, G2, G3} = {{a1, c5, d1}, {d2, d3}, {d4, d5}};

HighlightGraph[wag, Subgraph[wag, #] & /@ {G1, G2, G3}]

enter image description here

HighlightGraph[wag, Subgraph[wag, Join[G1, G3]], GraphHighlightStyle -> "Thick"]

enter image description here

Use VertexDelete to delete the vertices in G2 from wag:

vcoords = AssociationThread[vnames, GraphEmbedding[wag]];

Graph[VertexDelete[wag, G2], VertexCoordinates -> {v_ :> vcoords @ v}]

enter image description here

$\endgroup$
1
  • $\begingroup$ It is a great answer. Now I can easily map the interactions between countries and regions, a very useful piece of code. In my question, I forgot to refer to you for the select[...] function you developed. Thanks a lot. $\endgroup$ Jan 30, 2021 at 20:25

Your Answer

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

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