(*^ ::[paletteColors = 128; automaticGrouping; magnification = 150; currentKernel; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakBelow, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = Left Header, nohscroll, cellOutline, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, L1, 12; fontset = Left Footer, cellOutline, blackBox, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; next21StandardFontEncoding; ] :[font = title; inactive; preserveAspect; startGroup; ] Profit Maximization :[font = subsubtitle; inactive; preserveAspect; ] Hal R. Varian January, 1992 :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Maximizing profit :[font = text; inactive; preserveAspect; ] Let's find the profit-maximizing choice for the production function x^(1/2). We start by defining the production function ;[s] 3:0,0;68,1;75,2;122,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] f[x_] := x^(1/2) :[font = text; inactive; preserveAspect; ] Profits as a function of x are ;[s] 3:0,0;25,1;27,2;31,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Profit[x_,p_,w_] := p f[x] - w x :[font = text; inactive; preserveAspect; ] Let's plot this for p=w=1: ;[s] 3:0,0;19,1;25,2;27,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Plot[Profit[x,1,1],{x,.001,1}] :[font = text; inactive; preserveAspect; ] In order to find the profit-maximizing level of input, we solve for that x that makes the derivative of profit equal to zero: :[font = input; preserveAspect; ] Solve[D[Profit[x,1,1],x]==0,x] :[font = text; inactive; preserveAspect; ] Note that the solutions to Solve are a list of solutions; in this case the list has only one element in it: 1/4. In order to find the input demand function, we can do this same calculation for arbitrary values of p and w: ;[s] 9:0,0;27,1;32,2;108,3;111,4;215,5;216,6;221,7;222,8;223,-1; 9:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Solve[D[Profit[x,p,w],x]==0,x] :[font = text; inactive; preserveAspect; ] Of course, we should always check the second-order condition to make sure that we really have a maximum. :[font = input; preserveAspect; ] D[Profit[x,p,w],{x,2}] :[font = text; inactive; preserveAspect; ] When x is positive, this is certainly a negative number ;[s] 3:0,0;5,1;6,2;56,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup; ] The profit function :[font = text; inactive; preserveAspect; ] Finally, we want to calculate the profit function for this technology. In order to do that, we take the the expression for profit and substitute the optimized value of x. In Mathematica, you substitute for a value by using the notation /. ;[s] 6:0,0;170,1;172,2;177,3;188,4;239,5;242,-1; 6:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0; :[font = input; preserveAspect; endGroup; endGroup; ] Profit[x,p,w]/.{x->p^2/(4 w^2)} :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] The Cobb-Douglas profit function :[font = text; inactive; preserveAspect; ] We can do the same sort of thing when there are several factors. For example, consider the Cobb-Douglas technology :[font = input; preserveAspect; ] f[x1_,x2_] := x1^(1/4) x2^(1/4) :[font = text; inactive; preserveAspect; ] The profit function is :[font = input; preserveAspect; ] Profit[x1_,x2_,p_,w1_,w2_] := p f[x1,x2] - w1 x1 - w2 x2 :[font = text; inactive; preserveAspect; ] We can plot profits as a function of the inputs, with prices all fixed at 1. We will do both a 3-D plot and a contour plot: :[font = input; preserveAspect; ] Plot3D[Profit[x1,x2,20,1,1],{x1,0.01,80},{x2,0.01,80},Lighting->False, ViewPoint->{2.107, -2.506, 0.854}] :[font = input; preserveAspect; ] ContourPlot[Profit[x1,x2,20,1,1],{x1,0.01,80},{x2,0.01,80}, ContourShading->False] :[font = text; inactive; preserveAspect; ] Let's solve for the optimal value of the two factor inputs. Just as before, we take the derivatives with respect to each input, set them equal to zero, and then solve the resulting system of equations. This time we'll give the solution a name so we can use it later :[font = input; preserveAspect; ] solution=Solve[{D[Profit[x1,x2,1,1,1],x1]==0, D[Profit[x1,x2,1,1,1],x2]==0},{x1,x2}] :[font = text; inactive; preserveAspect; ] Notice that we have two solutions; only the positive one makes economic sense. We select it by using [[1]] to take the first element of the list. :[font = input; preserveAspect; ] solution[[1]] :[font = text; inactive; preserveAspect; ] We can do the same calculation for arbitrary values of p, w1 and w2. Since we know that we'll get two answers, we'll select the first one right off the bat and call it solution :[font = input; preserveAspect; ] solution = Solve[{D[Profit[x1,x2,p,w1,w2],x1]==0, D[Profit[x1,x2,p,w1,w2],x2]==0}, {x1,x2}][[1]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup; ] The profit function :[font = text; inactive; preserveAspect; ] To find the profit function, we just substitute this solution back into the definition of profit: :[font = input; Cclosed; preserveAspect; startGroup; ] Profit[x1,x2,p,w1,w2]/.% :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup; ] (p*(p^2/(w1^(1/2)*w2^(3/2)))^(1/4)*(p^2/(w1^(3/2)*w2^(1/2)))^(1/4))/ 4 - p^2/(8*w1^(1/2)*w2^(1/2)) ;[o] 2 2 p 1/4 p 1/4 p (--------------) (--------------) 3/2 3/2 2 Sqrt[w1] w2 w1 Sqrt[w2] p ----------------------------------------- - ------------------- 4 8 Sqrt[w1] Sqrt[w2] :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Comparative statics :[font = text; inactive; preserveAspect; ] Once we have solved for an optimal choice, we want to see how it responds to changes in the economic environment. In the current context that means examining how the demand functions respond to changes in prices. In Mathematica the easiest way to do is is by using total derivatives. Consider a function g[x,a]. The first-order condition that a maximum value of x must satisfy is ;[s] 5:0,0;219,1;230,2;308,3;314,4;385,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] D[g[x,a],x]==0 :[font = text; inactive; preserveAspect; ] Totally differentiating this gives us :[font = input; Cclosed; preserveAspect; startGroup; ] Dt[D[g[x,a],x]]==0 :[font = output; output; inactive; preserveAspect; endGroup; ] Dt[a]*Derivative[1, 1][g][x, a] + Dt[x]*Derivative[2, 0][g][x, a] == 0 ;[o] (1,1) (2,0) Dt[a] g [x, a] + Dt[x] g [x, a] == 0 :[font = text; inactive; preserveAspect; ] Note the notation Mathematica uses. Dt[a] would be written da in standard notation. (1,1) 2 2 g [x,a] would be d g(x,a)/dx, the second derivative. Solving this for dx=Dt[x] gives us the answer we are after ;[s] 15:0,0;18,1;29,2;37,3;42,4;60,5;62,6;90,7;95,8;157,9;168,10;178,11;189,12;233,13;241,14;274,-1; 15:1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,0,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,3,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,0,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,0,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,3,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; Cclosed; preserveAspect; startGroup; ] Solve[Dt[D[g[x,a],x]]==0,Dt[x]] :[font = output; output; inactive; preserveAspect; endGroup; ] {{Dt[x] -> -((Dt[a]*Derivative[1, 1][g][x, a])/ Derivative[2, 0][g][x, a])}} ;[o] (1,1) Dt[a] g [x, a] {{Dt[x] -> -(------------------)}} (2,0) g [x, a] :[font = text; inactive; preserveAspect; ] In classical notation, this simply says that g 12 dx = -da --- g11 ;[s] 5:0,0;79,1;103,2;105,3;215,4;217,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,10,8,Times,65,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,10,8,Times,65,12,0,0,0; :[font = text; inactive; preserveAspect; ] Since we know that the denominator of this expression is negative because of the second-order conditions, the sign of the entire expression is determined by the mixed partial derivative in the numerator. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup; ] Profit maximization with one input :[font = text; inactive; preserveAspect; ] Let's apply this to a profit maximization problem. We have :[font = input; preserveAspect; ] Profit[x_,p_,w_] := p f[x] - w x :[font = text; inactive; preserveAspect; ] Take the derivative of this expression and solve for Dt[x]. ;[s] 3:0,0;53,1;58,2;60,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Solve[Dt[D[Profit[x,p,w],x]]==0,Dt[x]] :[font = text; inactive; preserveAspect; endGroup; endGroup; ] This expression shows us that x decrease when w increases and increases when p increases. ;[s] 8:0,0;30,1;31,2;32,3;46,4;47,5;77,6;78,7;90,-1; 8:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Maximization with several variables :[font = text; inactive; preserveAspect; ] The same logic applies if there are several variables. The only tricky part is that the second order condition is messier. Suppose that we have a function f[x1,x2,a] and we want to know how x1 and x2 respond to changes in a. The FOCs are :[font = input; preserveAspect; ] FOC={D[f[x1,x2,a],x1]==0, D[f[x1,x2,a],x2]==0} :[font = text; inactive; preserveAspect; ] Take the derivative of this list with respect to a and solve for Dt[x1] and Dt[x2] ;[s] 5:0,0;65,1;71,2;76,3;81,4;83,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Solve[Dt[FOC],{Dt[x1],Dt[x2]}] :[font = text; inactive; preserveAspect; ] This expression is somewhat messy. Luckily, the denominators in this expression are simply the determinant of the Hessian matrix of f. We will verify this by direct calculation: ;[s] 3:0,0;133,1;135,2;179,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] hess={{D[f[x1,x2,a],x1,x1], D[f[x1,x2,a],x1,x2]}, {D[f[x1,x2,a],x2,x1], D[f[x1,x2,a],x2,x2]}} :[font = input; preserveAspect; ] MatrixForm[hess] :[font = input; preserveAspect; ] detHess=-Det[hess] :[font = text; inactive; preserveAspect; ] Now substitute solve for Dt[x1] and Dt[x2] again, substituting back into the total differential ;[s] 5:0,0;25,1;31,2;36,3;42,4;96,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; ] Solve[Dt[FOC],{Dt[x1],Dt[x2]}]/.{detHess->HH} :[font = text; inactive; preserveAspect; ] Just as before, the response of the choice variable to the parameter depends on the mixed partial derivatives, and the sign of the denominator is determined automatically by the second order conditions. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup; ] Profit maximization with two factors :[font = text; inactive; preserveAspect; ] Now let h[x1,x2] be the production function and totally differentiate the FOCs :[font = input; preserveAspect; ] solution= 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]] :[font = text; inactive; preserveAspect; ] The determinant of the Hessian is just as before; we'll compute it and substitute it in as before: :[font = input; preserveAspect; ] detHess=-Det[{{D[h[x1,x2],x1,x1], D[h[x1,x2],x1,x2]}, {D[h[x1,x2],x2,x1], D[h[x1,x2],x2,x2]}}] :[font = input; preserveAspect; ] solution/.{detHess->HH} :[font = text; inactive; preserveAspect; endGroup; endGroup; endGroup; ] This gives us a very simple expression for the comparative statics result: the change in x1 is the change in w1 times the second derivative of the production function with respect to x2 plus the change in w2 times the cross partial. ;[s] 9:0,0;89,1;91,2;109,3;111,4;182,5;185,6;205,7;207,8;233,-1; 9:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; ^*)