Mathematica 教學 Linear Proggramming Simplex Method Version 2

Mathematica 的LinearProgramming無法輸出最佳解的搜尋過程，所以自己寫了一個函數來輸出Simplex method的搜尋過程。

myPivotRatio[varstemp_List,bvartemp_List,nonbvartemp_List,simplexmatrixtemp_List,
objcoeftemp_List,soltemp_List,objsoltemp_]:=Block[{M,vars=varstemp,bvar=bvartemp,
nonbvar=nonbvartemp,simplexmatrix=simplexmatrixtemp,simplexmatrixall,
objcoef=objcoeftemp,sol=soltemp,objsol=objsoltemp,invar,pivotcol1,ratio},

(*選擇進入變數*)
invar=SortBy[DeleteCases[Transpose@{objcoef,vars},{a_,b_}/;a==0],First][[-1,2]];
pivotcol1=Position[vars,invar][[1,1]];
ratio=MapThread[If[#2==0,#1/0.00000001,#1/#2]&,{sol,
simplexmatrix[[All,pivotcol1]]}]];

mySimplexIteration[varstemp_List,bvartemp_List,nonbvartemp_List,simplexmatrixtemp_List,
objcoeftemp_List,soltemp_List,objsoltemp_]:=Block[{M,vars=varstemp,bvar=bvartemp,
nonbvar=nonbvartemp,simplexmatrix=simplexmatrixtemp,simplexmatrixall,
objcoef=objcoeftemp,sol=soltemp,objsol=objsoltemp,invar,
outvar,pivotcol1,pivotcol2,rowtrans,outtemp,mytab1,mytab2,z},

(*選擇進入變數*)
invar=SortBy[DeleteCases[Transpose@{objcoef,vars},{a_,b_}/;a==0],First][[-1,2]];
pivotcol1=Position[vars,invar][[1,1]];

(*選擇離去變數*)
outvar=SortBy[Select[Transpose@{bvar,sol/simplexmatrix[[All,pivotcol1]]},
#[[2]]>0&],Last][[1,1]]//Quiet;
pivotcol2=Position[bvar,outvar][[1,1]];

(*對基本變數進行列運算*)
simplexmatrixall=
Insert[MapThread[Flatten@{#1,#2}&,{simplexmatrix,sol}],
Flatten@{objcoef,objsol},1];

mytab1=Grid[Prepend[Partition[Flatten[Transpose@{Flatten[{"c-z",bvar}],
simplexmatrixall}],2+Length@vars],Flatten[{"",vars,"Solution"}]],
Spacings->{2,2},Frame->All,
Background->{None,{Lighter[Yellow,0.9],Lighter[Red,0.9],
{Lighter[Blend[{Blue,Green}],0.8],White}}},
FrameStyle->Directive[Thickness[1]],
ItemSize->{Flatten[{2,Table[2,{Length@vars}],Automatic}]}];
simplexmatrixall[[1+pivotcol2]]=
simplexmatrixall[[1+pivotcol2]]/
simplexmatrixall[[1+pivotcol2,pivotcol1]];
rowtrans=simplexmatrixall[[All,pivotcol1]]/
simplexmatrixall[[1+pivotcol2,pivotcol1]];
rowtrans[[1+pivotcol2]]=0;
simplexmatrixall=simplexmatrixall[[#]]-
rowtrans[[#]]*simplexmatrixall[[1+pivotcol2]]&/@
Range[Length@rowtrans];
sol=simplexmatrixall[[All,-1]][[2;;-1]];
simplexmatrix=simplexmatrixall[[2;;-1]][[All,1;;-2]];
objcoef=simplexmatrixall[[1,1;;-2]];
objsol=simplexmatrixall[[1,-1]];

(*更新基本變數和非基本變數*)
bvar=bvar/.outvar->invar;
nonbvar=nonbvar/.invar->outvar;

(*SimplexMethod表格輸出*)
mytab2=Grid[Prepend[Partition[Flatten[Transpose@{Flatten[{"c-z",bvar}],
simplexmatrixall}],2+Length@vars],Flatten[{"",vars,"Solution"}]],
Spacings->{2,2},
Frame->All,
Background->{None,{Lighter[Yellow,0.9],Lighter[Red,0.9],
{Lighter[Blend[{Blue,Green}],0.8],White}}},
FrameStyle->Directive[Thickness[1]],
ItemSize->{Flatten[{2,Table[2,{Length@vars}],Automatic}]}];

(*SimplexMethod結果輸出*)
Simplify@{vars,bvar,Complement[vars,bvar],simplexmatrix,
objcoef,sol,objsol,
Length@Select[myPivotRatio[vars,bvar,nonbvar,simplexmatrix,objcoef,
sol,objsol],#>=0&],
mytab1,mytab2}];

mySimplex[vars_,bvar_,nonbvar_,simplexmatrix_,objcoef_,sol_,objsol_]:=
Block[{init,myiter,nonbvarpos,simplexans},
init={vars,bvar,nonbvar,simplexmatrix,objcoef,sol,objsol,1,None,None};
$mySimplexIteration=NestWhileList[mySimplexIteration@@#[[1;;-4]]&,init,
(If[#[[-3]]==0,Print["Unboundedsolution"]];
Length[Select[#[[5]],Positive]]>0&&#[[-3]]>0)&][[2;;-1]];
$mySimplexIterationTable=Flatten@{$mySimplexIteration[[1,-2]],
$mySimplexIteration[[All,-1]]};
nonbvarpos[i_]:=Position[$mySimplexIteration[[i,2]],#]&/@nonbvar;
simplexans[i_]:=MapThread[If[#2=={},Rule[#1,0],
Rule[#1,$mySimplexIteration[[i,6]][[#2[[1,1]]]]]]&,
{nonbvar,nonbvarpos[i]}];
$myVariableIteration=Insert[Table[nonbvar/.simplexans[z],
{z,Length@$mySimplexIteration}],Table[0,{Length@nonbvar}],1];
{-$mySimplexIteration[[-1,-4]],simplexans[-1]}]


bvar={s1,s2,s3,s4};
nonbvar={x1,x2};
vars=Flatten[{nonbvar,bvar}];
objcoef={5,4,0,0,0,0};
nonbmatrix={{6,4},{1,2},{-1,1},{0,1}};
bmatrix=IdentityMatrix[Length@bvar];
sol={24,6,1,2};
simplexmatrix=MapThread[Flatten[{#1,#2}]&,{nonbmatrix,bmatrix}];
mySimplex[vars,bvar,nonbvar,simplexmatrix,objcoef,sol,0]
$myVariableIteration
Column@$mySimplexIterationTable

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

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