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

[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овской) можно это записать?

[Jenek56Rus]

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

[lxa85]

Нашел реализацию симплекс метода на 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]

Цитата Jenek56Rus:



Не подскажите в чем моя ошибка?

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

Пока правильно не оформишь - нет.

Берешь 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);

----

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

[lxa85]

Симплекс-метод -> линейное программирование -> транспортная задача -> Алгоритмы нахождения максимального потока -> Алгоритмы нахождения минимального потока ->

Максимальный поток минимальной стоимости

[Jenek56Rus]

Цитата Jenek56Rus:



сдесь считываются данные из таблицы

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

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

Jenek56Rus, фунции solve идентичны, определения массивов - тоже.

Значит смотри, что подается на вход функции. Манипуляции с массивом остаются не понятными.

Не проще будет задать пока проверочные массивами константно, а потом закомментировать после отладки?

Чтобы каждый раз заново не набирать.



Выкладывай проект, выкладывай проверочные задания.

Кроме того в Delphi есть хорошая система отладки. Выполняй алгоритм по шагам, смотри, что ему не нравится.
Цитата Jenek56Rus:



Материал по ссылке читал несколько раз но так толком ничего не понял

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

и до алгоритмов видимо не дошел...


Цитата Jenek56Rus:



задача мне понятна и решить я ее могу , правда только графически

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

Тогда и программируй как ТЫ это понимаешь, а не как дядьки умные решили.

Понял как решать задачу - решай. Потом будешь смотреть и сравнивать с известными методами.

[lxa85]

Вот проэкт

[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]

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