Using Karush-Kuhn Tucker conditions to solve the constrained optimization problem

KKTMinimize[obj_,eqns_,ineqns_,variables_]:=
Block[{myrule,lambda,u,\[Lambda],Lagrange,eqnu,ineqnlam,eqnus,
ineqnlams,kkteqns,kktvars,kktans},
myrule={z_[i_]:>ToExpression[ToString[z]<>ToString[i]]};
eqnu=u[#]&/@Range[Length@eqns];
ineqnlam=\[Lambda][#]&/@Range[Length@ineqns];
eqnus=If[Length@eqns>=1,eqns.eqnu,0];
ineqnlams=If[Length@ineqns>=1,ineqns.ineqnlam,0];
kktvars=Flatten@{variables,eqnu,ineqnlam}/.myrule;
Lagrange=obj-eqnus-ineqnlams;
kkteqns=Flatten@{Thread[D[Lagrange,{variables}]==0],
Thread[eqns==0],Thread[ineqns<=0],Thread[ineqns*ineqnlam==0],
Thread[ineqnlam<=0]}/.myrule;
If[MemberQ[PolynomialQ[#,kktvars]&/@kkteqns[[All,1]],False],
Print["KKT限制式均需為多項式。"],
kktans=Reduce[kkteqns,kktvars,Backsubstitution->True]/.
{And->List,Or->List,Equal->Rule};
If[Length@Dimensions@kktans==1,{obj/.kktans,kktans},
{obj/.#,#}&/@kktans]]];

(* usage *)
(* KKTMinimize[objective,equalities, inequalities, variablies] *)

obj=x1^2+x2^2+3*x3^2+4*x4^2+2*x5^2-8*x1-2*x2-3*x3-x4-2*x5;
cons={x1-99,x2-99,x3-99,x4-99,x5-99,-x1,-x2,-x3,-x4,-x5,
x1+x2+x3+x4+x5-400,x1+2*x2+2*x3+x4+6*x5-800,2*x1+x2+6*x3-200,
x3+x4+5*x5-200};
ans=KKTMinimize[-obj,{},cons,{x1,x2,x3,x4,x5}];
SortBy[ans,First][[1]]

Tags: Mathematica 教學, Mathematica 教學 程式, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見