|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Delphi - Как найти минимум функции при ограничениях |
|
Delphi - Как найти минимум функции при ограничениях
|
Новый участник Сообщения: 20 |
Профиль | Отправить PM | Цитировать Как найти минимум функции вида
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 Где <=> - один из знаков: >= , = , <= |
|
Отправлено: 15:01, 09-05-2012 |
Необычный Сообщения: 4463
|
Профиль | Сайт | Отправить PM | Цитировать Сначала определиться с математикой решения, затем программировать. Не совсем похоже на мат.задачу "от нечего делать".
Многокритериальное программирование, поиск минимума многокритериальной функции. Критерий Лапласа, генетическое программирование. Это где-то там. Или решить вручную 3-5 примеров, поискать общие зависимости. --- Так, бррр, стоп. Вот L1, x1, x2, xn, A1, A2, B1 - что это такое? Функции, степени, константы, параметры? В какой-нибудь более путной нотации (желательно TeXовской) можно это записать? |
------- Отправлено: 16:28, 09-05-2012 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Необычный Сообщения: 4463
|
Профиль | Сайт | Отправить PM | Цитировать Симплекс-метод -> линейное программирование -> транспортная задача -> Алгоритмы нахождения максимального потока -> Алгоритмы нахождения минимального потока -> Максимальный поток минимальной стоимости
|
------- Отправлено: 19:49, 09-05-2012 | #3 |
Новый участник Сообщения: 20
|
Профиль | Отправить PM | Цитировать Нашел реализацию симплекс метода на 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. Код: 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. |
Последний раз редактировалось Jenek56Rus, 10-05-2012 в 06:53. Отправлено: 21:48, 09-05-2012 | #4 |
Необычный Сообщения: 4463
|
Профиль | Сайт | Отправить PM | Цитировать Цитата Jenek56Rus:
Берешь WinMerge и сравниваешь. В оригинале : for i := 1 to m do // Вводим дополнительные переменные A[i, n+i] := 1; fillchar(A[m+1], sizeof(A[m+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); У меня один вопрос: материал по приведенной ссылке читался? Задача вообще понятна, или так, кое как? |
||
------- Отправлено: 01:12, 10-05-2012 | #5 |
Новый участник Сообщения: 20
|
Профиль | Отправить PM | Цитировать Материал по ссылке читал несколько раз но так толком ничего не понял, задача мне понятна и решить я ее могу , правдо только графически, решить тут естественно нужно не графически, а как реализовать это программно не понятно...
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); |
Отправлено: 07:03, 10-05-2012 | #6 |
Необычный Сообщения: 4463
|
Профиль | Сайт | Отправить PM | Цитировать Цитата Jenek56Rus:
сил моих нет. Цитата:
Значит смотри, что подается на вход функции. Манипуляции с массивом остаются не понятными. Не проще будет задать пока проверочные массивами константно, а потом закомментировать после отладки? Чтобы каждый раз заново не набирать. Выкладывай проект, выкладывай проверочные задания. Кроме того в Delphi есть хорошая система отладки. Выполняй алгоритм по шагам, смотри, что ему не нравится. Цитата Jenek56Rus:
Цитата Jenek56Rus:
Понял как решать задачу - решай. Потом будешь смотреть и сравнивать с известными методами. |
||||
------- Отправлено: 09:08, 10-05-2012 | #7 |
Новый участник Сообщения: 20
|
Профиль | Отправить PM | Цитировать Вот проэкт
|
Отправлено: 15:02, 10-05-2012 | #8 |
Новый участник Сообщения: 20
|
Профиль | Отправить PM | Цитировать Вот сама задача :
При подкормке посевов необходимо внести на 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 |
Отправлено: 16:02, 10-05-2012 | #9 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Jenek56Rus, каков акцент: просто решить задачу или же решить задачу на Delphi?
|
Отправлено: 16:58, 10-05-2012 | #10 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
Разное - Функции при совпадении имён файлов в процессе копирования. | saneck | Microsoft Windows 2000/XP | 4 | 15-12-2011 05:07 | |
"Мы точно умрем 21 Октября!" как минимум - вот так... | P.M. | Флейм | 8 | 16-10-2011 01:43 | |
[решено] остановка функции при условии. | yukuru | AutoIt | 3 | 26-07-2011 00:01 | |
CMD/BAT - [решено] две функции по mp3 (узнать продолжительность и найти все mp3 файлы в папке) | tor4ok11 | Скриптовые языки администрирования Windows | 5 | 22-11-2010 07:17 | |
[решено] При наличии файла ответов нет функции Восстановления (Repair, [R]) | toai | Автоматическая установка Windows 2000/XP/2003 | 33 | 27-03-2009 11:20 |
|