Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have a system of equations (equilibrium conditions) and would like to evaluate how changes of exogenous variables affect the endogenous values. In step 1, I state the equilibrium equations and some assumptions about the properties of the functions. The optimal solution may not be unique and therefore there are assumptions listed to ensure uniqueness (first assumption in first assumptions list and $y<0$).

Unfortunately, the output involves complex numbers and the equations are quite long. I would be more than happy to just receive +/-/0 as ouput or any hints how to optimize my code and output.

Thank you!

(*** Equilibrium Conditions ***)
(* Endogenous variables: c, L, n, k, m, u, d, q, f, e, Vl, Vc, a, \
δ , (y)*)
(* Exogenous variables: T, P, Π, A, r, ρ, s, \
α, ψ, ϕ, x, *)
ClearAll[c, L, n, k, m, u, d, q, f, e, Vl, Vc, a, δ, T, 
  P, Π, A, r, ρ, s, α, ψ, ϕ, x, y];
$Assumptions = 
     D[fm, {m, 2}]/D[fm, m] > (D[w, q]*ϕ)/(w*a) && D[fm, m] > 0 && 
      D[fm, {m, 2}] > 0 &&  D[fm, {m, 3}] >= 0  &&  D[gn, n] > 0 &&  
      D[gn, {n, 2}] > 0 
    (* Assumptions for Properties of Cost Functions *)
     $Assumptions = 
 r > 0 && A > 0 && P > 0  && ρ > 0 && ψ > 0 && 
  s > 0 && α > 0 && 
  T > 0 && Π > 0 && ϕ > 0 && σ > 0
(* Assumptions for Exogenous Parameters *)
fm = F[m];
(* Cost Type 1 *)
gn = G[n];
(* Cost Type 2 *)
(* δ = \!\(
\*SubsuperscriptBox[\(∫\), \(-∞\), \(y\)]\(w\
\[DifferentialD]x\)\) *)
(* Probability Function with Density Function w(.) of x *) 
$Assumptions = y < 0
(* Optimal Solution is on the lefthand-side of normal distribution - \
i.e., y<0 *)
w = PDF[NormalDistribution[ρ, σ], y]
(* Density Function *)
y = q - (ϕ*m)/a
(* Error Term y - Normally Distributed with mean and variance Sigma^2 \
*)
g1 =    (P*A*Π)/(L*n) - n/(1 + n)*D[G[n], n]
g2 = k -   D[G[n], n]
g3 = L - (T - P)/(1 + n)
g4 = c - n*L
g5 = a - (P*A)/L
g6 = (w/(r + δ)) - (ϕ/a)*(-y/σ^2)
g7 = D[fm, m] + 
  D[fm, {m, 2}]*((r + δ)/w) - (ρ*s)/(α*
    T)*ψ *ϕ/a
g8 = δ - \!\(
\*SubsuperscriptBox[\(∫\), \(-∞\), \(y\)]\(w \
\[DifferentialD]x\)\)
(* Probability Function with Density Function w(.) of x *)
g9 = u - a + ρ*m
g10 = d - n + m + u
g11 = e - δ/(n + δ)
g12 = f - n*k + gn + 
  fm +  ( D[fm, m]/(ϕ/a*w))*((r + e + δ*(1 - e))/(1 - e))
g13 = Vl - ((1 + r)/r)*((r + e)/(1 - e))*(D[fm, m]/(ϕ/a*w))
g14 = Vc - ((1 + r)^2/r)*(e/(1 - e))*(D[fm, m]/(ϕ/a*w))

