Смекни!
smekni.com
Информатика

Решение задач линейного программирования симплекс методом (стр. 3 из 4)

В остальных клетках столбца x2 плана 2 записываем нули.

Таким образом, в новом плане 2 заполнены строка x2 и столбец x2 .

Все остальные элементы нового плана 2, включая элементы индексной строки, определяются по правилу прямоугольника.

Для этого выбираем из старого плана четыре числа, которые расположены в вершинах прямоугольника и всегда включают разрешающий элемент РЭ.

НЭ = СЭ - (А*В)/РЭ

СТЭ - элемент старого плана, РЭ - разрешающий элемент (5.5), А и В - элементы старого плана, образующие прямоугольник с элементами СТЭ и РЭ.

Представим расчет каждого элемента в виде таблицы:

Конец итераций: найден оптимальный план


Окончательный вариант симплекс-таблицы:

X1 X2 X3 X4 X5 X6 св. чл.
1 0 159/100 41/100 0 -9/100 729/20
0 0 -191/100 -109/100 1 -9/100 1429/20
0 1 -15/22 -7/22 0 9/50 243/11
0 0 1886.36 413.64 0 263.64

Оптимальный план можно записать так:

x1 = 729/20=36.45

x5 =1429/20= 71.45

x2 =243/11= 22.09

F(X) = 3500*36.45 + 3200*22.09 = 198281.82

Программная реализация

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Edit2: TEdit;

Exit: TButton;

Button_Next: TButton;

Edit1: TEdit;

Button_Prev: TButton;

ScrollBox1: TScrollBox;

Conditions: TGroupBox;

Label3: TLabel;

Extrem: TComboBox;

Memo1: TMemo;

procedure ExitClick(Sender: TObject);

procedure Button_NextClick(Sender: TObject);

procedure Button_PrevClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

mm = 100; nn = 100;

var

Form1: TForm1;

table_changed,done,solve,is_ok,kanon,need_basis,need_i_basis,is_basis,written: boolean;

m,n,y,i_basis,i0,j0,step,iter: integer;{m - элементов , n - ограничений}

pole: array [1..nn, 1..mm] of TEdit; {полядляввода}

podpis: array [0..nn, 0..mm] of TLabel; {подписиполей}

znak: array [1..nn] of TComboBox; {знакисравненияограничений}

matrix: array [1..nn, 1..mm] of double; {массивдлярассчетов}

all_basis: array [1..nn] of integer;{номерабазисныхпеременных}

f: text;{файловая переменная для отчета}

tochnost: double;

implementation

{$R *.dfm}

procedure Init;

{инициализация: ввод размеров системы}

Begin

form1.Button_Prev.Enabled:=false;

form1.Edit1.Enabled:=true;

form1.Edit2.Enabled:=true;

form1.Extrem.Enabled:=true;

form1.ScrollBox1.DestroyComponents;{расчищаемместоподтабличку}

table_changed:=true;

tochnost:=0.000000001;

assign(f, 'report.htm');

end;

procedure Step1;

{шаг первый: создание таблички и ввод значений}

var

i,j: integer;

nadpis: string;

begin

form1.Memo1.ReadOnly:=false;

form1.Memo1.Lines.Clear;

form1.Memo1.ReadOnly:=true;

form1.Extrem.Enabled:=true;

iftable_changed=truethen {если меняли количество эл-тов или ограничений,}

begin {то создаем новую табличку}

table_changed:=false;

m:=strtoint(form1.Edit1.Text);{считываемколичествопеременных}

n:=strtoi

nt(form1.Edit2.Text);{иограничений}

form1.Edit1.Enabled:=false;{блокируемполядляихввода}

form1.Edit2.Enabled:=false;

i:=0; {используем нулевую строку массива подписей для заголовков}

for j:=1 to 3 do {подписываемчто is что}

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Left:=5;

podpis[i,j].Top:=32*(j-1); {расстояниемеждунадписями}

case j of

1: nadpis:='Целеваяфункция:';

2: nadpis:='F(x)=';

3: nadpis:='Система ограничений:';

end;

podpis[i,j].Caption:=nadpis;

end;

i:=n+1; {используем последнюю строку массива полей для целевой ф-ции}

for j:=1 to m+1 do

begin

pole[i,j]:=TEdit.Create(Form1.ScrollBox1);

pole[i,j].parent:=form1.ScrollBox1;

pole[i,j].Height:=20;

pole[i,j].Width:=40;

pole[i,j].Left:=80*(j-1)+30;

pole[i,j].Top:=30;

pole[i,j].Text:='0';

if j<=m then

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Height:=20;

podpis[i,j].Width:=20;

podpis[i,j].Left:=pole[i,j].Left+pole[i,j].Width+2;

podpis[i,j].Top:=pole[i,j].Top+2;

podpis[i,j].Caption:='X['+inttostr(j)+']';

if j<>m+1 then podpis[i,j].Caption:=podpis[i,j].Caption+' +';

