# Relocation of vertices in a digraph, using Euclidian distance measure My objective is to produce a Mathematica code to calculate a[j] for every vertex j. I have already developed the following code that yields all the variables required to calculate a[j]. However, I could not go further than that to produce a[j]. I need some help.

Clear[n, d, muBenchmark, G, mu, trs, abs, infoX, infoY, edgeCapMat,
information, sysX, sysY, sysXreduced, sysYreduced, capTA, infoXY,
dTA, dXY, Eplus, Eminus, saG, sink2, E1plus];

SeedRandom;
n = 10;
d = 0.2;
G = RandomGraph[{Round[n], Round[n*(n - 1)*d]}, DirectedEdges -> True,
VertexLabels -> "Name"]
muCritical = 1.4;   (* critical value for innovation *)
mu = Table[{i, RandomReal[{1, 2}]}, {i, 1,
n}]; (* {vertex, innovationIndex} *)

{trs, abs} = {Table[{\[Tau][i] = RandomReal[]}, {i, 1, n}],
Table[{\[Alpha][i] = RandomReal[]}, {i, 1, n}]};  (* capacities *)
{infoX, infoY} = {Table[x[i] = RandomInteger[{1, 5}], {i, 1, n}],
Table[y[i] = RandomInteger[{1, 5}], {i, 1, n}]};  (* information *)

edgeCapMat[trsCap_, absCap_] := trsCap.Transpose[absCap];
information[stock_] := DiagonalMatrix[stock];
{sysX, sysY} = {information[infoX].edgeCapMat[trs, abs],
information[infoY].edgeCapMat[trs, abs]};
{sysXreduced, sysYreduced} = {AdjacencyMatrix[G]*sysX,
AdjacencyMatrix[G]*sysY};

{capTA, infoXY} = {Table[{\[Tau][i], \[Alpha][i]}, {i, 1, n}],
Table[{x[i], y[i]}, {i, 1, n}]};
{dTA, dXY} = {Outer[EuclideanDistance, capTA, capTA, 1]*
AdjacencyMatrix[G],
Outer[EuclideanDistance, infoXY, infoXY, 1]*AdjacencyMatrix[G]};

Eplus[edgeList_, sink_] :=
Cases[edgeList,
x : {_, sink} :> x]; (* set of edges with a specific "sink" *)
Eminus[edgeList_, source_] :=
Cases[edgeList,
x : {source, _} :> x]; (* set of edges with a specific "source" *)
saG = SparseArray[AdjacencyMatrix[G]];
sink2 = Eplus[saG["NonzeroPositions"],
2] (* an example: all the edges with "sink=2" *)
E1plus = Eminus[sink2, 5]  (* an example: all the edges with "source=5" *)

• Comments are not for extended discussion; this conversation has been moved to chat. – Kuba Oct 11 '18 at 13:26
• @Kuba: How can I enter the Chat room while exchanging comments with somebody? Of course, now I can click to the Link you provided, but I mean how to do it at my will. – Tugrul Temel Oct 11 '18 at 14:33
• There is a menu in the top bar with chat link. You can enter general chat or create a new one for specific purpose. – Kuba Oct 11 '18 at 15:24
• @Kuba: I found it, but somehow it is not at the top bar but at the bottom of my display under Marthematica title. Thanks a lot. – Tugrul Temel Oct 11 '18 at 15:31

## 1 Answer

This is an answer to my question above. I should indicate that without @KGLR's final touch (the very last line of the following code), I could not have developed the answer. During the communication with @KGLR, I realized what was missing in the original code. Thanks go to @KGLR for inspiring me and completing the work.

Anyway, here is the code that does what I aimed to do.

(***********************************************)
(* Relocation due to innovations in a digraph  *)
(***********************************************)

Clear[n, d, G, muCritical, mu, innovators, trs, abs, infoX, infoY,
edgeCapMat, information, sysX, sysY, sysXreduced, sysYreduced, capTA,
infoXY, dTA, dXY, dTAi, dXYi, relocationSize];

SeedRandom;
n = 10;
d = 0.2;
G = RandomGraph[{Round[n], Round[n*(n - 1)*d]}, DirectedEdges -> True,
VertexLabels -> "Name"]

muCritical = 1.4;
mu = Table[{i,RandomReal[{1, 2}]}, {i,1,n}]; (*{vertex, innovationIndex}*)
innovators = Array[0 &, {n, n}];
Do[ If[mu[[i, 2]] >= muCritical, innovators[[i, All]] = 1] , {i, 1, n}];

{trs, abs} = {Table[{\[Tau][i] = RandomReal[]}, {i, 1, n}],
Table[{\[Alpha][i] = RandomReal[]}, {i, 1, n}]};  (* capacities *)
{infoX, infoY} = {Table[x[i] = RandomInteger[{1, 5}], {i, 1, n}],
Table[y[i] = RandomInteger[{1, 5}], {i, 1, n}]};  (* information *)

edgeCapMat[trsCap_, absCap_] := trsCap.Transpose[absCap];
information[stock_] := DiagonalMatrix[stock];
{sysX, sysY} = {information[infoX].edgeCapMat[trs, abs],
information[infoY].edgeCapMat[trs, abs]};
{sysXreduced, sysYreduced} = {AdjacencyMatrix[G]*sysX,
AdjacencyMatrix[G]*sysY};

{capTA, infoXY} = {Table[{\[Tau][i], \[Alpha][i]}, {i, 1, n}],
Table[{x[i], y[i]}, {i, 1, n}]};
{dTA, dXY} = {Outer[EuclideanDistance, capTA, capTA, 1]*
AdjacencyMatrix[G],
Outer[EuclideanDistance, infoXY, infoXY, 1]*
AdjacencyMatrix[G]};  (* matrices of distances based on G *)
{dTAi, dXYi} = {dTA*innovators,
dXY*innovators};  (* distance from innovators *)

(* @KGLR's contribution *)
relocationSize =
Quiet[Total[#, 1]/Total[Unitize[#], 1] &[dXYi/mu[[All, -1]] + dTAi]]
/.{Indeterminate -> 0}