(* First Step: Jacobian *)
J = {{D[g1, L], D[g1, c], D[g1, n], D[g1, k], D[g1, m], D[g1, u], 
    D[g1, d], D[g1, f], D[g1, q], D[g1, a] , D[g1, Vc], D[g1, Vl], 
    D[g1, e], D[g1, δ]},
   {D[g2, L], D[g2, c], D[g2, n], D[g2, k], D[g2, m], D[g2, u], 
    D[g2, d], D[g2, f], D[g2, q], D[g2, a] , D[g2, Vc], D[g2, Vl], 
    D[g2, e], D[g2, δ]},
   {D[g3, L], D[g3, c], D[g3, n], D[g3, k], D[g3, m], D[g3, u], 
    D[g3, d], D[g3, f], D[g3, q], D[g3, a] , D[g3, Vc], D[g3, Vl], 
    D[g3, e], D[g3, δ]}, 
   {D[g4, L], D[g4, c], D[g4, n], D[g4, k], D[g4, m], D[g4, u], 
    D[g4, d], D[g4, f], D[g4, q], D[g4, a] , D[g4, Vc], D[g4, Vl], 
    D[g4, e], D[g4, δ]},
   {D[g5, L], D[g5, c], D[g5, n], D[g5, k], D[g5, m], D[g5, u], 
    D[g5, d], D[g5, f], D[g5, q], D[g5, a] , D[g5, Vc], D[g5, Vl], 
    D[g5, e], D[g5, δ]}, 
   {D[g6, L], D[g6, c], D[g6, n], D[g6, k], D[g6, m], D[g6, u], 
    D[g6, d], D[g6, f], D[g6, q], D[g6, a] , D[g6, Vc], D[g6, Vl], 
    D[g6, e], D[g6, δ]}, 
   {D[g7, L], D[g7, c], D[g7, n], D[g7, k], D[g7, m], D[g7, u], 
    D[g7, d], D[g7, f], D[g7, q], D[g7, a] , D[g7, Vc], D[g7, Vl], 
    D[g7, e], D[g7, δ]}, 
   {D[g8, L], D[g8, c], D[g8, n], D[g8, k], D[g8, m], D[g8, u], 
    D[g8, d], D[g8, f], D[g8, q], D[g8, a] , D[g8, Vc], D[g8, Vl], 
    D[g8, e], D[g8, δ]},
   {D[g9, L], D[g9, c], D[g9, n], D[g9, k], D[g9, m], D[g9, u], 
    D[g9, d], D[g9, f], D[g9, q], D[g9, a] , D[g9, Vc], D[g9, Vl], 
    D[g9, e], D[g9, δ]},
   {D[g10, L], D[g10, c], D[g10, n], D[g10, k], D[g10, m], D[g10, u], 
    D[g10, d], D[g10, f], D[g10, q], D[g10, a] , D[g10, Vc], 
    D[g10, Vl], D[g10, e], D[g10, δ]},
   {D[g11, L], D[g11, c], D[g11, n], D[g11, k], D[g11, m], D[g11, u], 
    D[g11, d], D[g11, f], D[g11, q], D[g11, a] , D[g11, Vc], 
    D[g11, Vl], D[g11, e], D[g11, δ]},
   {D[g12, L], D[g12, c], D[g12, n], D[g12, k], D[g12, m], D[g12, u], 
    D[g12, d], D[g12, f], D[g12, q], D[g12, a] , D[g12, Vc], 
    D[g12, Vl], D[g12, e], D[g12, δ]},
   {D[g13, L], D[g13, c], D[g13, n], D[g13, k], D[g13, m], D[g13, u], 
    D[g13, d], D[g13, f], D[g13, q], D[g13, a] , D[g13, Vc], 
    D[g13, Vl], D[g13, e], D[g13, δ]},
   {D[g14, L], D[g14, c], D[g14, n], D[g14, k], D[g14, m], D[g14, u], 
    D[g14, d], D[g14, f], D[g14, q], D[g14, a] , D[g14, Vc], 
    D[g14, Vl], D[g14, e], D[g14, δ]}};

MatrixForm[J]

(* Second Step: Determinant of Jacobian *) 
(* Implicit function theorem requires Det J unequal to zero and all \
equations differentiable. *)
Det[J] 
Simplify[%]

