Оптимізація структури комп’ютерної мережі з використанням методу сторінка 6

Simplex.AddCons(Con[i].B,Con[i].A,Con[i].Sign); end; if (Simplex.Solve=SIMPLEX_DONE) then begin
Memo1.Lines.Add('Q'+IntToStr(StepNumber)+'='+FloatToStr(Simplex.GetMin));
Q[StepNumber-1]:=Simplex.GetMin;
SetLength(X,0);
X:=Simplex.GetSolution;

78 for i:=1 to CrutCount do begin if i<>StepNumber then begin
Memo1.Lines.Add('Q'+IntToStr(i)+'='+FloatToStr(GetQ(i,X)));
Q[i-1]:=GetQ(i,X); end;
QChart.Series[i-1].AddXY(StepNumber,Q[i-1]);
QStringGrid.Cells[i-1,1]:=FloatToStrF(GetQ(i,X),ffGeneral,3,3); end; for i:=0 to (ZminCount-1) do begin
XChart.Series[i].AddXY(StepNumber,X[i]);
Memo1.Lines.Add('x'+IntToStr(i+1)+'='+FloatToStr(X[i])); xStringGrid.Cells[i,1]:=FloatToStrF(X[i],ffGeneral,3,3); end; for i:=1 to (CrutCount-1) do begin
Memo1.Lines.Add('dQ'+IntToStr(i)+'='+FloatToStr(dQ[2,i-1])); dQStringGrid.Cells[i,1]:=FloatToStrF(dQ[1,i-1],ffGeneral,3,3); dQStringGrid.Cells[i,2]:=FloatToStrF(dQ[2,i-1],ffGeneral,3,3); end; end else begin if Simplex.Solve=(SIMPLEX_NO_SOLUTION) then
Memo1.Lines.Add('>>> Неможиво утвoрити базис'); exit; end;
Memo1.Lines.Add('============================================
======');

79
Memo1.Lines.Add('');
Simplex.Free; if (StepNumber=CrutCount) then begin dQPanel.Visible:=false;
Label8.Visible:=false;
Label9.Visible:=false;
Label10.Visible:=false;
Label11.Visible:=false;
Edit1.Visible:=false;
Button5.Visible:=false;
Button2.Visible:=false;
Button6.Visible:=false;
Label1.Caption:='Робоут завершено.
Кількість кроків '+IntToStr(StepNumber);
Memo1.Lines.Add('>>> Досягнуто останього кроку');
Memo1.Lines.Add('>>> Роботу завершено'); end; dQPanel.Visible:=true; dQPanel.Enabled:=true;
Button2.Enabled:=false;
Label8.Caption:='Призначення поступку для Q'+IntToStr(StepNumber); end; function TForm1.GetQ(nQ:word;R:TExtArray):extended; var i:word; s:extended; begin

80 s:=0; for i:=0 to (ZminCount-1) do begin s:=s+Cr[nq-1].Cr[i]*R[i]; end;
Result:=s; end; procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if not ((key='0') or (key='1') or (key='2') or (key='3') or
(key='4') or (key='5') or (key='6') or (key='7') or
(key='8') or (key='9') or (key=#13) or (key=#8)) then key:=#0; end; procedure TForm1.Button6Click(Sender: TObject); var i:word; begin
Memo1.Lines.Add('>>> Припинено користувачем');
Memo1.Lines.Add('============================================
======');
Memo1.Lines.Add('Остаточні результати');
Memo1.Lines.Add('============================================
======'); for i:=1 to CrutCount do begin
Memo1.Lines.Add('Q'+IntToStr(i)+'='+FloatToStr(GetQ(i,X))); end; for i:=0 to (ZminCount-1) do begin

81
Memo1.Lines.Add('x'+IntToStr(i+1)+'='+FloatToStr(X[i])); end;
Memo1.Lines.Add('============================================
======'); end; procedure TForm1.Button5Click(Sender: TObject); var i:word; st:string; begin dQ[1,StepNumber-1]:=StrToInt(Edit1.Text); dQ[2,StepNumber-1]:=(Q[StepNumber-1]*dQ[1,StepNumber-1])/100; dQStringGrid.Cells[StepNumber,1]:=FloatToStrF(dQ[1,StepNumber-
1],ffGeneral,3,3); dQStringGrid.Cells[StepNumber,2]:=FloatToStrF(dQ[2,StepNumber-
1],ffGeneral,3,3);
Button2.Enabled:=true; dQPanel.Enabled:=false;
Label11.Visible:=true;
Memo1.Lines.Add('>>> Призначено поступку');
Memo1.Lines.Add('============================================
======');
Memo1.Lines.Add('dQ'+IntToStr(StepNumber)+'='+Edit1.Text+'%');
Memo1.Lines.Add('dQ'+IntToStr(StepNumber)+'='+FloatToStr(dQ[2,StepNumber
-1]));
Memo1.Lines.Add('============================================
======');
SetLength(Con,Length(Con)+1);
ConsCount:=ConsCount+1;
SetLength(Con[ConsCount-1].A,ZminCount+1);

82 for i:=0 to (ZminCount-1) do begin
Con[ConsCount-1].A[i]:=Cr[StepNumber-1].Cr[i]; end;
Con[ConsCount-1].A[ZminCount]:=1;
Con[ConsCount-1].Sign:=Greater;
Con[ConsCount-1].B:=Q[StepNumber-1]-dQ[2,StepNumber-1]; for i:=StepNumber to (CrutCount-1) do begin
SetLength(Cr[i].Cr,Length(Cr[i].Cr)+1);
Cr[i].Cr[Length(Cr[i].Cr)-1]:=-50000; end;
Memo1.Lines.Add('');
Memo1.Lines.Add('>>> Введено додаткове обмеження');
Memo1.Lines.Add('============================================
======');
Memo1.Lines.Add('Q'+IntToStr(StepNumber)+'>='+'Q*'+IntToStr(StepNumber)+
'-'+'dQ'+IntToStr(StepNumber)); st:=''; st:=st+FloatToStrF(Cr[StepNumber-1].Cr[0],ffGeneral,3,3)+'*x1'; for i:=1 to (ZminCount-1) do begin if (Cr[StepNumber-1].Cr[i]>=0) then st:=st+'+'+FloatToStrF(Cr[StepNumber-
1].Cr[i],ffGeneral,3,3) else st:=st+FloatToStrF(Cr[StepNumber-1].Cr[i],ffGeneral,3,3); st:=st+'*x'+IntToStr(i+1); end; st:=st+'>=';

83 st:=st+FloatToStrF(Q[StepNumber-1]-dQ[2,StepNumber-1],ffGeneral,3,3);
Memo1.Lines.Add(st);
Memo1.Lines.Add('============================================
======'); end; procedure TForm1.Button7Click(Sender: TObject); begin if SaveDialog2.Execute then begin
QChart.SaveToBitmapFile(SaveDialog2.FileName);
Memo1.Lines.Add('');
Memo1.Lines.Add('>>> Графік значень Q успішно записаний в файл '+SaveDialog2.FileName);
Memo1.Lines.Add(''); end; end; procedure TForm1.Button8Click(Sender: TObject); begin if SaveDialog3.Execute then begin
XChart.SaveToBitmapFile(SaveDialog3.FileName);
Memo1.Lines.Add('');
Memo1.Lines.Add('>>> Графік значень X успішно записаний в файл '+SaveDialog3.FileName);
Memo1.Lines.Add(''); end; end; procedure TForm1.TabSheet5Show(Sender: TObject);

84 begin
Image1.Visible:=false;
Label12.Top:=Label12.Top+440;
Label13.Top:=Label13.Top+440;
Label14.Top:=Label14.Top+440;
Label15.Top:=Label15.Top+440;
Label16.Top:=Label16.Top+440;
Label17.Top:=Label17.Top+440;
Label18.Top:=Label18.Top+440;
Label19.Top:=Label19.Top+440;
Label20.Top:=Label20.Top+440;
Label21.Top:=Label21.Top+440;
Label22.Top:=Label22.Top+440;
Label23.Top:=Label23.Top+440;
Timer1.Enabled:=true; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if (Label20.Top>20) then begin
Label12.Top:=Label12.Top-2;
Label13.Top:=Label13.Top-2;
Label14.Top:=Label14.Top-2;
Label15.Top:=Label15.Top-2;
Label16.Top:=Label16.Top-2;
Label17.Top:=Label17.Top-2;
Label18.Top:=Label18.Top-2;
Label19.Top:=Label19.Top-2;
Label20.Top:=Label20.Top-2;
Label21.Top:=Label21.Top-2;

86
Додаток Б
Лістинг програми SimplexUnit.pas – модулядля роботи симплекс методу unit SimplexUnit; interface const
SIMPLEX_DONE = 0;
SIMPLEX_NO_SOLUTION = 1;
SIMPLEX_NO_BOTTOM = 2;
SIMPLEX_NEXT_STEP = 3; type
TOperation = (Equal,Less,Greater);
TExtArray = array of extended;
TConstrain = record
A : TExtArray;
B : extended;
Sign : TOperation; end;
TCruterij = record
Cr : TExtArray;
F : boolean; end;
TSimplex = class
M,N : integer;
Cons : array of TConstrain;
C : TExtArray;

87
L : extended;
Basis : array of integer;
Max : boolean;
Constructor Create(_C:TExtArray; Maximize:boolean=false);
Constructor CreateBasis(const Simplex:TSimplex);
Constructor Copy(const Simplex:TSimplex);
Procedure AddCons(_B:extended; _A:TExtArray; Sign:TOperation);
Procedure SetAllLengths(Len:integer);
Function SimplexStep:integer;
Function CheckBasis:boolean;
Procedure Normalize;
Procedure MulString(Number:integer; Value:extended);
Procedure AddString(Num1,Num2:integer; Value:extended);
Function Solve:integer;
Function GetMin:extended;
Function GetSolution:TExtArray;
Destructor Free; end;
TIntSimplex = class(TSimplex)
CurX : TExtArray;
CurL : extended;
CurFound : boolean;
Constructor Create(_C:TExtArray; Maximize:boolean=false);
Procedure DelLastCons;
Function IntSolve:integer;

88
Function GetIntMin:extended;
Function IsInteger(value:extended):boolean;
Function GetIntSolution:TExtArray;
Function SearchCons(_B:extended;_A:TExtArray):integer; end; implementation uses Math; procedure TSimplex.AddCons(_B: extended; _A: TExtArray; Sign: TOperation); var j : integer; begin if (Length(_A)>N) then SetAllLengths(Length(_A)); inc(M);
SetLength(Cons,M); if ((_B=0) and (Sign=Less)) then Sign:=Equal;
Cons[M-1].B:=_B;
Cons[M-1].Sign:=Sign;
SetLength(Cons[M-1].A,N); for j:=0 to Length(_A)-1 do Cons[M-1].A[j]:=_A[j]; if Length(_A)N-1 do
Cons[Num1].A[j]:=Cons[Num1].A[j]+Cons[Num2].A[j]*Value;

89
Cons[Num1].B:=Cons[Num1].B+Cons[Num2].B*Value; end; function TSimplex.CheckBasis: boolean; var i,j,k : integer; f : boolean; begin
SetLength(Basis,M); for i:=0 to M-1 do Basis[i]:=-1; for j:=0 to N-1 do begin f:=true; k:=-1; i:=0; while (f and (i0) and (Cons[i].A[j]<>1)) then f:=false; if (Cons[i].A[j]=1) then begin if (k=-1) then k:=i else f:=false; end; inc(i); end; if (f and (k<>-1)) then Basis[k]:=j; end; f:=true; for i:=0 to M-1 do f:=f and (Basis[i]<>-1);
Result:=f; end; constructor TSimplex.Create(_C: TExtArray; Maximize:boolean); var

90 j : integer; begin
N:=Length(_C);
M:=0;
SetLength(C,N);
Max:=Maximize; if (Maximize) then for j:=0 to N-1 do C[j]:=-_C[j] else for j:=0 to N-1 do C[j]:=_C[j];
Max:=Maximize; end; constructor TSimplex.Copy(const Simplex: TSimplex); var i,j : integer; begin
M:=Simplex.M;
N:=Simplex.N;
SetLength(Cons,M);
SetLength(Basis,M);
SetLength(C,N);
Max:=Simplex.Max; for i:=0 to M-1 do begin
SetLength(Cons[i].A,N);
Basis[i]:=-1; for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];
Cons[i].B:=Simplex.Cons[i].B;
Cons[i].Sign:=Simplex.Cons[i].Sign; end; for i:=0 to Simplex.N-1 do C[i]:=Simplex.C[i]; end;

91 constructor TSimplex.CreateBasis(const Simplex: TSimplex); var i,j : integer; begin
M:=Simplex.M;
N:=Simplex.N;
SetLength(Cons,M);
SetLength(Basis,M); for i:=0 to M-1 do begin
SetLength(Cons[i].A,N); for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];
Cons[i].B:=Simplex.Cons[i].B;
Cons[i].Sign:=equal; end; for i:=0 to M-1 do begin if (Simplex.Basis[i]<>-1) then Basis[i]:=Simplex.Basis[i] else begin
SetAllLengths(N+1); for j:=0 to M-1 do Cons[j].A[N-1]:=0;
Cons[i].A[N-1]:=1; end; end;
SetLength(C,N); for i:=0 to Simplex.N-1 do C[i]:=0; for i:=Simplex.N to N-1 do C[i]:=1; end; destructor TSimplex.Free; begin
SetLength(C,0);
SetLength(Basis,0);

92
SetLength(Cons,0);
M:=0;
N:=0; end; function TSimplex.GetMin: extended; var i : integer; begin
L:=0; for i:=0 to M-1 do if (Basis[i] L:=L+C[Basis[i]]*Cons[i].B; end; if (Max) then Result:=-L else Result:=L; end; function TSimplex.GetSolution: TExtArray; var
Solution : TExtArray; i,j : integer; begin
SetLength(Solution,N); for j:=0 to N-1 do begin
Solution[j]:=0; i:=0; while ((ij)) do inc(i); if ((Basis[i]=j) and (i Result:=Solution; end;

93 procedure TSimplex.MulString(Number: integer; Value: extended); var j : integer; begin for j:=0 to N-1 do Cons[Number].A[j]:=Cons[Number].A[j]*Value;
Cons[Number].B:=Cons[Number].B*Value; end; procedure TSimplex.Normalize; var i : integer; begin for i:=0 to M-1 do if (Cons[i].Sign<>Equal) then begin
SetAllLengths(N+1); if (Cons[i].Sign=Greater) then Cons[i].A[N-1]:=-1 else Cons[i].A[N-1]:=1; end; end; procedure TSimplex.SetAllLengths(Len: integer); var i, j : integer;
OldN : integer; begin
OldN:=N;
N:=Len;
SetLength(C,N); for i:=0 to M-1 do SetLength(Cons[i].A,N); if (OldN

94
C[j]:=0; for i:=0 to M-1 do Cons[i].A[j]:=0; end; end; end; function TSimplex.SimplexStep: integer; var
Delta : TExtArray; i,j : integer;
MaxVal : extended;
MaxNum : integer;
AB : extended;
ABLine : integer; begin
SetLength(Delta,N);
MaxVal:=0.1e-12;
MaxNum:=N; for j:=0 to N-1 do begin
Delta[j]:=0; for i:=0 to M-1 do Delta[j]:=Delta[j]+Cons[i].A[j]*C[Basis[i]];
Delta[j]:=Delta[j]-C[j]; if (Delta[j]>MaxVal) then begin
MaxVal:=Delta[j];
MaxNum:=j; end; end; if (MaxNum=N) then Result:=SIMPLEX_DONE else begin
AB:=0;
ABLine:=M;

95 for i:=0 to M-1 do if (Cons[i].A[maxnum]<>0) then begin if
((Cons[i].B/Cons[i].A[maxnum]>=0) and
((Cons[i].B/Cons[i].A[maxnum] AB:=Cons[i].B/Cons[i].A[maxnum];
ABLine:=i; end; end; if (ABLine=M) then Result:=SIMPLEX_NO_BOTTOM else begin for i:=0 to
M-1 do if
(i<>ABline) then
AddString(i,ABline,-
Cons[i].A[maxnum]/Cons[ABline].A[maxnum]);
MulString(ABline,1/Cons[ABline].A[maxnum]);
Basis[ABline]:=MaxNum;
Result:=SIMPLEX_NEXT_STEP;
L:=0; for i:=0 to M-1 do begin
L:=L+C[Basis[i]]*Cons[i].B; end; end; end; end; function TSimplex.Solve: integer; var
OldN : integer; i,j : integer;
Simplex : TSimplex; f : boolean;
Step : integer; begin
OldN:=N;

96
Normalize; f:=false; if (not CheckBasis) then begin
Simplex:=TSimplex.CreateBasis(self);
Simplex.Solve; f:=Simplex.GetMin<>0; if (not f) then for i:=0 to M-1 do begin for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];
Cons[i].B:=Simplex.Cons[i].B;
Basis[i]:=Simplex.Basis[i]; end;
Simplex.Free; end; if (f) then Step:=SIMPLEX_NO_SOLUTION else repeat
Step:=SimplexStep; until (Step<>SIMPLEX_NEXT_STEP);
SetAllLengths(OldN);
Result:=Step; end; constructor TIntSimplex.Create(_C:TExtArray; Maximize:boolean=false); begin
CurFound:=false; inherited; end; procedure TIntSimplex.DelLastCons();

97 begin dec(M);
SetLength(Cons,M); end; function TIntSimplex.GetIntMin: extended; begin
Result:=CurL; end; function TIntSimplex.GetIntSolution: TExtArray; begin
Result:=CurX; end; function TIntSimplex.IsInteger(Value:extended):boolean; begin
Result:=((Value=floor(Value)) or (Value=ceil(Value))); end; function TIntSimplex.IntSolve: integer; var i : integer;
OldN : integer;
FractCol : integer;
TmpX : TExtArray;
TmpCons : TExtArray;
Simplex : TSimplex;

98
NewValue : extended;
OldCons : integer;
OldSign : TOperation; begin
OldSign:=Equal;
SetLength(TmpX,1);
Simplex:=TSimplex.Copy(self); if (Simplex.Solve=SIMPLEX_DONE) then begin if
(not
CurFound or
((Simplex.GetMinMax) or
((Simplex.GetMin>CurL) and Max)) then begin
TmpX:=Simplex.GetSolution; i:=0; while ((i FractCol:=i; if (FractCol<>N) then begin
OldN:=N;
SetLength(TmpCons,OldN); for i:=0 to N-1 do TmpCons[i]:=0;
TmpCons[FractCol]:=1;
NewValue:=floor(TmpX[FractCol]);
OldCons:=SearchCons(NewValue,TmpCons); if (OldCons=-1) then AddCons(NewValue,TmpCons,less) else begin
OldSign:=Cons[OldCons].Sign;
Cons[OldCons].Sign:=Equal; end;
IntSolve;

99 if (OldCons=-1) then DelLastCons else Cons[OldCons].Sign:=OldSign;
NewValue:=ceil(TmpX[FractCol]);
OldCons:=SearchCons(NewValue,TmpCons); if (OldCons=-1) then AddCons(NewValue,TmpCons,greater) else begin
OldSign:=Cons[OldCons].Sign;
Cons[OldCons].Sign:=Equal; end;
IntSolve; if (OldCons=-1) then DelLastCons else Cons[OldCons].Sign:=OldSign;
SetAllLengths(OldN); end else begin
CurX:=Simplex.GetSolution;
CurL:=Simplex.GetMin;
CurFound:=true; end; end; end;
Simplex.Free; if (CurFound) then Result:=SIMPLEX_DONE else Result:=SIMPLEX_NO_SOLUTION; end;