Каталог Рефератов - Решение задач линейного программирования симплекс методом

	Информационно-образоательный портал
	Рефераты, курсовые, дипломы, научные работы,



МЕНЮ\|

поиск

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

p align="left">Оптимальный план можно записать так:

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;

if table_changed=true then {если меняли количество эл-тов или ограничений,}

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;

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;

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

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;

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

procedure write_system(strok,stolb: integer);

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

var

i,j: integer;

begin

write(f,'F(x) = ');

for j:=1 to stolb do

begin

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

if j<stolb then

begin

write(f,'x',j,'');

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

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

end;

writeln(f,'');

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

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',j,' ');

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,' ');

end;

writeln(f,'');

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',j,'') 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',all_basis[i],'') 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;

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;

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

begin

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

done:=true;

solve:=true;

end

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

begin

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

done:=true;

solve:=false;

end

else

if iter<>0 then

begin

writeln(f,'Итерация ',iter,'');

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

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

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

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

writeln(f,'X',all_basis[i0],' заменяем на X',j0,'');

all_basis[i0]:=j0;

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;

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

procedure preobr;

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

var

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

temp: double;

begin

if done=false then

begin

write(f, 'Пересчет:');

temp:=matrix[i0,j0];

Страницы: 1, 2, 3, 4

© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент.