0
$\begingroup$

I have the following code developed to balance an unbalanced square matrix using a reference matrix at t=0.

ClearAll[balSAM, row, col, labels];
balSAM = {
 {0, 679438, 0, 0, 0, 0, 0, 0, 0},
 {349467, 0, 0, 0, 206252, 0, 73905, 84850, 91949},
 {180492, 0, 0, 0, 0, 0, 0, 0, 396},
 {148626, 0, 0, 0, 0, 0, 0, 0, 0},
 {0, 0, 180778, 54736, 0, 23768, 58146, 0, 4903},
 {0, 0, 0, 84967, 13666, 0, 5249, 0, 8895},
 {853, 29819, 0, 8923, 74322, 9993, 0, 0, 2914},
 {0, 0, 0, 0, 23154, 61092, -13389, 0, 13993},
 {0, 97166, 109, 0, 4937, 17924, 2913, 0, 0}
 }*(1/1000) // N;
{row, col} = Dimensions[balSAM];
labels = {"Activity", "Commodity", "Labor", "Capital", "HHold", 
"Enterprise", "Government", "Investment", "RoW"};
Do[
 Do[
  If[balSAM[[i, j]] < 0, {balSAM[[j, i]] = -balSAM[[i, j]], 
    balSAM[[i, j]] = 0}], {i, row}
  ], {j, col}
 ];   (*negative entries treated as positive in the transposed cell \
       entries and then 0 placed in the negative entry cells*)
TableForm[balSAM, TableHeadings -> {labels, labels}]

ClearAll[unBalSAM, A1];
unBalSAM = {
  {0, 679138, 0, 0, 0, 0, 0, 0, 0},
  {345467, 0, 0, 0, 206252, 0, 73905, 84850, 91949},
  {180292, 0, 0, 0, 0, 0, 0, 0, 396},
  {168626, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 180778, 54236, 0, 23768, 58146, 0, 6503},
  {0, 0, 0, 84967, 13666, 0, 5249, 0, 8895},
  {853, 29819, 0, 8923, 74122, 9993, 0, 0, 2914},
  {0, 0, 0, 0, 22000, 60092, -15389, 0, 18793},
  {0, 95066, 109, 0, 4937, 17724, 4913, 0, 0}
  }*(1/1000) // N;
Do[
  Do[
  If[unBalSAM[[i, j]] < 0, {unBalSAM[[j, i]] = -unBalSAM[[i, j]], 
    unBalSAM[[i, j]] = 0}], {i, row}
    ], {j, col}
 ];   (*negative entries treated as positive in the transposed cell \
        entries and then 0 placed in the negative entry cells*)
A1 = (Transpose[Normalize[#, Total] & /@ Transpose[unBalSAM]]) //N; (*column-wise standardized  SAM*)
TableForm[unBalSAM, TableHeadings -> {labels, labels}]

ClearAll[eps, SAM0, colTotalSAM0, rowTotalSAM0, a0, SAM1, colTotalSAM1, rowTotalSAM1] ;
eps = 0.0000000000000001;

(* Data given at t=0 *)
SAM0 = balSAM;   (* SAM at t=0 *)
colTotalSAM0 = Total@SAM0;       (* column totals of SAM0 *)
rowTotalSAM0 = Total@Transpose[SAM0] ;   (* row totals of SAM0    *)
a0 = A1 ;     (*technical input coefficients at t=0*)

(* Data given at t=1 *)
SAM1 = unBalSAM;  (* SAM at t=1 *)
colTotalSAM1 = Total@SAM1;   (* column totals at t=1 *)
rowTotalSAM1 = Total@Transpose[SAM1];  (* row totals at t=1 *)

(*Cross-entropy nonlinear problem*)
ClearAll[objF, unknowns, eqList, constraints, sol, balancedSAM1] ;
objF =  \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(row\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 
   1\), \(col\)]\((a1[i, j] + eps)\)*Log[
\*FractionBox[\(a1[i, j] + eps\), \(a0[\([\)\(i, j\)\(]\)] + 
     eps\)]\ ]\)\) // N;
Do[  const1[i] = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(col\)]\(a1[i, j]*
  colTotalSAM1[\([j]\)]\)\) == rowTotalSAM1[[i]], {i, 
row - 1}  ] // N;  (*exclude one rowsum equation by Walras' Law*)
Do[const2[j] = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(row\)]\(a1[i, j]\)\) == 
1, {j, col}] // N;
Do[  Do[const3[i, j] = 0 <= a1[i, j] <= 1, {i, row}], {j, col}   ] // 
N; 

eqList = {Table[const1[i], {i, row - 1}], Table[const2[j], {j, col}], 
Table[const3[i, j], {i, row}, {j, col}]} // Flatten;
constraints = And @@ eqList;
unknowns = Table[a1[i, j], {i, row}, {j, col}] // Flatten ;
sol = NMinimize[{objF, constraints}, unknowns] ;    (* Numerical Nonlinear Programming *)

Do[  If[Sum[a1[i, j], {i, row}] == 1 /. sol[[2]], True, False], {j, col} ]
balancedSAM1 = Table[ t[i, j] = a1[i, j]*colTotalSAM1[[j]] /. sol[[2]], {i,row}, {j, col} ];
Total@balancedSAM1 == Total@Transpose[balancedSAM1]

I checked all of the equations and they look fine, but when I run the code it says that the NMinimize was unable to generate initial values and the function value is not a number at given points. I do not know what to do to solve this problem. Any idea?

$\endgroup$
  • 1
    $\begingroup$ Try sol = NMinimize[{objF // Rationalize, constraints}, unknowns] and NMinimize starts evaluation, but ends after a while with an error message (Mathematica v12) $\endgroup$ – Ulrich Neumann May 13 at 14:56
  • $\begingroup$ @Ulrich Neumann: I tried it as you suggested but NMinimize yields a complex number at a given point (MMA v11.3). $\endgroup$ – Tugrul Temel May 13 at 15:13
  • $\begingroup$ Check your objF to exclude complex values. $\endgroup$ – Ulrich Neumann May 13 at 18:30
  • $\begingroup$ @Ulrich Neumann: The code does not produce any solution, but several messages are repeated that inform me that NMinimize does not have have a real solution. So, I cannot really pinpoint the complexities in the objective function. $\endgroup$ – Tugrul Temel May 13 at 18:39

Your Answer

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

Browse other questions tagged or ask your own question.