{если поле не последнее, то дописываем плюсик}

end;

end;

for i:=1 to n do {полядлявводаограничений}

for j:=1 to m+1 do

begin

pole[i,j]:=TEdit.Create(Form1.ScrollBox1);

pole[i,j].parent:=form1.ScrollBox1;

pole[i,j].Height:=20;

pole[i,j].Width:=40;

pole[i,j].Left:=80*(j-1)+5; {расстояние между соседними + отступ от края}

pole[i,j].Top:=40*(i-1)+100;

pole[i,j].Text:='0';

if j<=m then

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Height:=20;

podpis[i,j].Width:=20;

podpis[i,j].Left:=pole[i,j].Left+pole[i,j].Width+2;

podpis[i,j].Top:=pole[i,j].Top+2;

podpis[i,j].Caption:='X['+inttostr(j)+']';

if j<>m then podpis[i,j].Caption:=podpis[i,j].Caption+' +'

{если поле не последнее, то дописываем плюсик; иначе пишем знак}

else begin

znak[i]:=TComboBox.Create(Form1.ScrollBox1);

znak[i].parent:=form1.ScrollBox1;

znak[i].Height:=20;

znak[i].Width:=40;

znak[i].Left:=podpis[i,j].Left+podpis[i,j].Width+25;

znak[i].Top:=pole[i,j].Top;

znak[i].Items.Insert( 0,'> ');

znak[i].Items.Insert( 1,'>=');

znak[i].Items.Insert( 2,' =');

znak[i].Items.Insert( 3,'<=');

znak[i].Items.Insert( 4,'< ');

znak[i].ItemIndex:=1;

end;

end else pole[i,j].Left:=pole[i,j].Left+70; //полядляправойчасти

//ограничений

end;

endelse {если табличку создавать не надо, то разблокируем поля}

begin

for i:=1 to n+1 do

for j:=1 to m+1 do

begin

pole[i,j].Enabled:=true;

if i<=n then znak[i].Enabled:=true;

end;

end;

end;

