Chapter 4

[1]-[9]

[1]

Do[Plot3D[(x1^a) (x2^(1 - a)), {x1, 0, 4}, {x2, 0, 4}, 
        BoxRatios -> {1, 1, 1}, ViewPoint -> {-1, -2, 1}, 
        AxesLabel -> {"x1", "x2", "y"}, 
        PlotLabel -> {"a", a}], {a, 0.1, 0.9, 0.1}]

[2]

Do[Plot3D[Max[a x1, (1 - a) x2], {x1, 0, 4}, {x2, 0, 4}, 
        BoxRatios -> {1, 1, 1}, ViewPoint -> {-1, -2, 1}], {
        a, 0.1, 0.9, 0.1}]

[4]

ContourPlot[(x1^0.6) (x2^0.4), {x1, 0, 4}, {x2, 0, 4}]

[5]

ContourPlot[Min[x1, x2] 4, {x1, 0, 4}, {x2, 0, 4}]

[6]

f[x1_, x2_] := (x1^(2/5)) (x2^(3/5)); MRTS[x1_, x2_]=-((Derivative[1, 0][f][x1, x2])/(Derivative[0, 1][f][x1, x2]))

[7]

mrts[productionfunction_]:=Module[{},f[x1_, x2_] := productionfunction[x1, x2];-((Derivative[1, 0][f][x1, x2])/(Derivative[0, 1][f][x1, x2]))]

[8]

