Решение задач оптимизации симплекс-методом
Рефераты >> Программирование и компьютеры >> Решение задач оптимизации симплекс-методом

else begin

flag := FRadioButton2.Checked;

end;

main(flag, MaxRow);

end;

Exit;

end;

if Sender = FBitBtn3 then

begin

if Assigned(FOnBitBtn3Click) then FOnBitBtn3Click(Sender)

else begin

for i:= 1 to FStrGr.ColCount-1 do

for j := 1 to FStrGr.RowCount-1 do

FStrGr.Cells[i, j] := '';

end;

Label2.Caption:='';

Exit;

end;

end;

procedure TSimplexM.SetColX(Value: integer);

begin

FColX := Value;

FStrGr.ColCount := Value;

SGColRow;

Name0str(FColX);

Name0col(FColX);

end;

procedure TSimplexM.SGColRow; //построение таблицы

begin

maxrow:=2+FColX;

maxcol:=2+2*FColX;

FStrGr.ColCount := 2*FColX+2;

FStrGr.RowCount := 2+FColX;

end;

function TSimplexM.Res(var NumMinCol:integer): boolean;

// ищем отрицательные числа в строке F ,если есть - выходим из цикла

var i: integer;

begin

res:=true;

for i:=2 to MaxCol-1 do

begin

if strtofloat(FStrGr.Cells[i,maxRow-1])<0 then

begin

NumMinCol:=i;

res:=false;

break;

end

end;

end;

procedure TSimplexM.divizion(NumMinCol: integer); // деление гл.строки на нужный коэффициент

var i: integer;

d: real;

begin

d:=strtofloat(FStrGr.Cells[NumMinCol,1]);

for i:=1 to MaxCol-1 do

FStrGr.Cells[i,1]:=floattostr

( (strtofloat(FStrGr.Cells[i,1]))/d );

end;

procedure TSimplexM.Adding(RowSet, ColSet, MaxCol, MaxRow, NumMinCol :integer);

//сложение главной строки с другими для получения нуля

var

i, j: integer;

tmp: string;

t: real;

begin

if RowSet>1 then

begin

for i:=0 to MaxCol-1 do

begin

tmp:=FStrGr.Cells[i,1]; // поднимаем главную строку в первую строку

FStrGr.Cells[i,1]:=FStrGr.Cells[i,RowSet];

FStrGr.Cells[i,RowSet]:=tmp;

end;

end;

divizion(NumMinCol);

for i:=2 to MaxRow-1 do

begin

t:=strtofloat(FStrGr.Cells[NumMinCol,i]); // коффициенты в др.строках

for j:=1 to MaxCol-1 do

begin

if t<0 then FStrGr.Cells[j,i]:=floattostr (strtofloat(FStrGr.Cells[j,1])*abs(t)+strtofloat(FStrGr.Cells[j,i]))

// умножаем на нужный коэффициент другой строки и складываем

else FStrGr.Cells[j,i]:=floattostr (strtofloat(FStrGr.Cells[j,1])*(-t)+strtofloat(FStrGr.Cells[j,i]));

end;

end;

end;

// главная процедура

procedure TSimplexM.Main ( var flag: boolean; MaxRow: integer);

var i, NumMinCol, ColSet, RowSet: integer;

date: real;

Answ, nn: boolean;

begin

Answ:=true;

nn:=false;

if flag then

for i:=2 to FColX+1 do

try

FStrGr.Cells[i,MaxRow-1]:=floattostr

(0-strtofloat(FStrGr.Cells[i,MaxRow-1]))

except

raise Exception.Create('Неверный формат данных');

end

else begin

for i:=2 to FColX+1 do

try

if strtofloat(FStrGr.Cells[i,MaxRow-1])<0 then nn:=true;

except

raise Exception.Create(' Неверный формат данных');

end;

if not nn then

begin

resultat(flag);

exit;

end;

end;

while not Res(NumMinCol) do

begin

MinPlusDate(Answ, FColX, NumMinCol, ColSet, RowSet, date);

if Answ=false then raise Exception.Create('Нет решений') else

begin

FStrGr.Cells[0,RowSet]:='X'+inttostr(ColSet-1);