{/////////////////}

procedure write_system(strok,stolb: integer);

{записывает массив в виде уравнений}

var

i,j: integer;

begin

write(f,'<P>F(x) = ');

for j:=1 to stolb do

begin

write(f,matrix[strok,j]:0:3);

if j<stolb then

begin

write(f,'x<sub>',j,'</sub>');

if (kanon=true) and (j=stolb-1) then write(f,' = ') else

if (matrix[strok,j+1]>=0) then write(f,' + ') else write(f,' ');

end;

end;

writeln(f,'</P>');

writeln(f,'<P>При ограничениях:</P><P>');

for i:=1 to strok-1 do

begin

for j:=1 to stolb do

BEGIN

write(f,matrix[i,j]:0:3);

if j<stolb then write(f,'x<sub>',j,'</sub> ');

if j=stolb-1 then

if kanon=false then write(f,' ',znak[i].text,' ')

else write(f,' = ');

if (matrix[i,j+1]>=0) and (j<stolb-1) then write(f,'+');

end;

writeln(f,'<br>');

end;

writeln(f,'</P>');

end;

{/////////////////}

procedure zapisat(strok,stolb: integer; v_strok,v_stolb:integer);

{записывает массив в виде таблички}

var

i,j:integer;

begin

writeln(f,'<TABLE BORDER BORDERCOLOR=black CELLSPACING=0 CELLPADDING=5>');

for i:=0 to strok do

begin

writeln(f,'<TR>');

for j:=1 to stolb+1 do

begin

write(f,'<TD ');

if i=0 then

begin

if (i_basis<>0) and (j>m+y-i_basis) and (j<=m+y) then

write(f,'BGCOLOR=yellow ')

else

write(f,'BGCOLOR=green ');

end

else

if (i=v_strok) or (j=v_stolb) then write(f,'BGCOLOR=silver ') else

if (i=strok) or (j=stolb) then

if (j<>stolb+1) then write(f,'BGCOLOR=olive ');

write(f,'align=');

if (i=0) and (j<stolb) then write(f,'center>X<sub>',j,'<sub>') else

if (i=0) and (j=stolb) then write(f,'center>св. чл.') else

if (i=0) and (j=stolb+1) then write(f,'center>базис') else

if (j=stolb+1) then

if i<>n+1 then write(f,'center>X<sub>',all_basis[i],'</sub>') else

write(f,'center>&nbsp')

else

write(f,'right>',matrix[i,j]:1:3);

writeln(f,'</TD>');

end;

writeln(f,'</TR>');

end;

writeln(f,'</TABLE>');

end;

{/////////////////}

procedure findved;

{ищет ведущий элемент}

var

i,j,k: integer;

temp: double;

begin

done:=false;

solve:=false;

is_ok:=true;

temp:=100000;

i0:=0;

j0:=0;

i:=n+1;

for j:=1 to m+y do

if (i0=0) or (j0=0) then

if matrix[i,j]>0 then

begin

j0:=j;

for k:=1 to n do

if (matrix[k,j]>0) then

if (matrix[k,m+y+1]/matrix[k,j]<temp) then

begin

temp:=matrix[k,m+y+1]/matrix[k,j];

i0:=k;

end;

end;

if (j0=0) and (i0=0) then

for j:=1 to m do

if matrix[n+1,j]=0 then

for i:=1 to n do

if (matrix[i,j]<>0) and (matrix[i,j]<>1) then

begin

is_ok:=false;

j0:=j;

end;

if is_ok=false then

begin

temp:=100000;

for k:=1 to n do

if (matrix[k,j0]>0) then

if (matrix[k,m+y+1]/matrix[k,j0]<temp) then

begin

temp:=matrix[k,m+y+1]/matrix[k,j0];

i0:=k;

end;

end;

if (j0=0) and (i0=0) then

begin

writeln(f, '<P>Конецвычислений</P>');

done:=true;

solve:=true;

end

else if (j0<>0) and (i0=0) then

begin

writeln(f, '<P>Не удается решить систему</P>');

done:=true;

solve:=false;

end

else

if iter<>0 then

begin

writeln(f,'<P><b>Итерация ',iter,'</b></P>');

writeln(f, '<P>Найдем ведущий элемент:</P>');

zapisat(n+1,m+y+1,i0,j0);

writeln(f,'<P>Ведущий столбец: ',j0,'<br>Ведущая строка: ',i0,'</P>');

write(f,'<P>В строке ',i0,': базис ');

writeln(f,'X<sub>',all_basis[i0],'</sub> заменяем на X<sub>',j0,'</sub></P>');

all_basis[i0]:=j0;

end;

end;

{/////////////////}

procedure okr;

{округляетмелкиепогрешности}

var

i,j: integer;

begin

for i:=1 to n+1 do

for j:=1 to m+y+1 do

if abs(matrix[i,j]-round(matrix[i,j]))< tochnost then

matrix[i,j]:=round(matrix[i,j]);

end;

{/////////////////}

procedurepreobr;

{преобразует массив относительно ведущего элемента}

var

i,j,k,l,t: integer;

temp: double;

begin

if done=false then

begin

write(f, '<P>Пересчет:</P>');

temp:=matrix[i0,j0];

for j:=1 to m+y+1 do matrix[i0,j]:=matrix[i0,j]/temp;

for i:=1 to n+1 do

begin

temp:=matrix[i,j0];

for j:=1 to m+y+1 do

if (i<>i0) then

matrix[i,j]:=matrix[i,j]-matrix[i0,j]*temp;

end;

okr;

zapisat(n+1,m+y+1,-1,-1);

{/////////////////////////убираем искусственный базис/////////////////////}

ifi_basis>0 then {если он есть }

begin

t:=0;

forj:=m+y-i_basis+1 tom+ydo {от первого исскусственного элемеента до конца}

begin

need_i_basis:=false;{предполагаем, что элемент не нужен (*)}

fori:=1 tondo {просматриваем столбец}

ifall_basis[i]=jthen{и если элемент в базисе}

need_i_basis:=true;{тогда он все-таки нужен}

if need_i_basis=false then t:=j;

{если наши предположения (*) подтвердились, то запомним этот элемент}

end;

if t<>0 then

begin

for k:=1 to n+1 do {во всех строках}

begin

forl:=ttom+ydo {от текущего столбца до последнего}

matrix[k,l]:=matrix[k,l+1];{заменяем элемент на соседний}

matrix[k,m+y+1]:=0;{а последний убираем}

end;

{столбец удален! надо это запомнить}

y:=y-1;

i_basis:=i_basis-1;

ifi_basis>0 then {если остались еще искусственные переменные,}

forl:=m+y-i_basis+1 tom+ydo{то от первой из них до последней}

fori:=1 tondo {просматриваем строки в столбце}

if matrix[i,l]=1 then all_basis[i]:=l; {туда, где 1, заносим в базис}

writeln(f,'<P>Искусственная переменная исключена из базиса<br>');

writeln(f,'и может быть удалена из таблицы.');

writeln(f,'</P>');

zapisat(n+1,m+y+1,-1,-1);

end;

end;

{///////////////закончили убирать искусственный базис////////////////////}

end;

end;

{/////////////////}

procedure otvet;

{выводит ответ}

var

i,j: integer;

begin

writeln(f,'<P><b>ОТВЕТ:</b></P>');

form1.Memo1.ReadOnly:=false;

form1.Memo1.Lines.Clear;

form1.Memo1.Lines.Add('ОТВЕТ:');

form1.Memo1.Lines.Add('');

if (solve=true) and (i_basis=0) then

write(f,'F(');

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'F(';

if form1.Extrem.ItemIndex=0 then

begin

write(f,'max) = ',0-matrix[n+1,m+y+1]:0:3);

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'max) = ';

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(0-matrix[n+1,m+y+1]);

end

 
назад
читать дальше
1
2
3
4
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.