(* Third Step: Comparative statics with Cramer's Rule *)
(* dY/dx = det(J_Y)/det(J) *)

(* A) Effectiveness *)
(* A.1) Comparative Static: effectiveness, α, on information, \
m *)
Jma = {{D[g1, L], D[g1, c], D[g1, n], D[g1, k], -D[g1, α], 
    D[g1, u], D[g1, d], D[g1, f], D[g1, q], D[g1, a] , D[g1, Vc], 
    D[g1, Vl], D[g1, e], D[g1, δ]},
   {D[g2, L], D[g2, c], D[g2, n], D[g2, k], -D[g2, α], 
    D[g2, u], D[g2, d], D[g2, f], D[g2, q], D[g2, a] , D[g2, Vc], 
    D[g2, Vl], D[g2, e], D[g2, δ]},
   {D[g3, L], D[g3, c], D[g3, n], D[g3, k], -D[g3, α], 
    D[g3, u], D[g3, d], D[g3, f], D[g3, q], D[g3, a] , D[g3, Vc], 
    D[g3, Vl], D[g3, e], D[g3, δ]}, 
   {D[g4, L], D[g4, c], D[g4, n], D[g4, k], -D[g4, α], 
    D[g4, u], D[g4, d], D[g4, f], D[g4, q], D[g4, a] , D[g4, Vc], 
    D[g4, Vl], D[g4, e], D[g4, δ]},
   {D[g5, L], D[g5, c], D[g5, n], D[g5, k], -D[g5, α], 
    D[g5, u], D[g5, d], D[g5, f], D[g5, q], D[g5, a] , D[g5, Vc], 
    D[g5, Vl], D[g5, e], D[g5, δ]}, 
   {D[g6, L], D[g6, c], D[g6, n], D[g6, k], -D[g6, α], 
    D[g6, u], D[g6, d], D[g6, f], D[g6, q], D[g6, a] , D[g6, Vc], 
    D[g6, Vl], D[g6, e], D[g6, δ]}, 
   {D[g7, L], D[g7, c], D[g7, n], D[g7, k], -D[g7, α], 
    D[g7, u], D[g7, d], D[g7, f], D[g7, q], D[g7, a] , D[g7, Vc], 
    D[g7, Vl], D[g7, e], D[g7, δ]}, 
   {D[g8, L], D[g8, c], D[g8, n], D[g8, k], -D[g8, α], 
    D[g8, u], D[g8, d], D[g8, f], D[g8, q], D[g8, a] , D[g8, Vc], 
    D[g8, Vl], D[g8, e], D[g8, δ]},
   {D[g9, L], D[g9, c], D[g9, n], D[g9, k], -D[g9, α], 
    D[g9, u], D[g9, d], D[g9, f], D[g9, q], D[g9, a] , D[g9, Vc], 
    D[g9, Vl], D[g9, e], D[g9, δ]},
   {D[g10, L], D[g10, c], D[g10, n], D[g10, k], -D[g10, α], 
    D[g10, u], D[g10, d], D[g10, f], D[g10, q], D[g10, a] , 
    D[g10, Vc], D[g10, Vl], D[g10, e], D[g10, δ]},
   {D[g11, L], D[g11, c], D[g11, n], D[g11, k], -D[g11, α], 
    D[g11, u], D[g11, d], D[g11, f], D[g11, q], D[g11, a] , 
    D[g11, Vc], D[g11, Vl], D[g11, e], D[g11, δ]},
   {D[g12, L], D[g12, c], D[g12, n], D[g12, k], -D[g12, α], 
    D[g12, u], D[g12, d], D[g12, f], D[g12, q], D[g12, a] , 
    D[g12, Vc], D[g12, Vl], D[g12, e], D[g12, δ]},
   {D[g13, L], D[g13, c], D[g13, n], D[g13, k], -D[g13, α], 
    D[g13, u], D[g13, d], D[g13, f], D[g13, q], D[g13, a] , 
    D[g13, Vc], D[g13, Vl], D[g13, e], D[g13, δ]},
   {D[g14, L], D[g14, c], D[g14, n], D[g14, k], -D[g14, α], 
    D[g14, u], D[g14, d], D[g14, f], D[g14, q], D[g14, a] , 
    D[g14, Vc], D[g14, Vl], D[g14, e], D[g14, δ]}};

MatrixForm[Jma]
Det[Jma]
Cma = Det[Jma]/Det[J]
Simplify[Cma]
Sign[Cma] // Simplify
share|improve this question
    
From the help : "This gives the Jacobian for a vector function." D[{x^2 + y^2, x y}, {{x, y}}] –  belisarius Nov 26 '13 at 15:48
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.