Chapter 3

[1]-[9]

[1]

(∂_x1) f[g1[x1, x2], g2[x1, x2]] /. {g1[x1, x2] -> y1, 
        g2[x1, x2] -> y2}

[2]

(∂_x2) f[g1[x1, x2], g2[x1, x2]] /. {g1[x1, x2] -> y1, 
        g2[x1, x2] -> y2}

[3]

v[p1_, p2_, w_] := 
      (((2^(2/3)) w)/(3 (p1^(1/3)) (p2^(2/3)))); {-(∂_p1) v[p1, p2, w]/(∂_w) v[p1, p2, w], 
      -(∂_p2) v[p1, p2, w]/(∂_w) v[p1, p2, w]}

[4]

demandfromindirectutility2[indutilityfunction_] := 
      Module[{v}, 
        v[p1_, p2_, w_] := indutilityfunction[p1, p2, w]; {
          (∂_p1) v[p1, p2, w]/(∂_w) v[p1, p2, w], 
          (∂_p2) v[p1, p2, w]/(∂_w) v[p1, p2, w]}]

[5]

demandfromindirectutility2[
      ((2 #(3^(2/3)))/(9 (5 #(1^(1/5)) #(2^(3/4)))))&]

[6]

demandfromindirectutility2[((n #(3^k))/(m #(1^a) #(2^b)))&]

[7]

e[p1_, p2_, w_] := ((3 (p1^(1/3)) (p2^(2/3)) u)/(2^(2/3))); 
    {(∂_p1) e[p1, p2, u], (∂_p2) e[p1, p2, u]}

[8]

compdemandfromexpenditure2[expenditurefunction_] := 
      Module[{e}, 
        e[p1_, p2_, u_] := expenditurefunction[p1, p2, u]; {
          (∂_p1) e[p1, p2, u], (∂_p2) v[p1, p2, u]}]

[9]

compdemandfromexpenditure2[
      ((9 #(1^(2/5)) #(2^(2/7)) #3)/(2^(3/4)))&]

[10]-[19]

[10]

compdemandfromexpenditure2[((n #(1^a) #(2^b) #3)/(2^c))&]

[11]

Plot[(5/(3 x1)), {x1, 0.01, 4}, AspectRatio -> 1, 
      PlotRange -> {0, 8}, GridLines -> Automatic, 
      AxesLabel -> {"x1", "p1"}]

[12]

demandcurve[utilityf_, w_] := 
      Module[{u, g, L, p1, p2, x1, x2, x10, x20, sol, sol2, sol3}, 
        u[x1_, x2_] := utilityf[x1, x2]; g[x1_, x2_] := p1 x1 + p2 x2 - w; 
        L[x1_, x2_, lambda_] := u[x1, x2] - lambda g[x1, x2]; 
        sol = Solve[{(∂_x1) L[x1, x2, lambda] == 0, 
              (∂_x2) L[x1, x2, lambda] == 0, 
              (∂_lambda) L[x1, x2, lambda] == 0}, {x1, x2, lambda}]; 
        x10 = PowerExpand[
            x1 /. sol[[1]]]; 
        sol2 = Solve[x10 == x, p1]; 
        p11 = p1 /. sol2[[1]]; 
        Print[" p1 = ", p11]; 
        Plot[p11, {x, 0.1, 4}, AspectRatio -> 1, 
          PlotLabel -> {"x1", "p1"}]]

[13]

demandcurve[#(1^(3/7)) #(2^(5/9))&, 5]

[14]

Plot[(((3^(2/3)) 5)/((2^(2/3)) (x1^(2/3)))), {x1, 0.1, 4}, 
      GridLines -> Automatic, AspectRatio -> 1]

[15]

compdemandcurve[utilityf_, U_, p2_] := 
      Module[{u, g, L, sol, sol2, x1, x2, x10, x20, p1}, 
        u[x1_, x2_] := utilityf[x1, x2]; g[x1_, x2_] := p1 x1 + p2 x2; 
        L[x1_, x2_, lambda_] := g[x1, x2] - lambda (u[x1, x2] - U); 
        sol = Solve[{(∂_x1) L[x1, x2, lambda] == 0, 
              (∂_x2) L[x1, x2, lambda] == 0, 
              (∂_lambda) L[x1, x2, lambda] == 0}, {x1, x2, lambda}]; 
        x10 = PowerExpand[
            x1 /. sol[[1]]]; 
        x20 = PowerExpand[
            x2 /. sol[[1]]]; 
        sol2 = Solve[x10 == x, p1]; 
        p11 = p1 /. sol2[[1]]; 
        Print["p1 = ", p11]; 
        Plot[p11, {x, 0.2, 2}, AspectRatio -> 1, 
          GridLines -> Automatic]]

[16]

compdemandcurve[#(1^(2/3)) #(2^(2/3))&, 3, 2]

[17]

kakakutojyuyou[p1_, p2_, w_] := 
      Module[{yosannsen, musabetu, x11, x12}, u[x1_, x2_] := (Sqrt[x1]) + (Sqrt[x2]); 
        yosannsen[p11_, p12_, wC_, x1_] := 
          -((p11 x1)/p12) + (wC/p12); 
        musabetu[u_, x1_] := (((u - (Sqrt[x1])))^2); 
        x11[p11_, p12_, wC_] := ((wC p2)/(p1 (p1 + p2))); 
        x12[p11_, p12_, wC_] := ((wC p1)/(p2 (p1 + p2))); 
        Plot[{yosannsen[p1, p2, w, x1], 
            musabetu[u[x11[p1, p2, w], x12[p1, p2, w]], x1]}, {x1, 0.1, 8}, 
          PlotRange -> {{0, 8}, {0, 8}}, 
          AxesLabel -> {"x1", "x2"}, 
          GridLines -> Automatic, AspectRatio -> 1, 
          DisplayFunction -> Identity]]

[18]

Show[kakakutojyuyou[4, 3, 15], DisplayFunction -> $DisplayFunction]

[19]

Show[{kakakutojyuyou[4, 3, 15], kakakutojyuyou[3, 3, 15], 
        kakakutojyuyou[2, 3, 15]}, DisplayFunction -> $DisplayFunction]

[20]-[29]

[20]

ParametricPlot[{((3 15)/((p1^2) + p1 3)), 
        ((p1 15)/(3 p1 + (3^2)))}, {p1, 0.4, 100}, 
      PlotRange -> {{0, 8}, {0, 8}}, GridLines -> Automatic, 
      AspectRatio -> 1]

[21]

Clear[incomeeffect]; incomeeffect[p1_, dp1_, p2_, w_] := 
      Module[{u, yosannsenn, musabetu, demand1, demand2, compd1, compd2, u0, 
          w2, ww}, u[x1_, x2_] := (Sqrt[x1]) + (Sqrt[x2]); 
        demand1[pp1_, pp2_, ww_] := ((ww pp2)/(pp1 (pp1 + pp2))); 
        demand2[pp1_, pp2_, ww_] := ((ww pp1)/(pp2 (pp1 + pp2))); 
        compd1[pp1_, pp2_, uu_] := (((pp2^2) (uu^2))/(((pp1 + pp2))^2)); 
        compd2[pp1_, pp2_, uu_] := (((pp1^2) (uu^2))/(((pp1 + pp2))^2)); 
        u0 = (Sqrt[(((p1 + p2) w)/(p1 p2))]); 
        w2 = (p1 + dp1) compd1[p1 + dp1, p2, u0] + 
            p2 compd2[p1 + dp1, p2, u0]; 
        yosannsenn[pp1_, pp2_, ww_, x1_] := 
          -((pp1 x1)/pp2) + (ww/pp2); 
        musabetu[uu_, x1_] := (((uu - (Sqrt[x1])))^2); 
        ten1 = {demand1[p1, p2, w], demand2[p1, p2, w]}; 
        ten2 = {compd1[p1 + dp1, p2, u0], compd2[p1 + dp1, p2, u0]}; 
        ten3 = {demand1[p1 + dp1, p2, w], demand2[p1 + dp1, p2, w]}; 
        t1 = Text["A", 1.1 ten1]; t2 = Text["A*", 1.1 ten2]; 
        t3 = Text["A0", 1.1 ten3]; 
        gr1 = Plot[{yosannsenn[p1, p2, w, x1], 
              yosannsenn[p1 + dp1, p2, w2, x1], 
              yosannsenn[p1 + dp1, p2, w, x1], 
              musabetu[u[demand1[p1, p2, w], demand2[p1, p2, w]], x1], 
              musabetu[u[demand1[p1 + dp1, p2, w], demand2[p1 + dp1, p2, w]], 
                x1]}, {x1, 0.001, 8}, DisplayFunction -> Identity]; 
        Show[{gr1, 
            Graphics[{PointSize[0.03], Point[ten1], Point[ten2], Point[ten3], 
                t1, t2, t3}]}, DisplayFunction -> $DisplayFunction, 
          PlotRange -> {{0, 8}, {0, 8}}, 
          AxesLabel -> {"x1", "x2"}, AspectRatio -> 1]]

[22]

incomeeffect[4, -2, 3, 15]

[23]

incomeeffect[3, 3, 4, 16]

[24]

demandcurve2[p10_, p2_, w__] := 
      Module[{u, demand1, compd1}, 
        u = (Sqrt[(((p10 + p2) w)/(p10 p2))]); 
        demand1 = ((p2 w)/((p1^2) + p1 p2)); 
        conpd1 = (((p2^2) (u^2))/(((p1 + p2))^2)); 
        ParametricPlot[{{demand1, p1}, {conpd1, p1}}, {p1, 0.1, 16}, 
          PlotStyle -> {{}, Dashing[{0.01}]}, 
          GridLines -> Automatic, AspectRatio -> 1, 
          PlotRange -> {{0, 8}, {0, 8}}]]

[25]

demandcurve2[2, 4, 15]

[26]

demandcurve2[4, 3, 16]

[27]

substitutionmatrix[conpd1_, conpd2_]:=Module[{conpdf1, conpdf2, s11, s12, s21, s22, S},f1[p1_, p2_, u_] := conpd1[p1, p2, u];f2[p1_, p2_, u_] := conpd2[p1, p2, u];s11=Derivative[1, 0, 0][f1][p1, p2, u];s12=Derivative[0, 1, 0][f1][p1, p2, u];s21=Derivative[1, 0, 0][f2][p1, p2, u];s22=Derivative[0, 1, 0][f2][p1, p2, u];S = Simplify[{{s11, s12}, {s21, s22}}]]

[28]

MatrixForm[
      substitutionmatrix[((#(2^2) #(3^2))/(((#1 + #2))^2))&, 
        ((#(1^2) #(3^2))/(((#1 + #2))^2))&]]

[29]

grofsubstitution[p10_, u0_]:=Module[{conpd1, s12},conpd1[p1_, p2_, u_] := (((p2^2) (u^2))/(((p1 + p2))^2));s12[p2_]:=Derivative[0, 1, 0][conpd1][p10, p2, u0];Plot[{conpd1[p10, p2, u0], s12[p2]}, {p2, 0.01, 6}, 
              PlotStyle -> {{}, Dashing[{0.01}]}, PlotRange -> All, 
              GridLines -> Automatic, AspectRatio -> 1, 
              AxesLabel -> {"p2", "x1*, s12"}]]

[30]-[39]

[30]

grofsubstitution[3, 6]

[31]

grofsubstitution[0.6, 10]

[32]

exampleofsubstitution[p10_, u0_]:=Module[{conpd1, s12},conpd1[p1_, p2_, u_] := 
              (((p2^(2/3)) (u^2))/((2^(2/3)) (p1^(2/3))));s12[p2_]:=Derivative[0, 1, 0][conpd1][p10, p2, u0];Plot[{conpd1[p10, p2, u0], s12[p2]}, {p2, 0.01, 6}, 
              PlotStyle -> {{}, Dashing[{0.01}]}, PlotRange -> All, 
              GridLines -> Automatic, AspectRatio -> 1, 
              AxesLabel -> {"p2", "x1*, s12"}]]

.

[33]

exampleofsubstitution[5, 10]

[34]

incomeconsumptioncurve1[p1_, p2_] := 
      Module[{x1, x2, gr, ten, points}, x1[w_] := (w/(3 p1)); 
        x2[w_] := ((2 w)/(3 p2)); 
        gr = ParametricPlot[{x1[w], x2[w]}, {w, 0, 50}, 
            DisplayFunction -> Identity]; 
        points = {PointSize[0.03], 
            Table[Point[{x1[w], x2[w]}], {w, 0, 50, 5}]}; 
        ten = Table[Text[{"w", w}, {x1[w], x2[w] + 0.4}], {w, 0, 50, 5}]; 
        Show[{gr, Graphics[{points, ten}]}, AspectRatio -> 1, 
          GridLines -> Automatic, PlotRange -> All, 
          AxesLabel -> {"x1", "x2"}, 
          DisplayFunction -> $DisplayFunction]]

[35]

incomeconsumptioncurve1[3, 4]

[36]

incomeconsumptioncurve2[p1_, p2_, w0_] := 
      Module[{x1, x2, gr, ten, points}, 
        x1[w_] := If[w < w0, (w/(3 p1)), (w0/(3 p1)) - ((w - w0)/p1)]; 
        x2[w_] := ((2 w)/(3 p2)); 
        gr = ParametricPlot[{x1[w], x2[w]}, {w, 0, ((4 w0)/3)}, 
            DisplayFunction -> Identity]; 
        points = {PointSize[0.03], 
            Table[Point[{x1[w], x2[w]}], {w, 0, ((4 w0)/3), 5}]}; 
        ten = Table[
            Text[{"w", w}, {x1[w], x2[w] + 0.2}], {w, 0, ((4 w0)/3), 
              5}]; Show[{gr, Graphics[{points, ten}]}, AspectRatio -> 1, 
          AxesLabel -> {"x1", "x2"}, 
          GridLines -> Automatic, PlotRange -> {{0, 4}, {0, 6}}, 
          DisplayFunction -> $DisplayFunction]]

[37]

incomeconsumptioncurve2[3, 4, 25]

[38]

engelcurve1[p1_, p2_] := 
      Module[{x1, x2, gr, ten, points}, x1[w_] := (w/(3 p1)); 
        gr = ParametricPlot[{x1[w], w}, {w, 0, 50}, 
            DisplayFunction -> Identity]; 
        points = {PointSize[0.03], Table[Point[{x1[w], w}], {w, 0, 50, 5}]}; 
        ten = Table[Text[{"w", w}, {x1[w], w + 0.4}], {w, 0, 50, 5}]; 
        Show[{gr, Graphics[{points, ten}]}, AspectRatio -> 1, 
          GridLines -> Automatic, PlotRange -> All, 
          AxesLabel -> {"x1", "w"}, 
          DisplayFunction -> $DisplayFunction]]

[39]

engelcurve1[3, 4]

[40]-[49]

[40]

engelcurve[2 p1_, p2_, w0_] := 
      Module[{x1, x2, gr, ten, points}, 
        x1[w_] := If[w < w0, (w/(3 p1)), (w0/(3 p1)) - ((w - w0)/p1)]; 
        gr = ParametricPlot[{x1[w], w}, {w, 0, ((4 w0)/3)}, 
            DisplayFunction -> Identity]; 
        points = {PointSize[0.03], 
            Table[Point[{x1[w], w}], {w, 0, ((4 w0)/3), 5}]}; 
        ten = Table[
            Text[{"w", w}, {x1[w] + 0.3, w + 0.2}], {w, 0, ((4 w0)/3), 
              5}]; Show[{gr, Graphics[{points, ten}]}, AspectRatio -> 1, 
          GridLines -> Automatic, PlotRange -> {{0, 4}, {0, 40}}, 
          AxesLabel -> {"x1", "w"}, 
          DisplayFunction -> $DisplayFunction]]

[42]

demanddelta[utility_] := 
      Module[{u, L, sol}, u[x1_, x2_] := utility[x1, x2]; 
        L[x1_, x2_, lambda_] := 
          u[x1, x2] - lambda (p1 x1 + p2 x2 - p1 w1 - p2 w2); 
        sol = Solve[{(∂_x1) L[x1, x2, lambda] == 0, 
              (∂_x2) L[x1, x2, lambda] == 0, 
              (∂_lambda) L[x1, x2, lambda] == 0}, {x1, x2, lambda}]]

[43]

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

[44]

demanddelta[#1 #2&]

[45]

\(Simplify[demanddelta[\@#1 + \@#2&]]\)

[46]

offercurve[demand1_, demand2_, p2_, w1_, w2_] := 
      Module[{x1, x2, Null}, x1[p1_] := demand1[p1, p2, w1, w2]; 
        x2[p1_] := demand2[p1, p2, w1, w2]; 
        ParametricPlot[{x1[p1], x2[p1]}, {p1, 0.01, 10}, 
          PlotRange -> {{0, 20}, {0, 20}}, AspectRatio -> 1, 
          GridLines -> Automatic, 
          AxesLabel -> {"x1", "x2"}]]

[47]

offercurve[((#1 #3 + #2 #4)/(3 #1))&, 
      ((2 (#1 #3 + #2 #4))/(3 #2))&, 2, 5, 10]

[48]

offercurve[((#1 #3 + #2 #4)/(3 #1))&, 
      ((2 (#1 #3 + #2 #4))/(3 #2))&, 1, 15, 2.5]

[49]

offercurve[((#2 (#1 #3 + #2 #4))/(#1 (#1 + #2)))&, 
      ((#1 (#1 #3 + #2 #4))/(#2 (#1 + #2)))&, 1, 15, 2.5]

[50]-[57]

[50]

offercurve[((#2 (#1 #3 + #2 #4))/(#1 (#1 + #2)))&, 
      ((#1 (#1 #3 + #2 #4))/(#2 (#1 + #2)))&, 3, 5, 2.5]

[51]

sol=DSolve[{mu'[p1]==mu[p1]/(3 p1),mu[q1] == w},mu[p1],p1]

[52]

Solve[x1 == (w/(3 q1)), q1]

[53]

Module[{mu, w, sol, sol1, sol2, sol3, q1},sol1=DSolve[{mu'[p1]==mu[p1]/(3 p1),mu[q1] == w},mu[p1],p1];mu = mu[p1] /. sol1[[1]];sol2 = Solve[x1 == (w/(3 q1)), q1];q1 = q1 /. sol2[[1]];sol3 = Solve[q1 x1 + x2 == w, w];w = w /. sol3[[1]];mu = PowerExpand[mu]]

[54]

utilityfromdemand[demandfunction_]:=Module[{mu, w, sol, sol1, sol2, sol3, q1},x1[p1_, p2_, w_] := demandfunction[p1, p2, w];sol1=DSolve[{mu'[p1]==x1[p1, 1, mu[p1]],mu[q1] == w},mu[p1],p1];mu = mu[p1] /. 
                sol1[[1]];sol2 = Solve[x1 == x1[q1, 1, w], q1];q1 = q1 /. sol2[[1]];sol3 = Solve[q1 x1 + x2 == w, w];w = w /. sol3[[1]];mu = Simplify[PowerExpand[mu]]]

[55]

utilityfromdemand[((2 #3)/(5 #1))&]

[56]

utilityfromdemand[#(3/(2 #1))&]

[57]

\(utilityfromdemand[#3\/\(#1 + \@#1\)&]\)

PowerExpand[Simplify[PowerExpand[%]]]