Как найти минимум функции при ограничениях

[Jenek56Rus]

Как найти минимум функции вида
L=L[1]*x1+L[2]*x2+ .... +L[n]*xn----> min (max)
при ограничениях:
A1[1]*x1+A1[2]*x2+....+A1[n]*xn <=> B1
.....................
Am[1]*x1+Am[2]*x2+....+Am[n]*xn <=> Bm
Где <=> - один из знаков: >= , = , <=

[lxa85]

Сначала определиться с математикой решения, затем программировать. Не совсем похоже на мат.задачу "от нечего делать".
Многокритериальное программирование, поиск минимума многокритериальной функции. Критерий Лапласа, генетическое программирование. Это где-то там.
Или решить вручную 3-5 примеров, поискать общие зависимости.
---
Так, бррр, стоп.
Вот L1, x1, x2, xn, A1, A2, B1 - что это такое? Функции, степени, константы, параметры?
В какой-нибудь более путной нотации (желательно TeXовской) можно это записать?

[lxa85]

Симплекс-метод -> линейное программирование -> транспортная задача -> Алгоритмы нахождения максимального потока -> Алгоритмы нахождения минимального потока -> Максимальный поток минимальной стоимости (http://habrahabr.ru/post/61884/)

[Jenek56Rus]

Нашел реализацию симплекс метода на pascal
Код:


program simple_sim;

{$APPTYPE CONSOLE}

uses SysUtils;
const mm = 100; nn = 100;

var A : array[1..mm, 1..nn] of double;
fun : array[1..nn] of integer; // Коэффициенты целевой функции
m, n : integer; // m ограничений, n переменных.

basis : array[1..nn] of integer; // Здесь храним номера базисных переменных
i, j : integer;
x : array[1..nn] of double; // Здесь будут значения переменных при расшифровке плана

procedure solve;
var i, j, i0, j0 : integer;
tmp : double;
opt : boolean;
begin
opt := false;
repeat
j0 := -1; i0 := 0;
while (j0 < m+n+1) and (A[m+1, j0] >= 0) do inc(j0);
if A[m+1, j0] >= 0 then opt := true;

if not opt then begin
tmp := 10000;
for i := 1 to m do
if (A[i, j0] > 0) and (A[i, m+n+1] / A[i, j0] < tmp) then
begin
tmp := A[i, m+n+1] / A[i, j0]; i0 := i
end;
// i0 - выводим, j0 - добавляем
basis[i0] := j0; // Ввод нового элемента в базис
// [i0, j0] - ведущий эл-т в Гауссе:
for i := 1 to m + 1 do
if i <> i0 then
begin
tmp := A[i, j0];
for j := 1 to m + n + 1 do
A[i,j] := A[i,j] - A[i0,j]*tmp/A[i0,j0];
end;
tmp := A[i0, j0];
for j := 1 to m + n + 1 do
A[i0, j] := A[i0, j] / tmp;
end;
until opt;
end;

begin
assign(input, 'e:\diplom\input.txt'); reset(input);
// -------Ввод данных---------------------------
read(n); read(m);

for i := 1 to n do read(fun[i]); //Читаем коэффициенты целевой функции

for i := 1 to m do
for j := 1 to n do
read(A[i, j]);

for i := 1 to m do
read(A[i, n+m+1]); // Читаем правые части ограничений

for i := 1 to m do // Вводим дополнительные переменные
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);

// базис из доп. переменных
for i := 1 to m do
basis[i] := n + i;
for j := 1 to n do
A[m+1,j] := -fun[j]; // Оценки для небазисных переменных = -fun[j], для базисных - 0


solve; // DO IT! +)

// -- вывод базиса --
for i := 1 to m do
if basis[i] <= n then
x[basis[i]] := A[i, m+n+1];

for i := 1 to n do writeLn('x[', i, '] = ', x[i]:0:3);
writeLn('min f(x) = ', A[m+1, m+n+1]:0:3);
end.


Периписал под Delphi
Код:

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
Button2: TButton;
SpinEdit1: TSpinEdit;
StringGrid2: TStringGrid;
SpinEdit2: TSpinEdit;
StringGrid3: TStringGrid;
Edit1: TEdit;
StringGrid4: TStringGrid;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
n,i,j,m:integer;
fun,x:array[1..100] of double;
A:array [1..100,1..100] of double;
basis:array [1..100] of integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
n:=spinedit1.value;
m:=spinedit2.Value;
stringgrid1.ColCount:=n;
stringgrid2.ColCount:=n;
stringgrid2.RowCount:=m;
stringgrid3.ColCount:=m;
end;
procedure solve;
var i, j, i0, j0 : integer;
tmp : double;
opt : boolean;
begin
opt := false;
repeat
j0 := -1; i0 := 0;
while (j0 < m+n+1) and (A[m+1, j0] >= 0) do inc(j0);
if A[m+1, j0] >= 0 then opt := true;

