Chapter 5

[1]-[9]

[1]

sen = 
      Table[Line[{{x1, (3^3) (x1^(-3/2)), 0}, {x1, 
              (3^3) (x1^(-3/2)), 5}}], {x1, 2, 10, 0.2}]; men1 = 
      Table[Line[{{x1, 0, 0.2 x1}, {x1, 10, 0.2 x1 + 0.3 10}}], {x1, 0, 
          10, 0.3}]; men2 = 
      Table[Line[{{0, x2, 0.3 x2}, {10, x2, 0.2 10 + 0.3 x2}}], {x2, 0, 
          10, 0.3}]; Show[Graphics3D[{sen, men1, men2}], 
      DisplayFunction -> $DisplayFunction, BoxRatios -> {1, 1, 1}, 
      Axes -> True, AxesLabel -> {"x1", "x2", "c"}]

[2]

sen = 
      Table[Line[{{x1, (3^3) (x1^(-3/2)), 0}, {x1, 
              (3^3) (x1^(-3/2)), 
              0.2 x1 + 0.3 (3^3) (x1^(-3/2))}}], {x1, 1, 10, 0.1}]; 
    Show[Graphics3D[sen], ViewPoint -> {3, -5, 1.5}, 
      BoxRatios -> {1, 1, 1}, Axes -> True, 
      AxesLabel -> {"x1", "x2", "c"}]

[3)]

Show[%, ViewPoint -> {1, -100, 1}]

[4]

Plot[0.2 x1 + 0.3 (3^3) (x1^(-3/2)), {x1, 1.5, 10}, 
      PlotRange -> {0, 5}, AspectRatio -> 1, 
      GridLines -> Automatic]

[5]

Clear[x1, x2, lambda, f, sol]; f[x_ 1, x2_] := (Sqrt[x1]) (x2^(1/3)); L = w1 x1 + w2 x2 - lambda (f[x1, x2] - y); sol = 
      Solve[{(∂_x1) L == 0, (∂_x2) L == 0, 
          (∂_lambda) L == 0}, {x1, x2, lambda}]

[6]

x1 = x1 /. sol[[1]]; 
    x2 = x2 /. sol[[1]]; lambda = lambda /. sol[[1]]; 
    PowerExpand[{x1, x2, lambda}]

[7]

N[% /. {w1 -> 0.2, w2 -> 0.3, y -> 3}]

[8]

costmin[function_] := 
      Module[{f, L}, Clear[x1, x2, lambda, sol]; 
        f[x1_, x2_] := function[x1, x2]; 
        L[x1_, x2_, lambda_] := 
          w1 x1 + w2 x2 - lambda (f[x1, x2] - y); 
        sol = Solve[{(∂_x1) L[x1, x2, lambda] == 0, 
              (∂_x2) L[x1, x2, lambda] == 0, 
              (∂_lambda) L[x1, x2, lambda] == 0}, {x1, x2, lambda}]]

[9]

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

[10]-[19]

(10)

{x1, x2, lambda} = {
        x1 /. sol[[1]], 
        x2 /. sol[[1]], 
        lambda /. sol[[1]]}

(11)

Simplify[w1 x1 + w2 x2]

(12)

costfunction[w1_, w2_, y_] := 
      ((3 (w1^(1/3)) (w2^(2/3)) y)/(2^(2/3)))

(13)

Plot3D[costfunction[w1, w2, 2], {w1, 0.1, 2}, {w2, 0.1, 2}, 
      BoxRatios -> {1, 1, 1}, 
      AxesLabel -> {"w1", "w2", "c"}]

(14)

Plot3D[costfunction[w1, 2, y], {w1, 0.1, 2}, {y, 0, 2}, 
      BoxRatios -> {1, 1, 1}, 
      AxesLabel -> {"w1", "y", "c"}]

(15)

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

(16)

{x1, x2} = {x1 /. sol, x2 /. sol}

(17)

Simplify[w1 x1 + w2 x2]

(18)

costfunction[w1_, w2_, y_] := 2 (Sqrt[w1]) (Sqrt[w2]) (y^(3/2))

(19)

Plot[costfunction[2, 2, y], {y, 0, 6}, PlotRange -> {0, 50}, 
      PlotStyle -> Dashing[{0.01}], AspectRatio -> 1]

[20]-[29]

[20]

costmin2[function_] := 
      Module[{f, L}, Clear[x1, x2, lambda, sol]; 
        f[x1_, x2_] := function[x1, x2]; 
        L[x1_, lambda_] := w1 x1 + w2 x2 - lambda (f[x1, x2] - y); 
        sol = Solve[{(∂_x1) L[x1, lambda] == 0, 
              (∂_lambda) L[x1, lambda] == 0}, {x1, lambda}]]

[21]

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

[22]

x1 = x1 /. sol

[23]

Simplify[w1 x1 + w2 x2]

[24]

costfunction2[x2_, y_, w1_, w2_] := x2 w2 + ((w1 (y^3))/x2);

[25]

Plot[
      Evaluate[Table[costfunction2[x2, y, 2, 2], {x2, 2, 8, 2}]], {y, 0, 6}, 
      PlotRange -> {0, 50}, AspectRatio -> 1]

[26]

Show[{%%%%%%%, %}]

[27]

Plot3D[2 x2 + ((2 (y^3))/x2), {x2, 1, 6}, {y, 0, 6}, 
      BoxRatios -> {1, 1, 1}, PlotRange -> {0, 50}, 
      AxesLabel -> {"x2", "y", "c"}]

[28]

