(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 22887, 716]*) (*NotebookOutlinePosition[ 23743, 745]*) (* CellTagsIndexPosition[ 23699, 741]*) (*WindowFrame->Normal*) Notebook[{ Cell[OutputFormData["\<\ Comparative Statics Using Mathematica\ \>", "\<\ Comparative Statics Using Mathematica\ \>"], "Title", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ by Hal R. Varian August, 1991\ \>", "Subtitle", ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ "This Notebook describes how to use Mathematica to do comparative statics \ calculations. See the chapter on \"Optimization\" in ", StyleBox["Microeconomic Analysis, W. W. ", FontSlant->"Italic"], "Norton and Company, 1992. This should be thought of as a\n\"pre-beta\" \ version. Suggestions for the final version are welcome and should be sent to \ ", StyleBox["Hal.Varian@umich.edu", FontWeight->"Bold"], "." }], "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[TextData[StyleBox["Hal Varian\t\t Hal.Varian@um.cc.umich.edu\n\ Department of Economics\t BITNET: userCABX@umichum\nUniversity of Michigan\ \t NeXTmail:hal@alfred.econ.lsa.umich.edu\nAnn Arbor, MI 48109-1220 \ voice: 313-764-2364 fax: 313-764-2769", FontSize->17]], "Special1", ImageRegion->{{0, 1}, {0, 1}}], Cell["A Simple example", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Let's start with a simple example. We have an equation of the form g[x,a]=0. Here we think of x as being some endogenous variable determined by the \ relationship g[x,a]=0, and a as some exogenous parameter in the system. We \ want to determine how x varies as the parameter a varies. To do this, we \ first take a total derivative of the system.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["Dt[g[x,a]]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ Dt[a]*Derivative[0, 1][g][x, a] + Dt[x]*Derivative[1, 0][g][x, a]\ \>", "\<\ (0,1) (1,0) Dt[a] g [x, a] + Dt[x] g [x, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ In standard mathematical notation, this would be written as dg(x,a) dg(x,a) --------- da + ---------dx da dx The differential elements dx and da are denoted by Dt[x] and Dt[a] in \ Mathematica. Next we set this total differential equal to zero and solve the resulting \ equation for Dt[x]: \ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["Solve[Dt[g[x,a]]==0,Dt[x]]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {{Dt[x] -> -((Dt[a]*Derivative[0, 1][g][x, a])/Derivative[1, 0][g][x, a])}}\ \>", "\<\ (0,1) Dt[a] g [x, a] {{Dt[x] -> -(------------------)}} (1,0) g [x, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ This gives us an expression for dx. If we want to solve for the derivative \ dx/da, we simply divide both sides by da (= Dt[a]). However, it is usually \ more helpful to leave Dt[a] on the right hand side. Note that this the solution is a list that has one element in it. We can \ strip off one layer of listing to get a cleaner form for the final \ solution.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["%[[1]]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {Dt[x] -> -((Dt[a]*Derivative[0, 1][g][x, a])/ Derivative[1, 0][g][x, a])}\ \>", "\<\ (0,1) Dt[a] g [x, a] {Dt[x] -> -(------------------)} (1,0) g [x, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["Optimization", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ It is common in economic applications to apply comparative statics methods to \ optimization problems. In this case, the first-order condition is the first \ derivative of the objective function. For example, suppose that we have a \ problem max f[x,a] x This gives us a first-order condition of the form df[x,a] ------- = 0 dx We want to differentiate this expression with respect to a to determine how \ x varies with a. This is easily done: \ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["Solve[Dt[D[f[x,a],x]]==0,Dt[x]][[1]]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {Dt[x] -> -((Dt[a]*Derivative[1, 1][f][x, a])/ Derivative[2, 0][f][x, a])}\ \>", "\<\ (1,1) Dt[a] f [x, a] {Dt[x] -> -(------------------)} (2,0) f [x, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14] }, Open ]], Cell["\<\ This gives us the standard formula for Dt[x]: the ratio of the mixed partial and the second derivative with respect to the choice \ variable.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["Two equations", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Let's try the same calculation with two equations. We have now have two \ variable optimization problem max f[x1,x2,a] x1,x2\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["\<\ which leads to FOC df[x1,x2,a] ----------- = 0 dx1 df[x1,x2,a] ----------- = 0 dx2\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["\<\ We totally differentiate this system and solve for {dx1,dx2}: \ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["\<\ Solve[{Dt[D[f[x1,x2,a],x1]]==0, Dt[D[f[x1,x2,a],x2]]==0}, {Dt[x1],Dt[x2]}][[1]]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {Dt[x1] -> -((Dt[a]*Derivative[0, 2, 0][f][x1, x2, a]* Derivative[1, 0, 1][f][x1, x2, a])/ (-Derivative[1, 1, 0][f][x1, x2, a]^2 + Derivative[0, 2, 0][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a])) + (Dt[a]*Derivative[0, 1, 1][f][x1, x2, a]* Derivative[1, 1, 0][f][x1, x2, a])/ (-Derivative[1, 1, 0][f][x1, x2, a]^2 + Derivative[0, 2, 0][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a]), Dt[x2] -> (Dt[a]*Derivative[1, 0, 1][f][x1, x2, a]* Derivative[1, 1, 0][f][x1, x2, a])/ (-Derivative[1, 1, 0][f][x1, x2, a]^2 + Derivative[0, 2, 0][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a]) - (Dt[a]*Derivative[0, 1, 1][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a])/ (-Derivative[1, 1, 0][f][x1, x2, a]^2 + Derivative[0, 2, 0][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a])}\ \>", "\<\ {Dt[x1] -> -( (0,2,0) (1,0,1) Dt[a] f [x1, x2, a] f [x1, x2, a] ------)\\ (1,1,0) 2 (0,2,0) (2,0,0) -f [x1, x2, a] + f [x1, x2, a] f [x1, x2, a] (0,1,1) (1,1,0) Dt[a] f [x1, x2, a] f [x1, x2, a] + ---------------------------------------------------------------\\ (1,1,0) 2 (0,2,0) (2,0,0) -f [x1, x2, a] + f [x1, x2, a] f [x1, x2, a] , Dt[x2] -> (1,0,1) (1,1,0) Dt[a] f [x1, x2, a] f [x1, x2, a] --------------------------------------------------------------- - (1,1,0) 2 (0,2,0) (2,0,0) -f [x1, x2, a] + f [x1, x2, a] f [x1, x2, a] (0,1,1) (2,0,0) Dt[a] f [x1, x2, a] f [x1, x2, a] ---------------------------------------------------------------} (1,1,0) 2 (0,2,0) (2,0,0) -f [x1, x2, a] + f [x1, x2, a] f [x1, x2, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ This is kind of messy. In the standard treatment of comparative statics \ problems we use Cramer's rule to solve for (dx1, dx2). In this case we know \ that the denominator of the expression for dx1, say, is the determinant of \ the Hessian. Since the Hessian is a positive definite matrix due to the \ second-order conditions, we know its sign automatically. However, if we look more closely at the expression immediately above, we see \ that Mathematica automatically puts this expression in the \"right\" format: \ the determinant of the mixed partials over the determinant of the Hessian. \ All we need to do is to substitute out for the Hessian.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["Simplifying the expression", "Subsection", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ As we just saw, the above expression is messier than it has to be. We know \ that the denominator is negative because of the second-order conditions. We \ will calculate the determinant of the Hessian and substitute it out. We compute the Hessian matrix using the \"Table\" command:\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["Hessian = Table[D[f[x[1],x[2],a],x[i],x[j]],{i,2},{j,2}]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {{Derivative[2, 0, 0][f][x[1], x[2], a], Derivative[1, 1, 0][f][x[1], x[2], a]}, {Derivative[1, 1, 0][f][x[1], x[2], a], Derivative[0, 2, 0][f][x[1], x[2], a]}}\ \>", "\<\ (2,0,0) (1,1,0) {{f [x[1], x[2], a], f [x[1], x[2], a]}, (1,1,0) (0,2,0) {f [x[1], x[2], a], f [x[1], x[2], a]}}\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["Now compute the determinant of this matrix:", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell[CellGroupData[{ Cell["Det[%]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ -Derivative[1, 1, 0][f][x[1], x[2], a]^2 + Derivative[0, 2, 0][f][x[1], x[2], a]* Derivative[2, 0, 0][f][x[1], x[2], a]\ \>", "\<\ (1,1,0) 2 (0,2,0) -f [x[1], x[2], a] + f [x[1], x[2], a] (2,0,0) f [x[1], x[2], a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["Finally, change back to the (x1,x2) notation", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["%/.{x[1]->x1,x[2]->x2}", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ -Derivative[1, 1, 0][f][x1, x2, a]^2 + Derivative[0, 2, 0][f][x1, x2, a]*Derivative[2, 0, 0][f][x1, x2, a]\ \>", "\<\ (1,1,0) 2 (0,2,0) (2,0,0) -f [x1, x2, a] + f [x1, x2, a] f [x1, x2, a]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ This is the determinant of the bordered Hession; call it DH. We recalculate \ the comparative statics expression given above, but now substitue the result \ of the last calculation.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["\<\ Solve[{Dt[D[f[x1,x2,a],x1]]==0, Dt[D[f[x1,x2,a],x2]]==0}, {Dt[x1],Dt[x2]}][[1]]/.%->DH\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {Dt[x1] -> -((Dt[a]*Derivative[0, 2, 0][f][x1, x2, a]* Derivative[1, 0, 1][f][x1, x2, a])/DH) + (Dt[a]*Derivative[0, 1, 1][f][x1, x2, a]* Derivative[1, 1, 0][f][x1, x2, a])/DH, Dt[x2] -> (Dt[a]*Derivative[1, 0, 1][f][x1, x2, a]* Derivative[1, 1, 0][f][x1, x2, a])/DH - (Dt[a]*Derivative[0, 1, 1][f][x1, x2, a]* Derivative[2, 0, 0][f][x1, x2, a])/DH}\ \>", "\<\ (0,2,0) (1,0,1) Dt[a] f [x1, x2, a] f [x1, x2, a] {Dt[x1] -> -(---------------------------------------------) + DH (0,1,1) (1,1,0) Dt[a] f [x1, x2, a] f [x1, x2, a] ---------------------------------------------, DH (1,0,1) (1,1,0) Dt[a] f [x1, x2, a] f [x1, x2, a] Dt[x2] -> --------------------------------------------- - DH (0,1,1) (2,0,0) Dt[a] f [x1, x2, a] f [x1, x2, a] ---------------------------------------------} DH\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["This gives the final form of the result", "Text", ImageRegion->{{0, 1}, {0, 1}}], Cell["An Economic Example", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Let's try an economic example. Let h[x1,x2] be a production function and consider the profit maximization problem, max h[x1,x2] - w1 x1 - w2 x2\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["\<\ Solve[{Dt[D[h[x1,x2]-w1 x1 - w2 x2,x1]]==0, Dt[D[h[x1,x2]-w1 x1 - w2 x2,x2]]==0}, {Dt[x1],Dt[x2]}][[1]]\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {Dt[x1] -> (Dt[w1]*Derivative[0, 2][h][x1, x2])/ (-Derivative[1, 1][h][x1, x2]^2 + Derivative[0, 2][h][x1, x2]*Derivative[2, 0][h][x1, x2]) - (Dt[w2]*Derivative[1, 1][h][x1, x2])/ (-Derivative[1, 1][h][x1, x2]^2 + Derivative[0, 2][h][x1, x2]*Derivative[2, 0][h][x1, x2]), Dt[x2] -> -((Dt[w1]*Derivative[1, 1][h][x1, x2])/ (-Derivative[1, 1][h][x1, x2]^2 + Derivative[0, 2][h][x1, x2]*Derivative[2, 0][h][x1, x2])) + (Dt[w2]*Derivative[2, 0][h][x1, x2])/ (-Derivative[1, 1][h][x1, x2]^2 + Derivative[0, 2][h][x1, x2]*Derivative[2, 0][h][x1, x2])}\ \>", "\<\ (0,2) Dt[w1] h [x1, x2] {Dt[x1] -> ------------------------------------------------ - (1,1) 2 (0,2) (2,0) -h [x1, x2] + h [x1, x2] h [x1, x2] (1,1) Dt[w2] h [x1, x2] ------------------------------------------------, (1,1) 2 (0,2) (2,0) -h [x1, x2] + h [x1, x2] h [x1, x2] (1,1) Dt[w1] h [x1, x2] Dt[x2] -> -(------------------------------------------------) + (1,1) 2 (0,2) (2,0) -h [x1, x2] + h [x1, x2] h [x1, x2] (2,0) Dt[w2] h [x1, x2] ------------------------------------------------} (1,1) 2 (0,2) (2,0) -h [x1, x2] + h [x1, x2] h [x1, x2]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ Again, it makes sense to compute the Hessian and substitute it out. However, \ we leave this an an exercise for the reader.\ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["Constrained Maximization", "Section", ImageRegion->{{0, 1}, {0, 1}}], Cell["\<\ Now let's try a constrained maximization problem. This is a cost \ minimization problem: max w1 x1 + w2 x2 f[x1,x2] = y \ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell["Define the Lagrangian", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["L[x1,x2,t] = w1 x1 + w2 x2 - t(f[x1,x2] - y)", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ w1*x1 + w2*x2 - t*(-y + f[x1, x2])\ \>", "\<\ w1 x1 + w2 x2 - t (-y + f[x1, x2])\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["The Hessian is", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14], Cell[CellGroupData[{ Cell["\<\ Hessian={{D[L[x1,x2,t],t,t], D[L[x1,x2,t],t,x1], D[L[x1,x2,t],t,x2]}, {D[L[x1,x2,t],x1,t],D[L[x1,x2,t],x1,x1],D[L[x1,x2,t],x1,x2]}, {D[L[x1,x2,t],x2,t],D[L[x1,x2,t],x2,x1],D[L[x1,x2,t],x2,x2]}}\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {{0, -Derivative[1, 0][f][x1, x2], -Derivative[0, 1][f][x1, x2]}, {-Derivative[1, 0][f][x1, x2], -(t*Derivative[2, 0][f][x1, x2]), -(t*Derivative[1, 1][f][x1, x2])}, {-Derivative[0, 1][f][x1, x2], -(t*Derivative[1, 1][f][x1, x2]), -(t*Derivative[0, 2][f][x1, x2])}}\ \>", "\<\ (1,0) (0,1) {{0, -f [x1, x2], -f [x1, x2]}, (1,0) (2,0) (1,1) {-f [x1, x2], -(t f [x1, x2]), -(t f [x1, x2])}, (0,1) (1,1) (0,2) {-f [x1, x2], -(t f [x1, x2]), -(t f [x1, x2])}}\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell[CellGroupData[{ Cell["Det[%]", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ t*Derivative[0, 2][f][x1, x2]*Derivative[1, 0][f][x1, x2]^2 - 2*t*Derivative[0, 1][f][x1, x2]*Derivative[1, 0][f][x1, x2]* Derivative[1, 1][f][x1, x2] + t*Derivative[0, 1][f][x1, x2]^2*Derivative[2, 0][f][x1, x2]\ \>", "\<\ (0,2) (1,0) 2 t f [x1, x2] f [x1, x2] - (0,1) (1,0) (1,1) 2 t f [x1, x2] f [x1, x2] f [x1, x2] + (0,1) 2 (2,0) t f [x1, x2] f [x1, x2]\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Solve[{Dt[D[L[x1,x2,t],x1]]==0, Dt[D[L[x1,x2,t],x2]]==0, Dt[D[L[x1,x2,t],t]] ==0}, {Dt[x1],Dt[x2],Dt[t]}]/.(%)->DHH\ \>", "Input", ImageRegion->{{0, 1}, {0, 1}}], Cell[OutputFormData["\<\ {{Dt[x1] -> (Dt[w1]*Derivative[0, 1][f][x1, x2]^2)/DHH - (Dt[w2]*Derivative[0, 1][f][x1, x2]*Derivative[1, 0][f][x1, x2])/ DHH - (Dt[y]*(-(t*Derivative[0, 2][f][x1, x2]* Derivative[1, 0][f][x1, x2]) + t*Derivative[0, 1][f][x1, x2]*Derivative[1, 1][f][x1, x2]))/ DHH, Dt[x2] -> -((Dt[w1]*Derivative[0, 1][f][x1, x2]*Derivative[1, 0][f][x1, x2])/ DHH) + (Dt[w2]*Derivative[1, 0][f][x1, x2]^2)/DHH - (Dt[y]*(t*Derivative[1, 0][f][x1, x2]* Derivative[1, 1][f][x1, x2] - t*Derivative[0, 1][f][x1, x2]*Derivative[2, 0][f][x1, x2]))/ DHH, Dt[t] -> -((Dt[w1]*(-(t*Derivative[0, 2][f][x1, x2]* Derivative[1, 0][f][x1, x2]) + t*Derivative[0, 1][f][x1, x2]*Derivative[1, 1][f][x1, x2]))/ DHH) - (Dt[w2]*(t*Derivative[1, 0][f][x1, x2]* Derivative[1, 1][f][x1, x2] - t*Derivative[0, 1][f][x1, x2]*Derivative[2, 0][f][x1, x2]))/ DHH - (Dt[y]*(-(t^2*Derivative[1, 1][f][x1, x2]^2) + t^2*Derivative[0, 2][f][x1, x2]*Derivative[2, 0][f][x1, x2]))/ DHH}}\ \>", "\<\ (0,1) 2 Dt[w1] f [x1, x2] {{Dt[x1] -> ---------------------- - DHH (0,1) (1,0) Dt[w2] f [x1, x2] f [x1, x2] ------------------------------------ - DHH (0,2) (1,0) (Dt[y] (-(t f [x1, x2] f [x1, x2]) + (0,1) (1,1) t f [x1, x2] f [x1, x2])) / DHH, (0,1) (1,0) Dt[w1] f [x1, x2] f [x1, x2] Dt[x2] -> -(------------------------------------) + DHH (1,0) 2 Dt[w2] f [x1, x2] ---------------------- - DHH (1,0) (1,1) (Dt[y] (t f [x1, x2] f [x1, x2] - (0,1) (2,0) t f [x1, x2] f [x1, x2])) / DHH, (0,2) (1,0) Dt[t] -> -((Dt[w1] (-(t f [x1, x2] f [x1, x2]) + (0,1) (1,1) t f [x1, x2] f [x1, x2])) / DHH) - (1,0) (1,1) (Dt[w2] (t f [x1, x2] f [x1, x2] - (0,1) (2,0) t f [x1, x2] f [x1, x2])) / DHH - 2 (1,1) 2 2 (0,2) (2,0) Dt[y] (-(t f [x1, x2] ) + t f [x1, x2] f [x1, x2]) ----------------------------------------------------------------}} DHH\ \>"], "Output", ImageRegion->{{0, 1}, {0, 1}}] }, Open ]], Cell["\<\ Note that the denominators in the expressions for dx1 and dx2 are negative \ due to the second-order conditions. The numerators in these expressions are \ positive. It follows that dx1/dw1 and dx2/dw2 are negative. Note that there is more information in these expressions than in the standard \ comparative statics results. Mathematica has made comparative statics \ calculations (almost) painless! \ \>", "Text", ImageRegion->{{0, 1}, {0, 1}}, FontSize->14] }, FrontEndVersion->"4.1 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{499, 599}, WindowMargins->{{Automatic, 3}, {Automatic, 0}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False} ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1705, 50, 160, 5, 101, "Title"], Cell[1868, 57, 91, 5, 122, "Subtitle"], Cell[1962, 64, 509, 13, 115, "Text"], Cell[2474, 79, 329, 5, 134, "Special1"], Cell[2806, 86, 68, 1, 59, "Section"], Cell[2877, 89, 449, 9, 134, "Text"], Cell[CellGroupData[{ Cell[3351, 102, 60, 1, 70, "Input"], Cell[3414, 105, 225, 6, 70, "Output"] }, Open ]], Cell[3654, 114, 519, 13, 70, "Text"], Cell[CellGroupData[{ Cell[4198, 131, 76, 1, 70, "Input"], Cell[4277, 134, 306, 9, 70, "Output"] }, Open ]], Cell[4598, 146, 426, 9, 70, "Text"], Cell[CellGroupData[{ Cell[5049, 159, 56, 1, 70, "Input"], Cell[5108, 162, 305, 10, 70, "Output"] }, Open ]], Cell[5428, 175, 67, 1, 70, "Subsection"], Cell[5498, 178, 655, 15, 70, "Text"], Cell[CellGroupData[{ Cell[6178, 197, 86, 1, 70, "Input"], Cell[6267, 200, 321, 11, 70, "Output"] }, Open ]], Cell[6603, 214, 214, 6, 70, "Text"], Cell[6820, 222, 65, 1, 70, "Section"], Cell[6888, 225, 225, 8, 70, "Text"], Cell[7116, 235, 257, 12, 70, "Text"], Cell[7376, 249, 135, 5, 70, "Text"], Cell[CellGroupData[{ Cell[7536, 258, 153, 5, 70, "Input"], Cell[7692, 265, 2279, 50, 70, "Output"] }, Open ]], Cell[9986, 318, 732, 13, 70, "Text"], Cell[10721, 333, 81, 1, 70, "Subsection"], Cell[10805, 336, 360, 9, 70, "Text"], Cell[CellGroupData[{ Cell[11190, 349, 106, 1, 70, "Input"], Cell[11299, 352, 440, 12, 70, "Output"] }, Open ]], Cell[11754, 367, 92, 1, 70, "Text"], Cell[CellGroupData[{ Cell[11871, 372, 56, 1, 70, "Input"], Cell[11930, 375, 342, 11, 70, "Output"] }, Open ]], Cell[12287, 389, 109, 2, 70, "Text"], Cell[CellGroupData[{ Cell[12421, 395, 72, 1, 70, "Input"], Cell[12496, 398, 312, 7, 70, "Output"] }, Open ]], Cell[12823, 408, 257, 7, 70, "Text"], Cell[CellGroupData[{ Cell[13105, 419, 160, 5, 70, "Input"], Cell[13268, 426, 1230, 30, 70, "Output"] }, Open ]], Cell[14513, 459, 88, 1, 70, "Text"], Cell[14604, 462, 71, 1, 70, "Section"], Cell[14678, 465, 239, 8, 70, "Text"], Cell[CellGroupData[{ Cell[14942, 477, 175, 5, 70, "Input"], Cell[15120, 484, 1685, 38, 70, "Output"] }, Open ]], Cell[16820, 525, 198, 6, 70, "Text"], Cell[17021, 533, 76, 1, 70, "Section"], Cell[17100, 536, 238, 8, 70, "Text"], Cell[17341, 546, 86, 2, 70, "Text"], Cell[CellGroupData[{ Cell[17452, 552, 94, 1, 70, "Input"], Cell[17549, 555, 155, 5, 70, "Output"] }, Open ]], Cell[17719, 563, 80, 2, 70, "Text"], Cell[CellGroupData[{ Cell[17824, 569, 270, 5, 70, "Input"], Cell[18097, 576, 671, 16, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[18805, 597, 56, 1, 70, "Input"], Cell[18864, 600, 539, 15, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[19440, 620, 194, 6, 70, "Input"], Cell[19637, 628, 2755, 72, 70, "Output"] }, Open ]], Cell[22407, 703, 476, 11, 70, "Text"] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)