0
$\begingroup$

I am trying to solve a Kuhn-Tucker constrained maximization problem. The variables of interest are d1,d2,dr and i. The other symbols are parameters which I have several restrictions for. It's an economics problem (going into the details of where the parameter restrictions and inequalities are coming from may be a bit tedious).

I have both tried using the built-in package from the Mathematica Journal below and using Solve with the various equality and inequality constraints directly. In both cases I let it run for two days and it would not solve. I'm wondering if there is a more efficient way to do this that anyone is aware of? Perhaps first finding all solutions with the equality conditions then keeping solutions that satisfy the inequality and parameter constraints? Any help would be much appreciated!

kkt[obj_, cons_, vars_, paramcons_:True] := 
  Module[{stdcons, eqcons, ineqcons, lambdas, mus, eqs1, eqs2, eqs3}, 
   stdcons = cons /. {(x_) >= (y_) -> y - x <= 0, (x_) > (y_) -> y - x > 0, 
       (x_) == (y_) -> x - y == 0, (x_) <= (y_) -> x - y <= 0}; 
    eqcons = Cases[stdcons, (x_) == 0 -> x]; 
    ineqcons = Cases[stdcons, (x_) <= 0 -> x]; 
    lambdas = Array[λ, Length[ineqcons]]; mus = Array[μ, Length[eqcons]]; 
    eqs1 = D[obj + mus . eqcons - lambdas . ineqcons == 0, {vars}]; 
    eqs2 = Thread[lambdas >= 0]; eqs3 = Table[lambdas[[i]]*ineqcons[[i]] == 0, 
      {i, Length[ineqcons]}]; Assuming[paramcons, 
     Refine[Reduce[Join[eqs1, eqs2, eqs3, cons], Join[vars, lambdas, mus], Reals, 
       Backsubstitution -> True]]]]


kkt[μ*(i*R - Subscript[d, r] - Subscript[d, 2]) + 
   (1 - μ)*θ*((i - Subscript[d, 1]/(γ*θ*R))*R - Subscript[d, 2]), 
  {i - μ*(Subscript[d, r] + Subscript[d, 2]) - 
     (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) <= 0, 
   θ*(Subscript[d, r] + Subscript[d, 2] - i) - c - 
     (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) + i - 
     μ*(Subscript[d, r] + Subscript[d, 2]) <= 0, 
   Subscript[d, 1] - Subscript[d, r] >= 0, θ*Subscript[d, r] - Subscript[d, 1] <= 
    0, i - 1 <= 0}, {Subscript[d, r], Subscript[d, 2], Subscript[d, 1], i}, 
  {μ > 0, μ < 1, θ > 0, θ < 1, R > 1, μ*R + θ*(1 - μ)*R > 1, 
   (1 - μ*R)*(1 - θ) < c, θ*(1/((1 - θ)*μ + θ) - 1) > c, μ*R < 1, γ < 1, 
   γ > 0}]

Here is the manual method:

L = θ*(1 - μ)*(R*(i - Subscript[d, 1]/(R*γ*θ)) - Subscript[d, 2]) + 
   μ*(i*R - Subscript[d, 2] - Subscript[d, r]) - 
   (i - (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) - 
     μ*(Subscript[d, 2] + Subscript[d, r]))*Subscript[λ, 1] - 
   (-c + i - (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) - 
     μ*(Subscript[d, 2] + Subscript[d, r]) + 
     θ*(-i + Subscript[d, 2] + Subscript[d, r]))*Subscript[λ, 2] + 
   (Subscript[d, 1] - Subscript[d, r])*Subscript[λ, 3] - 
   (-Subscript[d, 1] + θ*Subscript[d, r])*Subscript[λ, 4] - 
   (-1 + i)*Subscript[λ, 5]; 
focdr = FullSimplify[D[L, Subscript[d, r]]]; 
focd1 = FullSimplify[D[L, Subscript[d, 1]]]; 
focd2 = FullSimplify[D[L, Subscript[d, 2]]]; 
foci = FullSimplify[D[L, i]]; 
Solve[{Subscript[d, r]*focdr == 0, focd1*Subscript[d, 1] == 0, 
   focd2*Subscript[d, 2] == 0, foci*i == 0, 
   Subscript[λ, 1]*(i - μ*(Subscript[d, r] + Subscript[d, 2]) - 
      (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2])) == 0, 
   Subscript[λ, 2]*(θ*(Subscript[d, r] + Subscript[d, 2] - i) - c - 
      (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) + i - 
      μ*(Subscript[d, r] + Subscript[d, 2])) == 0, 
   Subscript[λ, 3]*(Subscript[d, 1] - Subscript[d, r]) == 0, 
   Subscript[λ, 4]*(θ*Subscript[d, r] - Subscript[d, 1]) == 0, 
   Subscript[λ, 5]*(i - 1) == 0, i - μ*(Subscript[d, r] + Subscript[d, 2]) - 
     (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) <= 0, 
   θ*(Subscript[d, r] + Subscript[d, 2] - i) - c - 
     (1 - μ)*(Subscript[d, 1] + θ*Subscript[d, 2]) + i - 
     μ*(Subscript[d, r] + Subscript[d, 2]) <= 0, μ > 0, μ < 1, θ > 0, θ < 1, 
   R > 1, μ*R + θ*(1 - μ)*R > 1, (1 - μ*R)*(1 - θ) < c, 
   θ*(1/((1 - θ)*μ + θ) - 1) > c, μ*R < 1, γ < 1, γ > 0}, 
  {i, Subscript[d, 1], Subscript[d, r], Subscript[d, 2], Subscript[λ, 1], 
   Subscript[λ, 2], Subscript[λ, 3], Subscript[λ, 4], Subscript[λ, 5]}]
$\endgroup$
  • 1
    $\begingroup$ That's why one should solve optimization problem numerically, not symbolically. $\endgroup$ – Henrik Schumacher May 6 at 14:49
  • $\begingroup$ But I need a symbolic solution and there is a unique one depending on the parameters. $\endgroup$ – gww466 May 6 at 15:02
  • $\begingroup$ I think yourkkt has at least two errors (there may be more); you don't need to use Table for the inequality constrains, you can simply write Thread[lambdas ineqcons == 0]; whenever I have used the Lagrangean etc in the past for optimization purposes, never have I found Reduce preferable to Solve; it seems that there are inequalities used that don't involve variables; even if everything else is correct, this would add more complexity into your symbolic Reduce; $\endgroup$ – user42582 May 6 at 20:38
  • $\begingroup$ it would definitely benefit anyone trying to help, if you could provide a clear description of the problem (perhaps casting it in some standard form), explaining what kind of an optimization problem it is (it appears to be a maximization problem but I'm not sure) what are the variables, what are the multipliers, what are free parameters and what are their constraints; $\endgroup$ – user42582 May 6 at 20:43
  • $\begingroup$ O ok thank you so much for your help - I took kkt directly from the Mathematica Journal. The inequalities that do not use variables are just parameter restrictions. I will definitely add some details $\endgroup$ – gww466 May 6 at 20:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.