МІHІСТЕРСТВО ОБРАЗОВАHІЯ І НАУКИ УКРАІHИ
ДОHБАССКАЯ ГОСУДАРСТВЕHHАЯ МАШІHОСТРОІТЕЛЬHАЯ АКАДЕМІЯ
Кафедра комп'ютерних інформаційних технологій
Контрольна робота № 1, 2
з дисципліни
«Методи синтезу та оптимізації»
Виконала
студентка групи ІТ 99-1З Александрова А.Н
Перевірила
Веремій О.В.
Краматорськ 2002
Завдання 1
ПРОГРАМУВАННЯ Чисельні методи одновимірної оптимізації
Мета завдання: закріпити теоретичні відомості і набути практичних навичок розробки алгоритмів і програм для знаходження екстремальних значень функції однієї змінної методом перебору з застосуванням ЕОМ.
Знайти максимум і мінімум функції при зміні аргументу від -4 до 3 з точністю 0,0001. Функція досягає максимуму при менших значеннях аргументу. Побудуйте графік функції.
Вихідні дані наведені в таблиці 1.
Таблиця 1
Номер варіанта | A | B | З | D |
6 | 1,5 | 0,4 | -5,6 | -10,8 |
Малюнок 1 - блок-схема методу
Рішення задачі на ЕОМ з графіком досліджуваної функції
На малюнку 2 зображено рішення задачі на ЕОМ з графіком функції.
Рисунок 2 - результати роботи програми, графік функції
Короткі висновки по роботі
Задача розв'язана методом послідовного рівномірного перебору з уточненням, тобто спочатку проводиться пошук з великим кроком, а при знаходженні екстремуму пошук повторюється в зоні екстремуму з зменшеним кроком.
Програма реалізує алгоритм
:
procedure TForm1.SpeedButton1Click (Sender: TObject);
var a, b, c, d, e, y, Ymax, Xmax,
x0, X, Xk, Xmin, Ymin, h, k: real;
i, n, count: integer;
status: integer; / / 0-спадання, 1-зростання
label l1;
Function MOO (x: real): real;
begin
result: = a * x * x * x + b * x * x + c * x + d;
end;
begin
Form1.Series1.Clear;
try / / введення початкових умов
with form1 do
begin
LabelXmin.Caption: = 'Xmin = 0';
LabelYmin.Caption: = 'Ymin = 0';
LabelXmax.Caption: = 'Xmax = 0';
LabelYmax.Caption: = 'Ymax = 0';
end;
a: = strtofloat (form1.Edit1.Text);
b: = strtofloat (form1.Edit2.Text);
c: = strtofloat (form1.Edit3.Text);
d: = strtofloat (form1.Edit4.Text);
e: = strtofloat (form1.Edit5.Text);
h: = strtofloat (form1.Edit6.Text);
x0: = strtofloat (form1.Edit7.Text);
xk: = strtofloat (form1.Edit8.Text);
k: = 10;
Ymin: = 1000000000;
Ymax: =- 10000000000;
status: = 1;
count: = 1;
except
showMessage ('Неправильно введені початкові умови');
end;
l1: n: = trunc ((xk-x0) / h) +1;
x: = x0;
for i: = 1 to n do
begin
y: = MOO (x);
case status of
0: if y <Ymin then
begin
Ymin: = y;
Xmin: = x;
X: = x + h;
end;
1: if Y> Ymax then
begin
Ymax: = y;
Xmax: = x;
X: = x + h;
end;
end;
end;
if count <= 2 then
if h <= e then
begin
with form1 do / / вивід результату
begin
LabelXmin.Caption: = 'Xmin =' + floatTostr (Xmin);
LabelYmin.Caption: = 'Ymin =' + floatTostr (Ymin);
LabelXmax.Caption: = 'Xmax =' + floatTostr (Xmax);
LabelYmax.Caption: = 'Ymax =' + floatTostr (Ymax);
end;
status: = (status +1) mod 2; / / Наступний екстремум
count: = count +1;
x0: = Xmin;
xk: = strtofloat (form1.Edit8.Text);
h: = strtofloat (form1.Edit6.Text);
goto l1;
end
else
begin
x0: = Xmin-h;
xk: = Xmin + h;
h: = h / k;
goto l1;
end;
x: = strtofloat (form1.Edit7.Text);
while x <strtofloat (form1.Edit8.Text) do
begin
y: = MOO (x);
form1.Series1.AddXY (x, y);
x: = x +0.1;
end;
end;
Завдання 2
РІШЕННЯ одновимірних задач ОПТИМІЗАЦІЇ МЕТОДАМИ ПОСЛІДОВНОГО ПОШУКУ
Мета завдання: придбати практичні навички розробки алгоритмів і програм для вирішення одновимірних задач оптимізації методами послідовного пошуку: дихотомії і золотого перетину.
Індивідуальне завдання
Знайти мінімум функції f (x) на проміжку [a, b] з точністю . Вихідні дані і номери варіантів наведені в таблиці 2. Побудувати графік мінімізіруемой функції.
Знайдіть мінімум функції на проміжку [a, b] c точністю ε = 10 -4, методом «золотого перетину» побудуйте графік мінімізіруемой функції.
Блок-схема методу «Золотого перетину» представлена на рісунке3.
Рисунок 3 - Блок-схема методу «Золотого перетину»
На малюнку 4 зображено рішення задачі на ЕОМ і графік мінімізіруемой функції.
Висновок: Методи послідовного пошуку будуються в припущенні унімодальному функції на заданому інтервалі. Виходячи з властивостей, унімодальному будується така стратегія послідовного пошуку екстремальної точки Х *, при якій будь-яка пара обчислень f (x) дозволяє звузити область пошуку (інтервал невизначеності).
Процедура мінімізації функції:
procedure TForm1.SpeedButton2Click (Sender: TObject);
label l2;
Var a, b, e, x, x1, x2, y, y1, y2, Xmin, Ymin: real;
n: integer;
t: string;
Function f (x: real): real;
begin
f: = tan (x) + exp (-x) + x;
{F: = x * x + sin (x);}
end;
begin
Form1.Series1.Clear;
try / / введення початкових умов
a: = strtofloat (form1.Edit9.Text);
b: = strtofloat (form1.Edit10.Text);
e: = strtofloat (form1.Edit11.Text);
except
showMessage ('Неправильно введені початкові умови');
end;
x1: = a +0.382 * (ba); x2: = b-0.382 * (ba);
y1: = f (x1); y2: = f (x2);
n: = 1;
l2: n: = n +1;
if y1 <= y2 then
begin
b: = x2;
if (ba)> = e then
begin
x2: = x1;
x1: = a +0.382 * (ba);
y2: = y1;
y1: = f (x1);
goto l2;
end;
end
else
begin
a: = x1;
if (ba)> = e then
begin
x1: = x2;
x2: = b-0.382 * (ba);
y1: = y2;
Y2: = f (x2);
goto l2;
end;
end;
Xmin: = (a + b) / 2;
Ymin: = f (Xmin);
str (Xmin: 10:4, t);
form1.Label20.Caption: = 'Xmin =' + t;
str (Ymin: 10:4, t);
form1.Label21.Caption: = 'Ymin =' + t;
form1.Label22.Caption: = 'n =' + Inttostr (n);
x: = strtofloat (form1.Edit9.Text);
while x <strtofloat (form1.Edit10.Text) do
begin
y: = f (x);
form1.Series1.AddXY (x, y);
x: = x +0.1;
end;
end;
Завдання 3
Градієнтні методи РІШЕННЯ БАГАТОВИМІРНИХ ЗАВДАНЬ ОПТИМІЗАЦІЇ
Мета завдання: закріпити теоретичні відомості і набути практичних навичок пошуку безумовного екстремуму функції багатьох змінних градієнтним методом.
Індивідуальне завдання
Знайдіть мінімум функції методом найшвидшого спуску, вибравши початкову точку . Дати геометричну ілюстрацію рішення задачі.
Рішення
1) У точці f (X 0) = = -14,5
Обчислимо координати градієнта функції в точці Х 0:
.
Оскільки , То Х 0 не є точкою екстремуму
2) перемістимося ізх 0 уздовж градієнта - в нову точкуХ 1 за формулою:
тобто .
Для визначення координат точки Х 1 потрібно вибрати значення кроку . Отримаємо:
Зі співвідношення ( , ) = 0 маємо:
(-3-3 ) (-3) + (1 + ) = 10 +10 = 0
звідки =
Завдання 4
ЗАСТОСУВАННЯ Градієнтні методи ДЛЯ ОПТИМІЗАЦІЇ НА ЕОМ МАТЕМАТИЧНИХ МОДЕЛЕЙ ОБ'ЄКТІВ
Мета завдання: придбати практичні навички розробки алгоритмів і програм оптимізації математичних моделей градієнтним методом.
Індивідуальне завдання
Знайдіть мінімум функції f (x 1, х2) методом найшвидшого спуску, вибравши в якості початкової точки спочатку Хо, а потім точку з протилежного квадраніа. Порівняйте кількість ітерацій. Для визначення оптимального кроку шляхом одномірної мінімізації вздовж антіградіентного напрямки прийміть метод дихотомії у програмі, передбачте отрисовку траєкторії найшвидшого спуску.
, При Хо (2,4).
Блок-схема алгоритму розв'язання зображена на малюнку 5
Рисунок 5 - блок-схема алгоритму рішення методом найшвидшого спуску
Результати роботи програми.
Малюнок 6 - Рішення задачі на ЕОМ і траєкторія пошуку оптимальних значень (при Хо (2,4))
Малюнок 7 Рішення задачі на ЕОМ і траєкторія пошуку оптимальних значень (при Хо (-2, -4))
Висновок: Особливістю методу найшвидшого спуску є те, що пошук рішення виконується з оптимальним кроком, який розраховується за допомогою одновимірної мінімізації функції. Градієнти у двох сусідніх точках ортогональні і тому траєкторія до оптимального рішення в вигляді зигзага з поворотом під прямим кутом. При Хо (2,4) кількість ітерацій - 5, а при Хо (-2, -4) кількість ітерацій зменшилася до 4, а значення цільової функції залишилося тим самим - F (x) = 0,61370564.
Лістинг підпрограми методу.
unit Opt1_4;
interface
uses
Messages, SysUtils, Graphics, Forms, Dialogs;
const n = 2;
type Artype = array [1 .. n] of real;
Funop = function (xi: Artype): real;
ProcMin = Procedure (a, b, e: real; var xm, ym: real);
type
TForm2 = class (TForm)
private
public
procedure Optimiz (k: integer);
end;
var
Form2: TForm2;
Nmax, prn, NN: integer;
e, Fopt: real;
X0, G: artype;
f1: funop;
Pmin: ProcMin;
kAntGrad: real;
function model1 (x: Artype): real;
implementation
uses Main, UnitGraph;
/ / Підпрограма обчислення заданої функції
function model (x: Artype): real;
begin
model: = exp (x [1]) + sqr (x [2]) -2 * x [1];
end;
{Main program}
procedure Grad (n: integer; e: real; x: artype; var g: Artype;
F: Funop);
Var i: integer; fp, fo: real;
begin
for i: = 1 to n do
begin
x [i]: = x [i] + e;
fp: = F (x);
x [i]: = x [i] -2 * e;
fo: = F (x);
x [i]: = x [i] + e;
g [i]: = (fp-fo) / 2 / e;
end;
end;
procedure Opgrad (n: integer; e: real; var xk: Artype; Nmax: integer;
prn: byte; var Fopt: real; var nn: integer; F: Funop);
Label 1;
Var dk: Artype; / / Градієнт
od {норма вектор-градієнта},
lambda {крок}, s, sf: real;
i: integer;
Function FF (x: real): real;
Var i: integer;
begin
for i: = 1 to n do
xk [i]: = xk [i] + abs (x) * dk [i] / od;
FF: = F (xk);
for i: = 1 to n do
xk [i]: = xk [i]-abs (x) * dk [i] / od;
end;
Procedure Min (a0, b0, e: real; Var xm, ym: real); / / Метод Дихотомії
Label 1,2;
Var x1, x2, y1, y2, delta, a, b: real;
k, n: integer;
begin
a: = a0; b: = b0;
delta: = e / 2;
1: n: = 2 * k;
x1: = (a + b-delta) / 2;
x2: = (a + b + delta) / 2;
y1: = ff (x1); y2: = ff (x2);
if y1 <= y2 then b: = x2
else a: = x1;
if (ba) <e then
begin
xm: = (a + b) / 2;
ym: = ff (xm);
end
else
begin
k: = k +1;
goto 1
end;
end;
{Main prcvedure}
BEGIN
nn: = 0; lambda: = 0;
if prn = 0 then
begin
for i: = 1 to n do
form1.ListBox1.Items.Add ('x' + inttostr (i )+'='+ Floattostr (xk [i]) + '');
form1.ListBox1.Items.Add (# 13 + 'Цільова функція =' + Floattostr (F (xk)) + # 13);
end;
repeat
Grad (n, e / 2, xk, dk, F);
for i: = 1 to n do
dk [i]: =- dk [i]; sf: = F (xk);
if prn = 1 then
begin
form1.ListBox1.Items.Add ('Ітерація №' + inttostr (nn) + # 13 + 'Крок =' + Floattostrf (lambda, ffGeneral, 8,5));
form1.ListBox1.Items.Add ('Поточна точка');
for i: = 1 to n do
begin
form1.ListBox1.Items.Add ('X' + inttostr (i )+'='+ floattostrf (xk [i], ffGeneral, 8,5));
formGraph.imGraph.Canvas.LineTo (round (mx * xk [1] + Sx), round (-my * xk [2] + Sy));
end;
form1.ListBox1.Items.Add (# 13 + 'Поточний антіградіент');
for i: = 1 to n do
form1.ListBox1.Items.Add ('g' + inttostr (i )+'='+ Floattostrf (dk [i], ffGeneral, 8,5) + '');
form1.ListBox1.Items.Add ('Цільова функція F =' + Floattostrf (sf, ffGeneral, 8,5));
form1.ListBox1.Items.Add ('----------------------------------------- --');
end;
od: = 0;
for i: = 1 to n do
od: = od + sqr ((dk [i]));
od: = sqrt (od); if od <e then goto 1;
nn: = nn +1;
if nn> Nmax then
begin
nn: = nn-1;
showmessage ('Мінімум не знайдений !!!'+ # 13 +' Необхідна чіслоітерацій більше виділеного ресурсу '+ Inttostr (Nmax));
Fopt: = F (xk);
Exit
end;
Min (0,10, e, lambda, s);
for i: = 1 to n do
xk [i]: = xk [i] + lambda * dk [i] / od;
Until (lambda <e);
Одна: Fopt: = F (xk);
with form1.ListBox1.Items do
begin
Add ('Оптимальні значення за' + inttostr (nn) + 'ітерації');
for i: = 1 to n do
Add ('X' + inttostr (i )+'*'+'='+ floattostrf (xk [i], ffGeneral, 8,5));
Add ('Цільова функція F (X *) =' + Floattostrf (fopt, ffGeneral, 8,5));
end;
end;
function model1 (x: Artype): real;
begin
end;
procedure TForm2.Optimiz (k: integer);
begin
try / / введення початкових умов
with form1 do
begin
X0 [1]: = strtofloat (form1.Edit12.Text);
X0 [2]: = strtofloat (form1.Edit13.Text);
end
except
showMessage ('Неправильно введені початкові умови');
end;
with FormGraph do / / координатна площина
begin
{Установка максимуму і мінімуму функції}
Xb: =- abs (X0 [1]) -5; Xe: = abs (X0 [1]) +5; Ymin: =- abs (X0 [2]) -5; Ymax: = abs (X0 [2] ) +5;
GrafOrt;
end;
Nmax: = 500; e: = 0.00001; prn: = 1;
formGraph.imGraph.Canvas.Pen.Color: = clRed;
formgraph.imGraph.Canvas.Pen.Width: = 2;
formgraph. imGraph.Canvas.TextOut (round (mx * x0 [1] + Sx),
round (-my * x0 [2] + Sy), '0 ');
formGraph.imGraph.Canvas.MoveTo (round (mx * x0 [1] + Sx), round (-my * x0 [2] + Sy));
F1: = Model;
Grad (n, 0.1, X0, g, f1);
Opgrad (n, e, X0, Nmax, prn, fopt, NN, f1);
formgraph.imGraph.Canvas.Pen.Width: = 1;
end;
end.
Завдання 5
МЕТОДИ нульового порядку РІШЕННЯ БАГАТОВИМІРНИХ ЗАВДАНЬ ОПТИМІЗАЦІЇ
Мета завдання: придбати практичні навички розробки алгоритмів і програм оптимізації багатовимірних функцій методами ненульового порядку, зокрема методом прямого пошуку.
Рисунок 8 - блок-схема підпрограми циклічної зміни координат базисної точки
Рисунок 9 - Блок-схема методу прямого пошуку
Індивідуальне завдання.
Знайдіть мінімум функції методом прямого пошуку, вибравши в Хо (3, -1, 2), а потім Хо (-3, 1, -2).
Алгоритм з допомогою якого проводилася оптимізація функції зображено на малюнках 8, 9 у вигляді блок-схем.
Рішення задачі на ЕОМ.
На малюнках 10, 11 зображені результати оптимізації на ЕОМ при різних початкових умовах
Рисунок 10 - результати і траєкторія руху базису при Хо (3, -1, 2)
Малюнок 11 - результати при Хо (-3,1, -2)
Висновок: В ході роботи при зміні початкових умов було виявлено, що наближення початкових умов до оптимальних значень кількість ітерацій значно зменшується.
Лістинг підпрограми
procedure Poisk (n: integer; zb: Artype; delta: real;
Var z1: Artype; Var w: real;
Var l: integer; F: Funop);
Var
z: Artype; i: integer; y: real;
begin
w: = f (zb);
z: = zb; z1: = zb; l: = 0;
for i: = 1 to n do
begin
z [i]: = zb [i] + delta; y: = f (z);
if y <w then
begin
z1 [i]: = z [i]; l: = l +1; w: = y
end
else begin
z [i]: = zb [i]-delta; y: = f (z);
if y <w then
begin
z1 [i]: = z [i]; l: = l +1; w: = y
end
end;
end;
w: = f (z1);
end;
procedure MyClass.OptPoisk (n, m: integer;
delta, eps: real; xo: Artype; Var xb: Artype;
Var Yopt: real; Var ip: integer; F: Funop);
Label 6,7,10;
Var x1, x2, x3: Artype;
d, wo, y1, y2, y3: real; i, l: integer;
a, b: string;
Procedure Outt (x: Artype; y: real);
Var i: integer;
begin
for i: = 1 to n do
begin
str (x [i]: 8:3, a); str (y: 9:3, b);
form1.ListBox2.Items.Add ('X' + inttostr (i )+'='+ a);
with formgraph do
begin
imGraph.Canvas.Pen.Color: = clRed;
imgraph.Canvas.LineTo (round (mx * x [1] + Sx),
round (-my * x [2] + Sy));
imGraph1_3.Canvas.Pen.Color: = clBlue;
imgraph1_3.Canvas.LineTo (round (mx * x [1] + Sx),
round (-my * x [3] + Sy));
imGraph2_3.Canvas.Pen.Color: = clBlack;
imgraph2_3.Canvas.LineTo (round (mx * x [2] + Sx),
round (-my * x [3] + Sy));
end;
end;
str (y: 9:1, b);
form1.ListBox2.Items.Add ('--------------------- F = '+ b +'-----------');
end;
Begin
f: = model;
d: = delta;
wo: = f (xo);
ip: = 0;
with formGraph do
begin
imGraph.Canvas.Pen.Width: = 2;
imGraph1_3.Canvas.Pen.Width: = 2;
imGraph2_3.Canvas.Pen.Width: = 2;
for i: = 1 to n do
begin / / Перо в початкову точку
imGraph.Canvas.TextOut (round (mx * xo [1] + Sx),
round (-my * xo [2] + Sy), inttostr (ip));
imGraph.Canvas.MoveTo (round (mx * xo [1] + Sx),
round (-my * xo [2] + Sy));
imGraph1_3.Canvas.TextOut (round (mx * xo [1] + Sx),
round (-my * xo [3] + Sy), inttostr (ip));
imGraph1_3.Canvas.MoveTo (round (mx * xo [1] + Sx),
round (-my * xo [3] + Sy));
imGraph2_3.Canvas.TextOut (round (mx * xo [2] + Sx),
round (-my * xo [3] + Sy), inttostr (ip));
imGraph2_3.Canvas.MoveTo (round (mx * xo [2] + Sx),
round (-my * xo [3] + Sy));
end;
end;
Outt (xo, wo);
xb: = xo;
10: Poisk (n, xb, d, x1, y1, l, F);
ip: = ip +1;
if l = 0 then goto 6;
7: for i: = 1 to n do
x2 [i]: = 2 * x1 [i]-xb [i];
y2: = f (x2);
Poisk (n, x2, d, x3, y3, l, F);
ip: = ip +1;
if ip> m then
begin
ShowMessage ('Кількість ітерацій>' + inttostr (m) + # 13 + 'Мінімум не знайдений !!!');
xb: = x3;
Yopt: = f (xb);
Exit
end;
if y3 <y1 then
begin
xb: = x1; wo: = f (xb);
Outt (xb, wo);
x1: = x3; y1: = y3;
goto 7
end
else
begin
xb: = x1; wo: = f (xb);
Outt (xb, wo);
goto 10
end;
6: if d> = eps then
begin
d: = d / 5;
goto 10
end
else Yopt: = f (xb);
form1.ListBox2.Items.Add ('Кількість ітерацій -' + InttoStr (ip));
for i: = 1 to n do
begin
str (xb [i]: 8:3, a);
form1.ListBox2.Items.Add ('X' + inttostr (i) + 'опт'+'='+ a);
end;
form1.listbox2.Items.Add ('Мінімум -' + FloatToStr (opt1_5.Yopt));
end;
function model (x: Artype): real;
begin
model: = {25 * sqr (x [1] +3) +4 * sqr (x [3] -4) +10 * sqr (x [1]-x [2]) +10;}
{3 * sqr (x [1] -4) +50 * sqr (x [2] -3) +16 * sqr (x [1]-x [3]) +12;}
16 * sqr (x [1] +2) +4 * sqr (x [2] -3) +5 * sqr (x [3]-x [2]) -8;
end;
Завдання 6
МЕТОДИ ВИПАДКОВОГО ПОШУКУ РІШЕННЯ БАГАТОВИМІРНИХ ЗАВДАНЬ ОПТИМІЗАЦІЇ
Мета завдання: придбати практичні навички пошуку на ЕОМ умовного екстремуму функцій багатьох змінних методом випадкового пошуку з перерахунком.
Індивідуальне завдання.
Знайдіть мінімум функції методом випадкового пошуку, вибравши початковою точкою Хо (0, 0, 0) при зміні аргументів Xi в межах [ai, bi]. Передбачте отрисовку пошуку мінімуму в координатах x 1 Ox 2, x 1 Ox 3, x 2 Ox 3.
Проведіть порівняльний аналіз за кількістю обчислень функції задаючи параметр М = 10, 15, 20 при кроці Н = 20 і, задаючи Н = +0,5; 1; 2 при М = 15
Рисунок 12 - блок-схема методу випадкового пошуку з перечет.
Малюнок 13 рішення задачі на ЕОМ і траєкторія пошуку оптимальних значень функції
Результати роботи програми зображені на малюнку 13.
Висновок: в основі методу випадкового пошуку лежить внесення елементів випадку в процедуру формування пробних точок, які використовуються для визначення напрямку пошуку. Даний метод ефективний для функцій з великою кількістю змінних, так як обмежується кількість обчислень функції за рахунок знаходження антіградіентного направлення за допомогою пробних точок.
Лістинг підпрограми методу
unit Opt1_6;
interface
uses
Dialogs, SysUtils, Graphics;
Const n = 3;
Type Artype = array [1 .. n] of real;
Funop = function (xi: Artype): real;
type MyClass = class
public
procedure slpoisk (n, m, mf: integer;
h, hmin: real; xmin, xmax: Artype;
Var xo: Artype; Var Yopt: real; F: Funop);
end;
var opt6: MyClass;
var
F: FUNOP;
i, m, mf, im: integer;
h, hmin: real;
xmin, xmax: Artype;
xo, x: Artype;
Yopt: real;
function model (x: Artype): real;
implementation
uses main, unitGraph;
function model (x: Artype): real;
begin
model: = {25 * sqr (x [1] +3) +4 * sqr (x [3] -4) +10 * sqr (x [1]-x [2]) +10;}
{10 * sqr (x [1]-x [2]) +4 * sqr (x [1] -2) +25 * sqr (x [3] + x [2]) +8;}
16 * sqr (x [1] +2) +4 * sqr (x [2] -3) +5 * sqr (x [3]-x [2]) -8;
end;
procedure Myclass.slpoisk (n, m, mf: integer;
h, hmin: real; xmin, xmax: Artype;
Var xo: Artype; Var Yopt: real; F: Funop);
Label 9,10;
Var x, d, s: Artype; b, hr, y0, y, qsi: real; i, l, k: integer;
Procedure Outt (x: Artype; y: real; kod: integer);
Var i: integer; a, b, c: string;
begin
for i: = 1 to n do
begin
str (x [i]: 8:3, a); str (y: 9:3, b);
form1.ListBox3.Items.Add ('X' + inttostr (i) +
'=' + A);
if (kod = 1) then
with formgraph do
begin
imGraph.Canvas.Pen.Color: = clRed;
imgraph.Canvas.LineTo (round (mx * x [1] + Sx),
round (-my * x [2] + Sy));
imGraph1_3.Canvas.Pen.Color: = clBlue;
imgraph1_3.Canvas.LineTo (round (mx * x [1] + Sx),
round (-my * x [3] + Sy));
imGraph2_3.Canvas.Pen.Color: = clBlack;
imgraph2_3.Canvas.LineTo (round (mx * x [2] + Sx),
round (-my * x [3] + Sy));
end;
end;
case Kod of
0: c: = 'Початкова точка';
1: c: = 'Функція убуває';
2: c: = 'пробної точки';
end;
form1.ListBox3.Items.Add ('----------- '+ c +' ------'+' F = '+ b);
end;
/ / Main
begin
f: = model;
b: =- 1e20;
for i: = 1 to n do
begin
d [i]: = xmax [i]-xmin [i];
if d [i]> b then
b: = d [i];
end;
for i: = 1 to n do
s [i]: = d [i] / b;
hr: = h; y0: = f (xo); im: = 1;
with formGraph do
begin
imGraph.Canvas.Pen.Width: = 2;
imGraph1_3.Canvas.Pen.Width: = 2;
imGraph2_3.Canvas.Pen.Width: = 2;
for i: = 1 to n do
begin / / Перо в початкову точку
imGraph.Canvas.TextOut (round (mx * xo [1] + Sx),
round (-my * xo [2] + Sy), inttostr (im));
imGraph.Canvas.MoveTo (round (mx * xo [1] + Sx),
round (-my * xo [2] + Sy));
imGraph1_3.Canvas.TextOut (round (mx * xo [1] + Sx),
round (-my * xo [3] + Sy), inttostr (im));
imGraph1_3.Canvas.MoveTo (round (mx * xo [1] + Sx),
round (-my * xo [3] + Sy));
imGraph2_3.Canvas.TextOut (round (mx * xo [2] + Sx),
round (-my * xo [3] + Sy), inttostr (im));
imGraph2_3.Canvas.MoveTo (round (mx * xo [2] + Sx),
round (-my * xo [3] + Sy));
end;
end;
Outt (xo, y0, 0);
randomize;
9: k: = 0;
10: l: = 0;
for i: = 1 to n do
begin
qsi: = 2 * random-1;
x [i]: = xo [i] + hr * s [i] * qsi;
if x [i]> xmax [i] then
begin
x [i]: = xmax [i]; l: = l +1
end
else if x [i] <xmin [i] then
begin
x [i]: = xmin [i]; l: = l +1
end
end;
if l <n then
begin
y: = f (x);
outt (x, y, 2);
if y <y0 then outt (x, y, 1);
im: = im +1;
if im> mf then
begin
showMessage ('Кількість обчислень функції>' + IntTostr (mf) + # 13 + 'мінімум не Нейди !!!');
Yopt: = y0;
Exit
end;
if y <y0 then
begin
y0: = y; xo: = x;
goto 9;
end
end;
k: = k +1;
if k <m then goto 10
else
begin
hr: = hr / 2;
if hr <hmin then
begin
Yopt: = y0;
for i: = 1to n do
form1.ListBox3.Items.Add ('X' + inttostr (i) + 'опт'+'='+ floattostrf (x [i], ffGeneral, 5,2));
form1.ListBox3.Items.Add ('Yопт =' + floattostrf (Yopt, ffGeneral, 5,2));
form1.ListBox3.Items.Add ('Кількість обчислень функції =' + InttoStr (im));
Exit end
else goto 9;
end;
end;
end.