if not opt then begin
tmp := 10000;
for i := 1 to m do
if (A[i, j0] > 0) and (A[i, m+n+1] / A[i, j0] < tmp) then
begin
tmp := A[i, m+n+1] / A[i, j0]; i0 := i;
end;

basis[i0] := j0;

for i := 1 to m + 1 do
if i <> i0 then
begin
tmp := A[i, j0];
for j := 1 to m + n + 1 do
A[i,j] := A[i,j] - A[i0,j]*tmp/A[i0,j0];
end;
tmp := A[i0, j0];
for j := 1 to m + n + 1 do
A[i0, j] := A[i0, j] / tmp;
end;
until opt;
end;
procedure TForm1.Button2Click(Sender: TObject);

begin


for i:=1 to n do fun[i]:=strtofloat(stringgrid1.cells[i-1,0]);


for i:=1 to n do
for j:=1 to m do
A[i,j]:=strtofloat(stringgrid2.Cells[i-1,j-1]);

for i:=1 to m do A[i,n+m+1]:=strtofloat(stringgrid3.Cells[i-1,0]);
for i := 1 to m do
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);


for i := 1 to m do
basis[i] := n + i;
for j := 1 to n do
A[m+1,j] := -fun[j];

solve;

for i := 1 to m do
if basis[i] <= n then

for i:=1 to n do Stringgrid4.Cells[i-1,0]:=floattostr(x[i]);
x[basis[i]] := A[i, m+n+1];
edit1.Text:=floattostr(A[m+1,m+n+1]);
end;

end.


Считают по разному.Не подскажите в чем моя ошибка?

[lxa85]

Не подскажите в чем моя ошибка? »
Пока правильно не оформишь - нет.
Берешь WinMerge и сравниваешь.
В оригинале :
for i := 1 to m do // Вводим дополнительные переменные
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);

В Delphi
for i:=1 to n do
---
for j:=1 to m do // я понятия не имею, что здесь происходит, зачем эти вложенные циклы?
A[i,j]:=strtofloat(stringgrid2.Cells[i-1,j-1]);

for i:=1 to m do A[i,n+m+1]:=strtofloat(stringgrid3.Cells[i-1,0]);
for i := 1 to m do
---
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);

----
У меня один вопрос: материал по приведенной ссылке читался? Задача вообще понятна, или так, кое как?

[Jenek56Rus]

Материал по ссылке читал несколько раз но так толком ничего не понял, задача мне понятна и решить я ее могу , правдо только графически, решить тут естественно нужно не графически, а как реализовать это программно не понятно...
for i:=1 to n do
---
for j:=1 to m do // я понятия не имею, что здесь происходит, зачем эти вложенные циклы?
A[i,j]:=strtofloat(stringgrid2.Cells[i-1,j-1]);

for i:=1 to m do A[i,n+m+1]:=strtofloat(stringgrid3.Cells[i-1,0]);
for i := 1 to m do
---
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);
сдесь считываются данные из таблицы

[lxa85]

сдесь считываются данные из таблицы »
здесь, здание, здоровье
сил моих нет.
for i:=1 to n do
for j:=1 to m do // считвание первого массива
A[i,j]:=strtofloat(stringgrid2.Cells[i-1,j-1]);
---
for i:=1 to m do A[i,n+m+1]:=strtofloat(stringgrid3.Cells[i-1,0]); //считывание не пойми чего
---
for i := 1 to m do //возвращаемся к оригиналу.
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0); »
Jenek56Rus, фунции solve идентичны, определения массивов - тоже.
Значит смотри, что подается на вход функции. Манипуляции с массивом остаются не понятными.
Не проще будет задать пока проверочные массивами константно, а потом закомментировать после отладки?
Чтобы каждый раз заново не набирать.

Выкладывай проект, выкладывай проверочные задания.
Кроме того в Delphi есть хорошая система отладки. Выполняй алгоритм по шагам, смотри, что ему не нравится.Материал по ссылке читал несколько раз но так толком ничего не понял »
и до алгоритмов видимо не дошел...
задача мне понятна и решить я ее могу , правда только графически »
Тогда и программируй как ТЫ это понимаешь, а не как дядьки умные решили.
Понял как решать задачу - решай. Потом будешь смотреть и сравнивать с известными методами.

[Jenek56Rus]

Вот проэкт

[Jenek56Rus]

