(*^ ::[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; ] Utility Maximization :[font = section; inactive; Cclosed; preserveAspect; startGroup; ] Cobb-Douglas system :[font = text; inactive; preserveAspect; ] Let's calculate the factor demands for the Cobb-Douglas utility function. :[font = input; preserveAspect; ] u[x1_,x2_] := x1*x2 L= u[x1,x2]- lambda*(p1 x1 + p2 x2 - m) firstOrder={D[L,x1]==0,D[L,x2]==0,D[L,lambda]==0} solution=Solve[{D[L,x1]==0,D[L,x2]==0,D[L,lambda]==0}, {x1,x2,lambda}][[1]] :[font = text; inactive; preserveAspect; ] Here's the indirect utility function: :[font = input; preserveAspect; ] v[p1_,p2_,m_] := Evaluate[u[x1,x2]/.solution] v[p1,p2,m] :[font = text; inactive; preserveAspect; ] Now check Roy's identity: :[font = input; preserveAspect; ] {-D[v[p1,p2,m],p2]/D[v[p1,p2,m],m],-D[v[p1,p2,m],p1]/D[v[p1,p2,m],m]} :[font = text; inactive; preserveAspect; ] Here are plots of the indirect utility function with respect to y and (p1,p2): ;[s] 5:0,0;64,1;66,2;70,3;77,4;79,-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; ] Plot[v[1,1,m],{m,1,50}] :[font = input; preserveAspect; ] ContourPlot[v[p1,p2,10],{p1,1,10},{p2,1,10}] :[font = text; inactive; preserveAspect; ] To find the expenditure function, we solve the indirect utility function for m. ;[s] 3:0,0;77,1;78,2;80,-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; ] solution=Solve[v[p1,p2,m]==u,m][[1]] :[font = input; preserveAspect; ] e[p1_,p2_,u_] = Evaluate[m/.solution] :[font = text; inactive; preserveAspect; ] To find the money metric utility functions, just substitute: :[font = input; preserveAspect; ] m[p1_,p2_,x1_,x2_] := e[p1,p2,u]/.{u->u[x1,x2]} m[p1,p2,x1,x2] :[font = text; inactive; preserveAspect; ] Here's the indirect money metric utility function: :[font = input; preserveAspect; ] mu[p1_,p2_,q1_,q2_,m] := e[p1,p2,u]/.{u->v[q1,q2,m]} :[font = input; preserveAspect; endGroup; endGroup; ] mu[p1,p2,q1,q2,m] ^*)