Plot[
      Evaluate[Table[2 x2 + ((2 (y^3))/x2), {y, 1, 4.5, 0.5}]], {x2, 0.1, 
        6}, AspectRatio -> 1, PlotRange -> {0, 50}]

[29]

Plot[
      Evaluate[Table[(x^2) - 4 p x + 2 (p^2), {p, -7, 7}]], {x, -20, 
        20}, PlotRange -> {-100, 100}, AspectRatio -> 1]

[30]

Clear[f, x1, x2, L, sol, x3, lambda]; f[x1_, x2_, x3_] := (x1^(1/3)) (Sqrt[x2]) (x3^(1/3)); L[x1_, x2_, x3_, lambda_] := 
      w1 x1 + w2 x2 + w3 x3 - lambda (f[x1, x2, x3] - y); sol = 
      Solve[{(∂_x1) L[x1, x2, x3, lambda] == 0, 
          (∂_x2) L[x1, x2, x3, lambda] == 0, 
          (∂_x3) L[x1, x2, x3, lambda] == 0, 
          (∂_lambda) L[x1, x2, x3, lambda] == 0}, {x1, x2, x3, 
          lambda}]

[31]

{x1, x2, x3} = 
      PowerExpand[{x1 /. sol[[1]], 
          x2 /. sol[[1]], 
          x3 /. sol[[1]]}];

[32]

c[w1_, w2_, w3_, y_] := 
      2 ((((2/3)))^(3/7)) (w1^(2/7)) (w2^(3/7)) (w3^(2/7)) 
          (y^(6/7)) + 
        ((((3/2)))^(4/7)) (w1^(2/7)) (w2^(3/7)) (w3^(2/7)) 
          (y^(6/7))

[32]

Clear[f, L, x1, x2, x3, sol, lambda]; f[x1_, x2_, x3_] := (x1^(1/3)) (Sqrt[x2]) (x3^(1/3)); L[x1_, x3_, lambda_] := 
      w1 x1 + w2 x2 + w3 x3 - lambda (f[x1, x2, x3] - y); sol = 
      Solve[{(∂_x1) L[x1, x3, lambda] == 0, 
          (∂_x3) L[x1, x3, lambda] == 0, 
          (∂_lambda) L[x1, x3, lambda] == 0}, {x1, x3, lambda}]; 
    {x1, x3} = 
      PowerExpand[{x1 /. sol[[2]], 
          x3 /. sol[[2]]}]

[34]

w1 x1 + w2 x2 + w3 x3

[35]

cs[w1_, w2_, w3_, y_, x2_] := 
      w2 x2 + ((2 (Sqrt[w1]) (Sqrt[w3]) (y^(3/2)))/(x2^(3/4)))

[36]

Clear[f, L, x1, x2, x3, sol, lambda]; f[x1_, x2_, x3_] := (x1^(1/3)) (Sqrt[x2]) (x3^(1/3)); L[x1_, lambda_] := 
      w1 x1 + w2 x2 + w3 3 - lambda (f[x1, x2, x3] - y); sol = 
      Solve[{(∂_x1) L[x1, lambda] == 0, 
          (∂_lambda) L[x1, lambda] == 0}, {x1, lambda}]; {x1} = 
      PowerExpand[{x1 /. sol[[1]]}]

[37]

w1 x1 + w2 x2 + w3 x3

[38]

css[w1_, w2_, w3_, y_, x2_, x3_] := 
      w2 x2 + w3 x3 + ((w1 (y^3))/((x2^(3/2)) x3))

[39]

FindRoot[{c[w1, w2, 2, 3] == cs[w1, w2, 2, 3, 4], 
        c[w1, w2, 2, 3] == css[w1, w2, 2, 3, 4, 5]}, {w1, 14}, {w2, 4}]

[40]-[46]

[40]

w2 = 3.75024; Plot[{c[w1, w2, 2, 3], cs[w1, w2, 2, 3, 4], css[w1, w2, 2, 3, 4, 5]}, {
        w1, 0, 30}, PlotRange -> {10, 50}, AspectRatio -> 1, 
      PlotStyle -> {{}, Dashing[{0.01}], Dashing[{0.03}]}]

[41]

N[(∂_w1) c[w1, w2, 2, 3] /. {w1 -> 14.814}]

[42]

N[(∂_w1) cs[w1, w2, 2, 3, 4] /. {w1 -> 14.814}]

[43]

N[(∂_w1) css[w1, w2, 2, 3, 4, 5] /. {w1 -> 14.814}]

[44]

Plot[{Derivative[1, 0, 0, 0][c][w1, w2, 2, 3],Derivative[1, 0, 0, 0, 0][cs][w1, w2, 2, 3, 4],Derivative[1, 0, 0, 0, 0, 0][css][w1, w2, 2, 3, 4, 5]},{w1, 1, 30},AspectRatio -> 1,PlotStyle -> {{}, Dashing[{0.01}], Dashing[{0.02}]}]

[45]

N[{(∂_(w1, w1))c[w1, w2, 2, 3], 
          (∂_(w1, w1))cs[w1, w2, 2, 3, 4], 
          (∂_(w1, w1))css[w1, w2, 2, 3, 4, 5]} /. {
          w1 -> 14.814}]

[46]

Plot[{Derivative[2, 0, 0, 0][c][w1, w2, 2, 3],Derivative[2, 0, 0, 0, 0][cs][w1, w2, 2, 3, 4],Derivative[2, 0, 0, 0, 0, 0][css][w1, w2, 2, 3, 4, 5]},{w1, 1, 30},AspectRatio -> 1,PlotStyle -> {{}, Dashing[{0.01}], Dashing[{0.02}]}]