mrts[#(1^(3/7)) #(2^(4/7))&]

[9]

[10]-[19]

[10]

mrts2[productionfunction_]:=Module[{f, df, g1, g2},f[x1_, x2_] := productionfunction[x1, x2];df[m_, n_]:=Derivative[m, n][f][x1, x2];g1 = df[2, 0] df[0, 1]^2 - 2 df[1, 0] df[0, 1] df[1, 1] + 
                df[0, 2] df[1, 0]^2;g2 = df[0, 1]^3;(g1/g2)]

[11]

mrts2[#(1^(3/7)) #(2^(4/7))&]

[12]

productcurve[productionfunction_, fix2_] := 
      Module[{f}, f[x1_, x2_] := productionfunction[x1, x2]; 
        Plot[f[x1, fix2], {x1, 0, 4}, GridLines -> Automatic, 
          AxesLabel -> {"x1", "y"}, 
          PlotLabel -> {"x2", fix2}]]

[13]

productcurve[#(1^(3/7)) #(2^(4/7))&, 3]

[14]

marginalproducts[productionfunction_]:=Module[{f},f[x1_, x2_] := productionfunction[x1, x2];mr1=Derivative[1, 0][f][x1, x2];mr2=Derivative[0, 1][f][x1, x2];{mr1, mr2}]

[15]

marginalproducts[#(1^(3/7)) #(2^(4/7))&]

[16]

f[x1_, x2_] := (x1^(1/3)) (x2^(1/3)); Plot3D[f[x1, x2], {x1, 0, 5}, {x2, 0, 5}, BoxRatios -> {1, 1, 1}, 
      HiddenSurface -> False]

[17]

f[x1_, x2_] := (x1^(1/3)) (x2^(1/3)); productf = Table[Line[{{x1, 3, 0}, {x1, 3, f[x1, 3]}}], {x1, 0, 5, 0.1}]; 
    y[x1_]:=Derivative[1, 0][f][2, 3] (x1 - 2)+f[2, 3];marginalp = Line[{{0, 3, y[0]}, {5, 3, y[5]}}]; averagep = Line[{{0, 3, 0}, {2, 3, f[2, 3]}}]; Show[Graphics3D[{marginalp, 
          averagep, {Thickness[0.00001], Dashing[{0.01}], productf}}], 
      BoxRatios -> {1, 1, 1}, Axes -> True, 
      PlotRange -> {0, f[5, 5]}]

[18]

Show[%, ViewPoint -> {0, -1000, 0}]

[19]

f[x1_, x2_] := (x1^(1/3)) (x2^(1/3)); MP1=Derivative[1, 0][f][x1, 3];AP1 = f[x1, 3]/x1; Plot[{MP1, AP1}, {x1, 0.1, 3}, PlotRange -> {0, 3}, 
      AspectRatio -> 1, PlotStyle -> {{}, Dashing[{0.01}]}]

[20]-[29]

[20]

mpap[productf_]:=Module[{f, MP1, AP1},f[x1_, x2_] := productf[x1, x2];MP1=Derivative[1, 0][f][x1, 3];AP1 = f[x1, 3]/x1;gr1 = Plot3D[f[x1, x2], {x1, 0, 5}, {x2, 0, 5}, 
                BoxRatios -> {1, 1, 1}, DisplayFunction -> Identity]
                ;product = 
              Table[Line[{{x1, 3, 0}, {x1, 3, f[x1, 3]}}], {x1, 0, 5, 0.1}]
                ;averagep = Line[{{0, 3, 0}, {2, 3, f[2, 3]}}];y[x1_]:=Derivative[1, 0][f][2, 3] (x1 - 2)+f[2, 3];marginalp = Line[{{0, 3, y[0]}, {5, 3, y[5]}}];gr2 = Show[
                Graphics3D[{averagep, 
                    marginalp, {Thickness[0.00001], Dashing[{0.01}], 
                      product}}], BoxRatios -> {1, 1, 1}, 
                Axes -> True, PlotRange -> {0, 1.3 f[5, 5]}, 
                ViewPoint -> {0, -1000, 0}, 
                DisplayFunction -> Identity];gr3 = Plot[{MP1, AP1}, {x1, 0.1, 4}, PlotRange -> {0, 4}, 
                AspectRatio -> 1, 
                PlotStyle -> {{}, Dashing[{0.01}]}, 
                DisplayFunction -> Identity];Show[GraphicsArray[{gr1, gr2, gr3}, 
                DisplayFunction -> $DisplayFunction]]]

[21]

mpap[#(1^(3/2)) #(2^(1/3))&]

[22]

mpap[(1 - Cos[#(1/1.3)]) (1 - Cos[#(2/1.3)])&]

[23]

returnstoscale[function_] := 
      Module[{f, x1, x2, x22, sen1, sen2, ten}, 
        f[x1_, x2_] := function[x1, x2]; x2 = 0.3 x1; 
        sen1 = Table[
            Line[{{x1, x2, 0}, {x1, x2, f[x1, x2]}}], {x1, 0, 5, 0.2}]; 
        sen2 = Table[Line[{{x1, 2, 0}, {x1, 2, f[x1, 2]}}], {x1, 0, 5, 0.2}]; 
        ten = {PointSize[0.003], 
            Table[Point[{x1, x22, f[x1, x22]}], {x1, 0, 5, 0.2}, {x22, 0, 5, 
                0.2}]}; 
        Show[Graphics3D[{sen1, sen2, ten}], BoxRatios -> {1, 1, 1}, 
          Axes -> True, AxesLabel -> {"x1", "x2", "y"}, 
          ViewPoint -> {1, -2, 1.2}]]

[24]

returnstoscale[#(1^(3/4)) #(2^(2/3))&]

[25]

returnstoscale[#(1^(1/3)) #(2^(2/3))&]

[26]

returnstoscale[#(1^(1/4)) #(2^(1/3))&]

[27]

elasticityofscale[function_]:=Module[{f, y, e},f[x1_, x2_] := function[x1, x2];y[t_] := f[t x1, t x2];e=Simplify[((y'[1])/(y[1]))]]

[28]

elasticityofscale[#(1^(1/3)) #(2^(1/4))&]

[29]

elasticityofscale[#(1^(2/3)) #(2^(3/4))&]

[30]

elasticityofscale[#(1^(1/3)) #(2^(2/3))&]

[31]

elasticityofscale[#(1^a) #(2^b)&]

[32]

<< "Graphics`ImplicitPlot`"; homothetic[function_]:=Module[{f, gr1, gr, m},f[x1_, x2_] := function[x1, x2];gr1 = ImplicitPlot[{f[x1, x2] == f[5, 2.5], 
                  f[x1, x2] == f[10, 5], f[x1, x2] == f[15, 7.5]}, {x1, 0, 
                  20}, DisplayFunction -> Identity];m[x1_, x2_]:=-((Derivative[1, 0][f][x1, x2])/(Derivative[0, 1][f][x1, x2]));gr[x1_, x2_] := 
              Plot[m[x1, x2] (x - x1) + x2, {x, 0, 20}, 
                DisplayFunction -> Identity];Show[{gr1, gr[5, 2.5], gr[10, 5], gr[15, 7.5]}, 
              DisplayFunction -> $DisplayFunction, 
              PlotRange -> {0, 20}]]

[33]

homothetic[#(1^(2/3)) #(2^(1/3))&]

[34]

profitmax[function_, p_, w1_, w2_]:=Module[{f, gr1, gr2, x1, x2, sol},f[x1_, x2_] := function[x1, x2];sol=NSolve[{p Derivative[1, 0][f][x1, x2]==w1,p Derivative[0, 1][f][x1, x2]==w2},{x1, x2}];x10 = x1 /. sol[[1]];x20 = 
              x2 /. sol[[1]];gr1 = {PointSize[0.003], 
                Table[Point[{x1, x2, f[x1, x2]}], {x1, 0, 2, 0.05}, {x2, 0, 
                    2, 0.05}]};g[x1_, x2_] := 
              ((w1 (x1 - x10))/p) + ((w2 (x2 - x20))/p) + 
                f[x10, x20];gr2 = {Thickness[0.0005], 
                Table[Line[{{k, 0, g[k, 0]}, {k, 2, g[k, 2]}}], {k, 0, 2, 
                    0.2}]};gr3 = {Thickness[0.0005], 
                Table[Line[{{0, m, g[0, m]}, {2, m, g[2, m]}}], {m, 0, 2, 
                    0.2}]};Show[Graphics3D[{gr1, gr2, gr3}], BoxRatios -> {1, 1, 1}]
              ]

[35]

\(profitmax[\@#1\ #2\^\(1/3\)&, 10, 5, 3]\)

[36]

profitmax2[function_, p_, w1_, w2_]:=Module[{f, gr1, gr2, x1, x2, sol},f[x1_, x2_] := function[x1, x2];sol=NSolve[{p Derivative[1, 0][f][x1, x2]==w1,p Derivative[0, 1][f][x1, x2]==w2},{x1, x2}];x10 = x1 /. sol[[1]];x20 = 
              x2 /. sol[[1]];gr1 = {PointSize[0.002], 
                Table[Point[{x1, x2, f[x1, x2]}], {x1, 0, 2, 0.05}, {x2, 0, 
                    2, 0.05}]};g[x1_, x2_] := 
              ((w1 (x1 - x10))/p) + ((w2 (x2 - x20))/p) + 
                f[x10, x20];gr2 = {Thickness[0.0005], 
                Table[Line[{{x1, x20, 0}, {x1, x20, f[x1, x20]}}], {x1, 0.1, 
                    2, 0.04}]};gr3 = Line[{{0, x20, g[0, x20]}, {2, x20, g[2, x20]}}];Show[Graphics3D[{gr1, gr2, gr3}], BoxRatios -> {1, 1, 1}, 
              Axes -> True, 
              AxesLabel -> {"x1", "x2", "y"}]]

[37]

\(profitmax2[\@#1\ #2\^\(1/3\)&, 10, 5, 3]\)

[38]

Show[%, ViewPoint -> {2, -1000, 0}]

[39]

profitsurface[function_, p_, w1_, w2_] := 
      Module[{f}, f[x1_, x2_] := function[x1, x2]; 
        Plot3D[p f[x1, x2] - w1 x1 - w2 x2, {x1, 0, 3}, {x2, 0, 3}, 
          BoxRatios -> {1, 1, 1}]]

[40]

\(profitsurface[\@#1\ #2\^\(1/3\)&, 10, 5, 3]\)

[41]

Clear[pi]; f[x1_, x2_] := (Sqrt[x1]) (x2^(1/3)); pi[x1_, x2_] := p f[x1, x2] - w1 x1 - w2 x2; {Derivative[1, 0][pi][x1, x2],Derivative[0, 1][pi][x1, x2]}

[42]

Clear[x1, x2]; sol=Solve[{Derivative[1, 0][pi][x1, x2]==0,Derivative[0, 1][pi][x1, x2]==0},{x1, x2}];PowerExpand[sol]

[43]

{x10, x20} = 
      PowerExpand[{x1, x2} /. sol[[1]]]

[44]

PowerExpand[f[x10, x20]]

[45]

PowerExpand[pi[x10, x20]]

[46]

supplyandprofit[function_]:=Module[{f, pi, x1, x2, x10, x20},f[x1_, x2_] := function[x1, x2];pi[x1_, x2_] := p f[x1, x2] - w1 x1 - w2 x2;sol=Solve[{Derivative[1, 0][pi][x1, x2]==0,Derivative[0, 1][pi][x1, x2]==0},{x1, x2}];x10 = 
              x1 /. sol[[1]];x20 = x2 /. sol[[1]];PowerExpand[{f[x10, x20], pi[x10, x20]}]]

[47]

supplyandprofit[#(1^(1/4)) #(2^(1/3))&]

[48]

Clear[f, pi, x1, x2, x20]; f[x1_, x2_] := (Sqrt[x1]) (x2^(1/3)); pi[x1_, x2_] := p f[x1, x20] - w1 x1 - w2 x20; sol=Solve[Derivative[1, 0][pi][x1, x20]==0,x1]

[49]

x10 = x1 /. sol[[1]]

[50]

PowerExpand[f[x10, x20]]

[51]

PowerExpand[pi[x10, x20]]

[52]

(∂_p) ((p^6)/(432 (w1^3) (w2^2)))

[53]

{(∂_w1) ((p^6)/(432 (w1^3) (w2^2))), 
      (∂_w2) ((p^6)/(432 (w1^3) (w2^2)))}

[54]

Clear[pi]; 
    pi[p_, w1_, w2_] := 
      ((7 (p^(15/7)))/(15 (30375^(1/7)) (w1^(3/7)) (w2^(5/7)))); 
    Plot3D[pi[p, 2, w2], {p, 0, 3}, {w2, 0.2, 3}, 
      BoxRatios -> {1, 1, 1}, ViewPoint -> {-2, -2, 2}]

[55]

sen = Table[Line[{{p, 2, 0}, {p, 2, pi[p, 2, 2]}}], {p, 0, 3, 0.05}]; 
    Show[Graphics3D[sen], BoxRatios -> {1, 1, 1}, Axes -> True, 
      ViewPoint -> {2, -3, 1}]

[56]

Clear[f, x1, x2, x10, x20, w1, w2]; f[x1_, x2_] := (Sqrt[x1]) (x2^(1/3)); profit[p_, w1_, w2_, x1_, x2_] := p f[x1, x2] - w1 x1 - w2 x2; sol=Solve[{Derivative[0, 0, 0, 1, 0][profit][p, w1, w2, x1, x2]==0,Derivative[0, 0, 0, 0, 1][profit][p, w1, w2, x1, x2]==0},{x1, x2}];{x10, x20} = 
      PowerExpand[{x1 /. sol[[1]], 
          x2 /. sol[[1]]}]

[57]

pi[p_, w1_, w2_] = PowerExpand[profit[p, w1, w2, x10, x20]]

[58]

{x10, x20} /. {p -> 5, w1 -> 2, w2 -> 3}

[59]

Clear[f, x1, x2, x10, w1, w2]; f[x1_, x2_] := (Sqrt[x1]) (x2^(1/3)); x2 = (15625/46656); profit2[p_, w1_, w2_, x1_] := p f[x1, x2] - w1 x1 - w2 x2; sol=Solve[Derivative[0, 0, 0, 1][profit2][p, w1, w2, x1]==0,x1];x10 = PowerExpand[x1 /. sol[[1]]]; 
    pis[p_, w1_, w2_] = PowerExpand[profit2[p, w1, w2, x10]]; {x10, pis[p, w1, w2]}

[60]

{gr1, gr2} = {pi[p, w1, w2] /. {w2 -> 3}, 
        pis[p, w1, w2] /. {w2 -> 3}}

[61]

Module[{gpi, gpis}, 
      gpi = Plot3D[gr1, {p, 4.5, 5.5}, {w1, 1.5, 2.5}, 
          DisplayFunction -> Identity]; 
      gpis = Plot3D[gr2, {p, 4.5, 5.5}, {w1, 1.5, 2.5}, 
          DisplayFunction -> Identity]; 
      Show[{gpi, gpis}, DisplayFunction -> $DisplayFunction, 
        BoxRatios -> {1, 1, 1}]]

[62]

{gr11, gr22} = {pi[p, w1, w2] /. {w1 -> 2, w2 -> 3}, 
        pis[p, w1, w2] /. {w1 -> 2, w2 -> 3}}; Module[{gpi1, gpis1}, 
      gpi1 = Plot[gr11, {p, 4.5, 5.5}, DisplayFunction -> Identity]; 
      gpis1 = Plot[gr22, {p, 4.5, 5.5}, PlotStyle -> Dashing[{0.01}], 
          DisplayFunction -> Identity]; 
      Show[{gpi1, gpis1}, DisplayFunction -> $DisplayFunction, 
        AspectRatio -> 1]]

[63]

{gr111, gr222} = {pi[p, w1, w2] /. {p -> 5, w2 -> 3}, 
        pis[p, w1, w2] /. {p -> 5, w2 -> 3}}

[64]

Module[{gpi1, gpis1}, 
      gpi1 = Plot[gr111, {w1, 1.5, 2.5}, DisplayFunction -> Identity]; 
      gpis1 = Plot[gr222, {w1, 1.5, 2.5}, PlotStyle -> Dashing[{0.01}], 
          DisplayFunction -> Identity]; 
      Show[{gpi1, gpis1}, DisplayFunction -> $DisplayFunction, 
        AspectRatio -> 1]]

[65]

Derivative[2, 0, 0][pi][p, w1, w2]/.{p -> 5, w1 -> 2, w2 -> 3}

[66]

Derivative[2, 0, 0][pis][p, w1, w2]/.{p -> 5, w1 -> 2, w2 -> 3}