Вот сама задача :
При подкормке посевов необходимо внести на 1га почвы не менее 6 единиц химического вещества А, не менее 37 единиц химического вещества В, не менее 26 единиц химического вещества С и не менее 4 единиц химического вещества D. Фермер закупает комбинированные удобрения четырех видов В1, В2, В3 и В4. В таблице указано содержание количества единиц химического вещества в 10 кг каждого вида удобрений и цена 1 кг удобрений. Определите потребность фермера в удобрениях В1, В2, В3 и В4 на 1 га посевной площади при минимальных затратах на их приобретение.

Химические вещества Содержание химических веществ в 10 кг удобрения

В1 В2 В3 В4
А 32 14 27 20
В 11 5 9 2
С 6 5 13 7
D 4 3 7 5
Цена1кг 24 17 30 12

[Iska]

Jenek56Rus, каков акцент: просто решить задачу или же решить задачу на Delphi?

[Jenek56Rus]

Решить задачу в делфи...!

[lxa85]

В1 В2 В3 В4
А 32 14 27 20
В 11 5 9 2
С 6 5 13 7
D 4 3 7 5
Цена1кг 24 17 30 12 »
а какой правильный ответ? К чему надо стремиться то?
----
Открыл программу.
И куда там что писать?
Можно в какое-нибудь соответствие привести коэф. ограничений, коэф. функций и т.д. ?
Помни, это ты проблемой занимаешься, я ее первый раз вижу.

[Jenek56Rus]

32 14 27 20 коэфиценты 1 ограничения
11 5 9 2 коэфиценты 2 ограничения
6 5 13 7 коэфиценты 3 ограничения
4 3 7 5 коэфиценты 4 ограничения

24 17 30 12 это коэфиценты функции но так как это 1 кг а коэфиценты ограничений в 10кг умножим их на 10

6 единиц химического вещества А, не менее 37 единиц химического вещества В, не менее 26 единиц химического вещества С и не менее 4 единиц химического вещества D. Ну а это правая часть ограничений. Верный ответ данной программы 881,798, в проекте картинка там есть верный результат...

[Iska]

Jenek56Rus, не реально, чтобы кто-либо продавал удобрения в десятимиллионных долях грамма ;). Я лично добавил ограничение целочисленности, дабы фермеру не пришлось ходить за удобрениями с атомными весами: 82263 (NB: это документ Microsoft Excel, не код на Delphi!).

http://img213.imageshack.us/img213/4985/image00020120510222220.png

http://img827.imageshack.us/img827/9575/image00020120510222334.png

[Jenek56Rus]

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

[lxa85]

Jenek56Rus, я пробовал разобраться в твоей программе. Сейчас я остыл, но придушить очень хотелось.
Первый раз, когда пытался понять, что куда записывать, чтобы запустить расчет, второй раз за недокументированный алгоритм.
Если с первым разобрался, то на второе просто плюнул. "Идея" алгоритма мне не ясна. Соотв. вложенные циклы тоже мало о чем говорят. В слепую разбираться что они делают и что они должны(!) делать - никакого желания.
Вон посмотри у Iska. Каждое значение выводится через формулу. Все красиво и понятно.

Зачем массив A сделан 100 на 100? Его как отлаживать? 5x5 10х10, край 15х15 хватит за глаза.
Дважды щелкни на форму, откроется FormCreate процедура.
В ней напиши
n:=4,
m:=4,
StringGrid1 тому то, stringGrid2 - тому то. Что бы при запуске программы УЖЕ были забиты тестовые данные.
Я тебе это уже раз третий говорю.
Нажимать кнопку "сформировать матрицы" каждый раз в начале работы мне надоело после второго раза.

Наведи порядок на форме. Все нормальные люди читают сверху-вниз, слева-направо. А кнопка формирования матриц где-то в середине формы. Если бы не экран с расчетами Iska, я бы вообще не запустил эту программу. Потому что я не понимаю, что писать, куда писать, и почему ей(программе) это не нравится. Почему заполняя левую верхнюю таблицу, программа ругается на какую-то нижнюю правую. Это раздражает.

Ладно, к сути. Алгоритм SOLVE ясен? Можно его прокомментировать? Чтобы проверяющий (в данном случае я) понимал, что должен выполнить цикл. Лучше всего формулу с текстом. Если текст сложно, то только формулу.

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

[Jenek56Rus]

Solve.7z (NB: это документ Microsoft Excel, не код на Delphi!). » перезалейте плиз, ото когда извлекаю из архива он поврежден...(

[Iska]

перезалейте плиз, ото когда извлекаю из архива он поврежден...( »
Архив и документ в нём в порядке. Используйте 7-Zip версии не ниже 9.20, либо же WinRAR версии не ниже 3.91.

[Jenek56Rus]

Алгоритм SOLVE мне не совсем ясен ... Совсем запутался с задачей...(

[Jenek56Rus]

Можете математически обьяснить как это решить...?