(*^ ::[paletteColors = 128; automaticGrouping; 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; ] Econometrics :[font = subsubtitle; inactive; preserveAspect; ] Hal Varian January 1992 :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Goodness of Fit :[font = text; inactive; preserveAspect; ] Let's see how to measure goodness-of-fit, using the Cobb-Douglas money metric utility function. Recall that this function is given by: :[font = input; preserveAspect; ] m[p1_,p2_,x1_,x2_] := 2 p1^(1/2)p2^(1/2)x1^(1/2)x2^(1/2) :[font = text; inactive; preserveAspect; ] Let's generate some Cobb-Douglas demand data and perturb it by a random variable. We'll fix income at 100 and p2 at 1, and let p1 range from 1 to 10. ;[s] 5:0,0;111,1;113,2;128,3;130,4;151,-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; ] x1Data=Table[N[100/(2 p1)],{p1,1,10}] errorTerm=Table[Random[]/5,{p1,1,10}] x1DataPerturbed=x1Data*(1+errorTerm) x2Data=Table[100/2,{p1,1,10}] :[font = text; inactive; preserveAspect; ] We want to make sure that the budget constraint is satisfied by the perturbed data. Hence we multiply the second demand by (1-errorTerm). We check the budget constraint next, to make sure we've done it right. ;[s] 3:0,0;124,1;137,2;211,-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; ] x2DataPerturbed=x2Data*(1-errorTerm) x1DataPerturbed*Table[p1,{p1,1,10}] + x2DataPerturbed :[font = text; inactive; preserveAspect; ] Now we can compute the goodness of fit measures. :[font = input; preserveAspect; ] Table[N[m[i,1,x1DataPerturbed[[i]],x2DataPerturbed[[i]]]], {i,1,10}] :[font = text; inactive; preserveAspect; endGroup; ] Note how close the values are to full efficiency. We can have quite large perturbations of the data, and still be pretty close to optimizing behavior. :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Agricultural economics :[font = text; inactive; preserveAspect; ] Here we give a numerical example of the phenomenon described in the text. We have a number of farmers who want to maximize profits :[font = input; preserveAspect; ] profit[p_,q_,Q_,K_,S_] := p Q K^(1/2)S^(1/2) - q K :[font = input; preserveAspect; startGroup; ] profit[p,q,Q,K,S] :[font = output; output; inactive; preserveAspect; endGroup; ] -(K*q) + K^(1/2)*p*Q*S^(1/2) ;[o] -(K q) + Sqrt[K] p Q Sqrt[S] :[font = text; inactive; preserveAspect; ] Solve for the profit-maximizing demand and output: :[font = input; preserveAspect; startGroup; ] solution=Solve[D[profit[p,q,Q,K,S],K]==0,K][[1]] K[p_,q_,Q_,S_] := Evaluate[K/.solution] K[p,q,Q,S] Y[p_,q_,Q_,S_] := Evaluate[ PowerExpand[Q K^(1/2)S^(1/2)/.solution]] Y[p,q,Q,S] :[font = output; output; inactive; preserveAspect; ] {K -> (p^2*Q^2*S)/(4*q^2)} ;[o] 2 2 p Q S {K -> -------} 2 4 q :[font = output; output; inactive; preserveAspect; ] (p^2*Q^2*S)/(4*q^2) ;[o] 2 2 p Q S ------- 2 4 q :[font = output; output; inactive; preserveAspect; endGroup; ] (p*Q^2*S)/(2*q) ;[o] 2 p Q S ------ 2 q :[font = text; inactive; preserveAspect; ] (The PowerExpand operator puts the answer into a simpler form.) ;[s] 3:0,0;5,1;16,2;64,-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 = text; inactive; preserveAspect; ] Now we'll generate some data for farms with high-quality land (Q=10) and for farms with low-quality land (Q=2). First we'll generate some prices: ;[s] 5:0,0;62,1;68,2;105,3;110,4;149,-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; ] nObs=100; outputPrice=Table[Random[],{i,1,nObs}]; inputPrice=Table[Random[],{i,1,nObs}]; sunnyDays=Table[Random[],{i,1,nObs}]; :[font = input; preserveAspect; ] highData=Transpose[{Log[K[outputPrice,inputPrice,10,sunnyDays]], Log[Y[outputPrice,inputPrice,10,sunnyDays]]}]; lowData=Transpose[{Log[K[outputPrice,inputPrice,2,sunnyDays]], Log[Y[outputPrice,inputPrice,2,sunnyDays]]}]; :[font = text; inactive; preserveAspect; ] Now we'll fit the data for each quality of land separately. :[font = input; preserveAspect; startGroup; ] Fit[highData,{1,logK},logK] Fit[lowData,{1,logK},logK] :[font = output; output; inactive; preserveAspect; ] 1.643494422115747 + 0.5550052067058297*logK ;[o] 1.64349 + 0.555005 logK :[font = output; output; inactive; preserveAspect; endGroup; ] 0.2111114397889185 + 0.5550052067058291*logK ;[o] 0.211111 + 0.555005 logK :[font = text; inactive; preserveAspect; ] Notice that we get the same answer---something pretty close to the correct value of 0.5. But now let's put the data together and try the same operation. ;[s] 3:0,0;85,1;88,2;155,-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; startGroup; ] allData=Join[highData,lowData]; Fit[allData,{1,logK},logK] :[font = output; output; inactive; preserveAspect; endGroup; ] 0.83921329281461 + 0.6500026259425358*logK ;[o] 0.839213 + 0.650003 logK :[font = text; inactive; preserveAspect; ] Note the upward bias in the estimated parameter. We can do a scatterplot to see what's happening. The true production relationship is logY=logQ + logK/2, so we add this to the graph for Q=2 and Q=10. ;[s] 7:0,0;136,1;154,2;188,3;191,4;196,5;200,6;202,-1; 7: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; ] lowPlot=ListPlot[lowData,PlotStyle->AbsolutePointSize[3], Epilog->{Line[{{5,Log[2]+5/2},{-10.0,Log[2]-10/2}}], Line[{{5,Log[10]+5/2},{-10.0,Log[10]-10/2}}]}] highPlot=ListPlot[highData,PlotStyle->AbsolutePointSize[5], Epilog->{Line[{{5,Log[10]+5/2},{-10.0,Log[10]-10/2}}], Line[{{5,Log[2]+5/2},{-10.0,Log[2]-10/2}}]}] Show[{highPlot,lowPlot},{lowPlot,highPlot}] :[font = text; inactive; preserveAspect; ] Each true production function fits the data well, but when we put the two sets of data together, the fitted regression line will be too steep. :[font = subsection; inactive; preserveAspect; startGroup; ] Estimating the factor demand functions :[font = text; inactive; preserveAspect; ] Let's see if we can get better estimates by estimating the factor demand function rather than the production function. First we solve for the factor demand when the parameters of the production function are unknown. :[font = input; preserveAspect; startGroup; ] profit[p_,q_,Q_,K_,S_] := p Q K^a S^b - q K D[profit[p,q,Q,K,S],K] :[font = output; output; inactive; preserveAspect; endGroup; ] -q + a*K^(-1 + a)*p*Q*S^b ;[o] -1 + a b -q + a K p Q S :[font = text; inactive; preserveAspect; ] Mathematica has difficulty solving this equation, since it wants to find all solutions, not just the real solutions that we care about. But if we solve it by hand, we find that Log[k] = (1/(1-a)) log(q/p) + constant + error term To run this regression we need a new variable, and we need to extract Log[K] from allData. To extract Log[K], we Transpose the list of data and take the first list using Take[Transpose[allData,1]]]. Then we join this with the new variable we need ;[s] 14:0,0;11,1;192,2;243,3;315,4;321,5;327,6;334,7;348,8;354,9;359,10;368,11;416,12;443,13;494,-1; 14: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;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;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = text; inactive; preserveAspect; ] Remember, we have to have two copies of the prices... :[font = input; preserveAspect; startGroup; ] priceRatio=Join[Log[outputPrice/inputPrice], Log[outputPrice/inputPrice]]; newData=Transpose[{priceRatio, Take[Transpose[allData],1][[1]]}]; Fit[newData,{1,logPratio},logPratio] :[font = output; output; inactive; preserveAspect; endGroup; ] 0.5699842184481958 + 2.001895091262409*logPratio ;[o] 0.569984 + 2.0019 logPratio :[font = input; preserveAspect; startGroup; ] estimatedValueOfa= 1-(1/1.8993) :[font = output; output; inactive; preserveAspect; endGroup; ] 0.4734902332438267 ;[o] 0.47349 :[font = text; inactive; preserveAspect; endGroup; endGroup; ] Note how this value is much closer to the true value of 0.5. [By the way, all of these statements are statistical statements, so every now and then this won't be true. Run through these calculations again if this happens to you...] :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Diewert Cost function :[font = text; inactive; preserveAspect; ] Here is the unit cost function for a special cast of the Diewert cost function. We want to determine the shape of the isoquants as a function of the parameters. The most interesting parameter is the curvature parameter :[font = input; preserveAspect; ] Clear[b] c[w1_,w2_,b_] := w1 + w2 + 2 b Sqrt[w1 w2] :[font = text; inactive; preserveAspect; ] The conditional factor demands are :[font = input; preserveAspect; startGroup; ] h1[w1_,w2_,b_] := Evaluate[D[c[w1,w2,b],w1]] h2[w1_,w2_,b_] := Evaluate[D[c[w1,w2,b],w2]] {h1[w1,w2,b],h2[w1,w2,b]} :[font = output; output; inactive; preserveAspect; endGroup; ] {1 + (b*w2)/(w1*w2)^(1/2), 1 + (b*w1)/(w1*w2)^(1/2)} ;[o] b w2 b w1 {1 + -----------, 1 + -----------} Sqrt[w1 w2] Sqrt[w1 w2] :[font = text; inactive; preserveAspect; ] Normalize w2=1 and plot (h1,h2), letting w1 vary. We'll let the parameter b vary from b=1 to b=10. ;[s] 13:0,0;10,1;14,2;23,3;31,4;41,5;43,6;74,7;76,8;87,9;90,10;94,11;98,12;100,-1; 13: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;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; ] Do[ ParametricPlot[{h1[w1,1,b],h2[w1,1,b]},{w1,0.1,200}, PlotLabel->b,AspectRatio->Automatic, PlotRange->{{0,30},{0,30}}], {b,1,10} ] :[font = text; inactive; preserveAspect; endGroup; endGroup; ] From these diagrams it is easy to see that increasing b will tend to make the isoquantsflatter. ;[s] 3:0,0;54,1;55,2;96,-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; ^*)