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;
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;
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;
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> ')
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;
{/////////////////}
procedure preobr;
{преобразует массив
относительно ведущего элемента}
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);
{/////////////////////////убираем
искусственный базис/////////////////////}
if i_basis>0 then {если он есть }
begin
t:=0;
for j:=m+y-i_basis+1 to m+y do {от первого исскусственного
элемеента до конца}
begin
need_i_basis:=false;{предполагаем, что элемент не нужен
(*)}
for i:=1 to n do {просматриваем столбец}
if all_basis[i]=j then{и если элемент в базисе}
need_i_basis:=true;{тогда он все-таки нужен}
if need_i_basis=false then
t:=j;
{если наши предположения (*)
подтвердились, то запомним этот элемент}
if t<>0
then
begin
for k:=1 to
n+1 do {во всех строках}
begin
for l:=t to m+y do {от текущего столбца до последнего}
matrix[k,l]:=matrix[k,l+1];{заменяем
элемент на соседний}
matrix[k,m+y+1]:=0;{а последний убираем}
end;
{столбец удален! надо
это запомнить}
y:=y-1;
i_basis:=i_basis-1;
if i_basis>0 then {если остались еще искусственные
переменные,}
for l:=m+y-i_basis+1 to m+y do{то от первой из них до последней}
for i:=1 to n do {просматриваем строки в столбце}
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
else
begin
write(f,'min)
= ',matrix[n+1,m+y+1]:0:3);
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'min)
= ';
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(matrix[n+1,m+y+1]);
end;
writeln(f,'<br>при значениях:<br>');
form1.Memo1.Lines.Add('');
form1.Memo1.Lines.Add('');
form1.Memo1.Lines.Add('при значениях:');
form1.Memo1.Lines.Add('');
for j:=1 to m
do
begin
writeln(f,'x<sub>',j,'</sub>
= ');
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'X[';
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+inttostr(j);
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+']
= ';
written:=false;
for i:=1 to n
do
if
all_basis[i]=j then
begin
writeln(f,matrix[i,m+y+1]:0:3,'<br>');
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(matrix[i,m+y+1]);
form1.Memo1.Lines.Add('');
form1.Memo1.Lines.Add('');
written:=true;
end;
if written=false then
begin
writeln(f,'0.000
<br>');
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'0';
form1.Memo1.Lines.Add('');
form1.Memo1.Lines.Add('');
end;
end;
end else
begin
writeln(f,'<P>Решение не найдено.(</P>');
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'Решение не найдено.';
end;
form1.Memo1.ReadOnly:=true;
end;
{/////////////////}
procedure Step2;
{шаг второй: решение
задачи и формирование отчета}
var
i,j: integer;
k: integer;
begin
for i:=1 to
n+1 do
for j:=1 to
m+1 do
begin
matrix[i,j]:=strtofloat(pole[i,j].Text);
{Вводим значения в массив}
pole[i,j].Enabled:=false;
{Блокируем поля}
if i<=n
then znak[i].Enabled:=false;{блокируем знаки}
end;
form1.Extrem.Enabled:=false;
{////////////////////////////////////////////////////////////////////////////}
{ имеем матрицу
[ n+1, m+1 ] }
rewrite(f);
writeln(f,'<HTML>');
writeln(f,'<HEAD>');
writeln(f,'<TITLE>Отчет</TITLE>');
writeln(f,'</HEAD>');
writeln(f,'<BODY>');
writeln(f,'<H1>Отчет</H1>');
write(f,'<P><b>Необходимо
');
if
form1.Extrem.ItemIndex=0 then write(f,'макс') else write(f,'мин');
writeln(f,'имизировать
целевую функцию:</b></P>');
kanon:=false;{еще не в
канонической форме}
write_system(n+1,m+1);{Выведем
ее в отчет}
{приведем ее к
каноническому виду}
writeln(f,'<P><b>Приведем
к каноническому виду:</b></P>');
y:=0;{количество
дополнительных переменных}
need_basis:=false;
for i:=1 to n do
if
znak[i].ItemIndex<>2 then {если ограничение не является равенством}
begin
y:=y+1; {вводим
дополнительную переменную, для этого:}
for k:=1 to n+1 do begin
{во всех ограничениях и в ЦФ}
{перед правой
частью добавляем столбец}
matrix[k,m+y+1]:=matrix[k,m+y];
matrix[k,m+y]:=0;{состоящий из нулей}
end;
{а в текущем ограничении,
если знак был > или >=}
if (znak[i].ItemIndex=0) or
(znak[i].ItemIndex=1) then
begin
matrix[i,m+y]:=-1;{записываем
-1}
need_basis:=true;
end
else {иначе, т.е. в случае < или
<=}
matrix[i,m+y]:=1;
{записываем 1}
end
else
need_basis:=true;
{ЦФ приравнивается к
нулю, а свободный член переносится в правую часть:}
matrix[n+1,m+y+1]:=0-matrix[n+1,m+y+1];
{правые части ограничений
должны быть неотрицательны, проверим это:}
for i:=1 to n do {для
всех ограничений}
if matrix[i,m+y+1]<0
then {если правая часть отрицательна,}
{то отнимаем всю строку
от нуля}
for j:=1 to m+y+1 do
matrix[i,j]:=(0-matrix[i,j]);
kanon:=true;{система
приведена к каноническому виду}
{выведем ее в отчет}
write_system(n+1,m+y+1);
{если ф-ция на минимум,
то нужно поменять знаки в последней строке}
if
form1.Extrem.ItemIndex=1 then
for j:=1 to
m+y+1 do matrix[n+1,j]:=0-matrix[n+1,j];
{////////////////////////////////////////////////////////////////////////////}
{//////////////////////////
Тут надо ввести базис ///////////////////////////}
i_basis:=0;
for i:=1 to n do {то во всех ограничениях}
begin
is_basis:=false;
for j:=1 to
m+y do
if
(matrix[i,j]=1) then
if
(is_basis=false) then
begin
all_basis[i]:=j;
is_basis:=true;
for k:=1 to
n do
if
k<>i then
if
(matrix[k,j]<>0) then
if
(is_basis=true) then
begin
is_basis:=false;
all_basis[i]:=0;
end;
end;
if
is_basis=false then
begin
i_basis:=i_basis+1;
y:=y+1;
for k:=1 to
n+1 do
begin {во всех ограничениях и в ЦФ}
{перед правой частью
добавляем столбец}
matrix[k,m+y+1]:=matrix[k,m+y];
matrix[k,m+y]:=0;{состоящий из нулей}
end;
matrix[i,m+y]:=1;
all_basis[i]:=m+y;
end;
end;
{////////////////
Закончили ввод искусственного базиса //////////////////////}
{////////////////////////////////////////////////////////////////////////////}
{////////////////////////////////////////////////////////////////////////////}
{//////////////// теперь
надо от него избавиться ////////////////////////////}
if i_basis>0 then
begin
write(f,
'<H2>Необходимо ввести искусственный
базис</H2>');
zapisat(n+1,m+y+1,-1,-1);
writeln(f,
'<P>Искусственный базис введен.<br>');
writeln(f,
'Избавившись от него, получим первое допустимое решение</P>');
iter:=0;
repeat
inc(iter);
findved;
preobr;
until
(i_basis=0) or (iter=20) or (done=true);
if i_basis=0
then
begin
writeln(f,'<P>Искусственный
базис выведен полностью.<br>');
writeln(f,'Получено первое допустимое решение!</P>');
end
else
begin
writeln(f,'<P>Не удалось вывести искусственный
базис.<br>');
writeln(f,'Решение
не найдено.</P>');
end;
end;
{////////////////////////
попытки избавленя окончены ////////////////////////}
{////////////////////////////////////////////////////////////////////////////}
{///////////////////////////////
SIMPLEX START /////////////////////////////}
if i_basis=0
then
begin
iter:=0;
findved;
if done=false
then
begin
writeln(f,'<H2>Применяем
симплекс метод</H2>');
repeat
inc(iter);
findved;
preobr;
until
(done=true) or (iter=20);
end;
end;
otvet;
{///////////////////////////////
SIMPLEX END ///////////////////////////////}
writeln(f,'</BODY>');
writeln(f,'</HTML>');
CloseFile(f);
{////////////////////////////////////////////////////////////////////////////}
end;
{////////////////////////////////////////////////////////////////////////////}
{///////// все, что ниже, относится к
переходам между шагами ////////////////}
{////////////////////////////////////////////////////////////////////////////}
procedure
TForm1.ExitClick(Sender: TObject);
begin
Close();
end;
procedure
TForm1.Button_NextClick(Sender: TObject);
begin
step:=step+1;
Form1.Button_Prev.Enabled:=true;
case step of
1:Step1;
2:begin
Step2;
Form1.Button_Next.Enabled:=false;
end;
else
step:=step-1;
end;
form1.Caption:='Симплекс
метод - шаг '+inttostr(step);
end;
procedure
TForm1.Button_PrevClick(Sender: TObject);
begin
step:=step-1;
Form1.Button_Next.Enabled:=true;
case step of
0:begin
Init;
Form1.Button_Prev.Enabled:=false;
end;
1:Step1;
else
step:=step+1;
end;
form1.Caption:='Симплекс
метод - шаг '+inttostr(step);
end;
procedure
TForm1.FormCreate(Sender: TObject);
begin
Init;
end;
В данной
курсовой работе было рассмотрено решение задач линейного программирования
симплекс методом. Задача была решена симплекс методом, так же задача была
решена графически (построен график). Для представленной задачи была составлена
программа на языке Delphi, программа
находит значения целевой функции при условии максимизации значения.
Таким
образом, вычислительная техника в настоящее время находит широкое применение,
как в общей математике, так и в одном из её разделов – математических методах.
Список используемой литературы
1. Зайченко Ю.П., Шумилова С.А.
Исследование операций.
2. Лищенко «Линейное и нелинейное
программирование», М. 2003
3. А.Н. Карасев, Н.Ш. Кремер, Т.Н.
Савельева «Математические методы в экономике», М.2000
4. Орлов А.И. Теория принятия
решений. Учебное пособие. - М.: Издательство "Март", 2004
5. Интернет
Похожие работы на - Анализ имущества предприятия и проблемы его эффективного использования )
|