Adding(RowSet, ColSet, MaxCol, MaxRow, NumMinCol);

end;

end;

resultat(flag);

end;

procedure TSimplexM.MinPlusDate( var Answ: boolean; xov, NumMinCol: integer; var ColSet, RowSet:integer; var date:real);

//ищем наименьшее пложительное от деления св.чл. на гл.неизвестые

var t: real;

i, j, count : integer;

begin

count:=0; // кол-во отрицательных значений в столбце

for i:=1 to MaxRow-2 do

if strtofloat(FStrGr.Cells[NumMinCol,i])<0 then

count:=count+1;

if count=xov then // если кол-во отрицательных значений в столбце равно кол-ву неизвестных, то решения не существует

begin

Answ:=false;

exit;

end;

ColSet:=NumMinCol; // присвоение координат минимального из положительных (нужного) в столбце NumMinCol

RowSet:=1;

j:=1;

repeat

date:=(strtofloat(FStrGr.cells[1,j]))/(strtofloat(FStrGr.cells[NumMinCol,j])); // делим св.член на нужное

j:=j+1;

until date>0;

RowSet:=j-1; // опережает

for i:=j to MaxRow-2 do

begin

t:=(strtofloat(FStrGr.cells[1,i]))/(strtofloat(FStrGr.cells[NumMinCol,i]));

if t > 0 then

if t < date then

begin

date:=t;

RowSet:=i;

end;

end;

end;

procedure TSimplexM.Resultat; // вывод результата на экран

begin

if flag=false then Flabel2.caption:= floattostr

(-strtofloat(FStrGr.Cells[1,MaxRow-1]))

else Flabel2.caption:= FStrGr.Cells[1,MaxRow-1]

end;

procedure TSimplexM.Name0str(xov: integer); //именование нулевой строки

var i, j: integer;

begin

j:=0;

for i:=2 to 2*(xov+1) do

begin

j:=j+1;

FStrGr.Cells[i,0]:='X'+inttostr(j);

end;

end;

procedure TSimplexM.Name0Col(xov: integer); //именование нулевого столбца

var i, j: integer;

begin

j:=xov;

for i:=1 to xov do

begin

j:=j+1;

FStrGr.Cells[0,i]:='X'+inttostr(j);

end;

FStrGr.Cells[0,xov+1]:='F';

end;

procedure TSimplexM.InputData(var xov,MaxRow: integer); // введение количества неизвестных

begin

xov:=FColX;

maxrow:=2+xov;

maxcol:=2+2*xov;

FStrGr.RowCount:=maxrow;

FStrGr.ColCount:=maxcol ;

end;

procedure TSimplexM.SaveData; //сохранение вводимых в таблицу данных

var

i: Integer;

begin

SetLength(Data, FStrGr.Rowcount);

for i := 0 to FStrGr.RowCount do

begin

Data[i] := TStringList.Create;

Data[i].Assign(FStrGr.Rows[i]);

end;

end;

procedure TSimplexM.LoadData; //чтение в таблицу сохранённых данных

var

i: Integer;

begin

for i := 0 to Length(Data) do

begin

FStrGr.Rows[i].Assign(Data[i]);

end;

SetLength(Data, 0);

end;

procedure TSimplexM.SetBitBtn4Click(Sender: TObject);

begin

SaveData;

end;

procedure TSimplexM.SetBitBtn5Click(Sender: TObject);

begin

Label2.Caption:='';

LoadData;

end;

end.

5.Контрольный пример.

Завод выпускает продукцию 1-го и 2-го типа. Прибыль от реализации единицы продукции соответственно составляет 30 и 40 у.е.

На выпуск единицы продукции 1-го типа расходуется 4 единиц сырья категории А, 4 ед. – категории В. Для выпуска единицы продукции 2-го типа расходуется сырья категории А - 3 ед., категории С – 12 единицы.

Имеющиеся в наличие запасы сырья категории А – 120 единиц, В – 252 единицы.

Тип выпускаемой продукции

Расход сырья (ед.)

Прибыль от реализации единицы продукции (у.е.)

А

В

1

4

4

30

2

3

12

40

Запасы сырья (ед.)

120

252

 


Страница: