1
$\begingroup$

I have this function (Nhfunction) defined as procedural:

Clear["Global`*"]
ClearAll[Subscript]
(*Set of static parameters*)
rho = 2; r = 0.8;
m = 3; n = 2 ;
A = Table[Subscript[a, i], {i, n}];
Subscript[a, 1] = 0.5;
Subscript[a, 2] = 1 - Subscript[a, 1];    
V = Table[Subscript[v, i], {i, m}];
Subscript[v, 1] = 0.2;
Subscript[v, 2] = 0.4;
Subscript[v, 3] = 0.6;
G = Table[Subscript[g, i], {i, m}];
Subscript[g, 1] = 0.3;
Subscript[g, 2] = 0.4;
Subscript[g, 3] = 0.3;

(*Definition of the function that fails to evaluate*)
Nhfunction[c1_, c2_] :=
  Module[{},
   (*Function that take the arguments c1 of Nhfunction as parameter*)
   W1[i_, j_] := 
    rho*Subscript[a, 1]/
      r*(Subscript[v, i] - 
       rho/r*(Sum[
           Subscript[g, z]*
            Subscript[a, 1]*(Subscript[v, z] - Subscript[v, i]), {z, 
            i + 1, j}] + 
          Sum[Subscript[g, 
             k]*(Subscript[v, 
               k] - (Subscript[a, 1]*Subscript[v, i] + 
                Subscript[a, 2]*Subscript[v, j])), {k, j + 1, m}]) - 
       c1)*(1 - Sum[Subscript[g, s], {s, 1, i - 1}]);

   (*Similar function that takes c2*)
   W2[i_, j_] := 
    rho*Subscript[a, 2]/
      r*(Subscript[v, i] - 
       rho/r*(Sum[
           Subscript[g, z]*
            Subscript[a, 2]*(Subscript[v, z] - Subscript[v, i]), {z, 
            i + 1, j}] + 
          Sum[Subscript[g, 
             k]*(Subscript[v, 
               k] - (Subscript[a, 2]*Subscript[v, i] + 
                Subscript[a, 1]*Subscript[v, j])), {k, j + 1, m}]) - 
       c2)*(1 - Sum[Subscript[g, s], {s, 1, i - 1}]);

(*Table of preliminar results*)
   game = Table[Subscript[p, i, j, z], {i, m}, {j, m}, {z, n}];
   Do[Subscript[p, i, j, 1] = W1[i, j]; 
    Subscript[p, i, j, 2] = W2[j, i], {i, m}, {j, m}];

   (*Nash Table *)
   nash = Table[Subscript[nh, i, j], {i, m}, {j, n}];
   Do[Subscript[nh, i, 
      1] = {Position [game[[All, i, 1]], Max[game[[All, i, 1]]]], i} //
       Flatten, {i, m}];
   Do[Subscript[nh, i, 
      2] = {i, Position [game[[i, All, 2]], Max[game[[i, All, 2]]]]} //
       Flatten, {i, m}];
   Nasheq = Select[nash[[All, 1]], MemberQ[nash[[All, 2]], #] &];

(*Function expected output *)
      Return[Nasheq[[1, All]]]];

Some tested results:

Nhfunction[0,0]={2,2}
Nhfunction[1,1]={3,3}
Nhfunction[0,1]={2,3}

The issue is that if I run that code and then evaluate Nhfunction I get the proper result, but if then I evaluate new arguments on Nhfunction, the result doesn't change. However if I insist on the new arguments the output change to the correct one after 3 tries. For example:

1st evaluation: Nhfunction[0,0]={2,2} correct output.

Change arguments:

Nhfunction[1,1]={2,2} incorrect output.

(2nd) Enter on the line Nhfunction[1,1]={2,2} incorrect output.

(3rd) Enter on the line Nhfunction[1,1]={3,3} correct output.

I noted that the tables game and nash are not updating properly, but they update (with delay). This is what I tried without luck:

  • Define the game and nash table as module.
  • use p/: and nh/: to assign values to the tables and then ClearAll[game] and ClearAll[nash]
  • Evaluate[] on the Do that fills the tables (get an error on the nash table)

I need to eventually plot Nhfunction[x,y]

$\endgroup$
  • 1
    $\begingroup$ The very first thing that comes to my mind is: Don't use Subscript. Better use lists/arrays and Part instead. $\endgroup$ – Henrik Schumacher Sep 23 '18 at 6:16
2
$\begingroup$

Your usage of Subscript was very puzzling (and inefficient) This is the way I would write your algorithm down. I did not experience any delaying issues with this implementation. But of course, no guarantee that it does what you have in mind.

rho = 2;
r = 0.8;
R = rho/r;
m = 3;
n = 2;
a = {0.5, 1 - 0.5};
v = {0.2, 0.4, 0.6};
g = {0.3, 0.4, 0.3};

W1[c1_, i_, j_] := 
  R a[[1]] (v[[i]] - 
     R ( a[[1]] Sum[g[[z]] (v[[z]] - v[[i]]), {z, i + 1, j}] + 
        Sum[g[[k]] (v[[k]] - (a[[1]] v[[i]] + a[[2]] v[[j]])), {k, 
          j + 1, m}]) - c1) (1 - Sum[g[[s]], {s, 1, i - 1}]);
W2[c2_, i_, j_] :=
  R a[[2]] (v[[j]] - 
     R (a[[2]] Sum[g[[z]] (v[[z]] - v[[j]]), {z, j + 1, i}] + 
        Sum[g[[k]] (v[[k]] - (a[[2]] v[[j]] + a[[1]] v[[i]])), {k, 
          i + 1, m}]) - c2) (1 - Sum[g[[s]], {s, 1, j - 1}]);

Nhfunction[c1_, c2_] := First@Intersection[
    Table[{Ordering[Table[W1[c1, i, j], {i, m}], -1][[-1]], j}, {j, m}],
    Table[{i, Ordering[Table[W2[c1, i, j], {j, m}], -1][[-1]]}, {i, m}]
    ];

Here some test results:

Nhfunction[0, 0]
Nhfunction[1, 1]
Nhfunction[0, 1]

{2, 2}

{3, 3}

{2, 3}

$\endgroup$
  • $\begingroup$ Thanks, I would try to implement something like your solution without subscripts. I can't really use your code directly. $\endgroup$ – Rodrigo Sep 23 '18 at 11:54
  • $\begingroup$ You're welcome. My principal goal was to show that operating with arrays and Table might help to write more concise code that is also easier to debug. $\endgroup$ – Henrik Schumacher Sep 23 '18 at 12:23
  • $\begingroup$ Worked perfectly once I avoided the subscripts, thanks again :) $\endgroup$ – Rodrigo Sep 23 '18 at 17:30
  • $\begingroup$ You're welcome. $\endgroup$ – Henrik Schumacher Sep 23 '18 at 17:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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