## Creating a directed weighted graph by using a database

3

1

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


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]


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.

2if 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] ? – kglr – 2021-01-30T03:39:54.217

@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. – Tugrul Temel – 2021-01-30T16:51:47.473

1

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


Use wam with WeightedAdjacencyGraph with vnames as the first argument:

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


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}]


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


Use VertexDelete to delete the vertices in G2 from wag:

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

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


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. – Tugrul Temel – 2021-01-30T20:25:49.940