enter image description here

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[17];
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 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 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 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 at 15:31
up vote 2 down vote accepted

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[18];
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} 

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

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