Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/36: Рейтинг темы: голосов - 36, средняя оценка - 4.75
raxefon
4 / 4 / 0
Регистрация: 28.09.2009
Сообщений: 36
1

Метод Хука-Дживса.

16.02.2010, 13:50. Просмотров 6624. Ответов 10
Метки нет (Все метки)

Подскажите как можно избавиться от label m1, m2;goto а место них While поставить правильно? спс все кто поможет

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
procedure TForm1.Button1Click(Sender: TObject);
label m1, m2;
var
k,x,H,h0,x0:array[1..3] of real;
a,b:array[1..3] of integer;
j,i,ch:integer;
x1,x2,x3,y,y1,y2,y0,f,ymax :real;
flag:boolean;
begin
 f:=0.1;
 ch:=0;
 for i:=1 to 3 do begin
 a[i]:=0;
 b[i]:=20;
 x0[i]:=random(b[i]-a[i])+a[i];
 end;
y0:=0.35*x[1]*x[2]+0.7*x[3]*x[1]-x[1];
 ch:=ch+1;
 for i:=1 to 3 do begin
   H[i]:=(b[i]-a[i])/3;
   h0[i]:=(b[i]-a[i])*f;
   x0[i]:=x0[i]+h0[i];
   x[i]:=x0[i];
 end;
m1: flag:=true;
 for i:=1 to 3 do begin  //флаг=1, проводим исследования
   x[i]:=x0[i]+h0[i];
y1:=0.35*x[1]*x[2]+0.7*x[3]*x[1]-x[1];
   ch:=ch+1;
   x[i]:=x0[i]-h0[i];
y2:=0.35*x[1]*x[2]+0.7*x[3]*x[1]-x[1];
   ch:=ch+1;
   x[i]:=x0[i];
   if  y1>y2 then k[i]:=1
             else k[i]:=-1;
 end;
m2:
  for j:=1 to 3 do begin
      x[i]:=x0[i]+k[i]*H[i];
  end;
    y:=0.35*x[1]*x[2]+0.7*x[3]*x[1]-x[1];
      ch:=ch+1;
      if  y>y0 then begin
                     y0:=y;
                     x0[i]:=x[i];
                     flag:=false;
                     H[i]:=(b[i]-a[i])/3;
                    end
      else 
            if flag=false then H[i]:=H[i]/2
                            else goto m1; // ухудшение, проводим снова исследования
if H[i]>h0[i] then goto m2; // улучшение, без исслед. идём выше в др. точку
ymax:=x[1]*x[2]+sqr(x[2])-sqr(x[3])*0.4;
edit1.Text:=FloatToStrF(x[1],ffFixed,4,0);
edit2.Text:=FloatToStrF(x[2],ffFixed,4,0);
edit3.Text:=FloatToStrF(x[3],ffFixed,4,0);
edit4.Text:=FloatToStrF(ymax,ffFixed,4,0);
edit5.Text:=inttostr(ch);
end;
initialization
  randomize;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
16.02.2010, 13:50
Ответы с готовыми решениями:

Установка хука на движение формы
вот попытался поставить hook на WH_CALLWNDPROCRET После запуска вырубается...

Нужно додумать код CBT хука
Написал с горем по полам CBTHook(dll) на HCBT_ACTIVATE. Суть этого хука в том...

Метод хорд, метод касательных, метод половинного деления
Ребят помогите пожалуйста. Задали тему курсовой "Решение нелинейных уравнений...

Транспортная задача: метод северо-западного угла + метод оптимизации (потенциалов)
есть у кого-нибудь исходники на программу решения злп метод с-з угла + метод...

Транспортная Задача Делфи (метод с-з угла + метод оптимизации(потенциалов)
Ребят, столкнулся с такой проблемой: Курсовая работа "Компьютерная модель...

10
i8085
1897 / 1328 / 252
Регистрация: 11.09.2009
Сообщений: 4,682
16.02.2010, 17:54 2
raxefon,
не забивайте себе голову чьми-то накатами на "неправильность" goto. Всё "неправильное" давно из Паскаля убрано. А в данном случае применение goto вообще вполне оправданно.
0
Vovan-VE
13157 / 6542 / 1038
Регистрация: 10.01.2008
Сообщений: 15,070
16.02.2010, 18:40 3
Согласен с i8085. Как вариант, можно, для начала, на функции разбить, а там видно будет.
0
raxefon
4 / 4 / 0
Регистрация: 28.09.2009
Сообщений: 36
17.02.2010, 00:01  [ТС] 4
можете показать как будет это выгледить?
0
i8085
1897 / 1328 / 252
Регистрация: 11.09.2009
Сообщений: 4,682
17.02.2010, 10:23 5
Цитата Сообщение от Vovan-VE Посмотреть сообщение
...на функции разбить, а там видно будет.
Видно будет, что, как минимум, увеличится время выполнения программы за счёт вызовов функций вместо простого условного перехода.
0
raxefon
4 / 4 / 0
Регистрация: 28.09.2009
Сообщений: 36
18.02.2010, 00:37  [ТС] 6
код можешь переделалать?
0
raxefon
4 / 4 / 0
Регистрация: 28.09.2009
Сообщений: 36
20.02.2010, 04:30  [ТС] 7
не получается ((
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
20.02.2010, 11:24 8
Raxefon, здравствуй! Я сейчас займусь этой прогой. Отпишу сюда сегодня.
Что касается кода - я по своему сделаю.
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
21.02.2010, 03:36 9
Вот вариант решения.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  //Точка в трёхмерном пространстве.
  TDot = record
    X, Y, Z : Extended;
  end;
 
  //Сведения о функции в заданной точке.
  TFunc = record
    Dot : TDot;
    Func : Extended;
  end;
 
  //Область задания аргументов - куб.
  TArea = record
    //Центр области.
    Dot : TDot;
    //Размер граней куба.
    LX, LY, LZ : Extended;
  end;
 
//Расчёт значения функции в заданной точке.
function CalcFunc(const aDot : TDot) : Extended;
begin
  Result := 0.3 * aDot.X * aDot.Z * aDot.Z - 0.4 * aDot.Y * aDot.X + aDot.X * aDot.Z;
 
  //Для тестов.
  //X -> +20, Y -> -40, Z -> -40
  //Result := - aDot.X + aDot.Y + aDot.Z;
  //X -> -40, Y -> +20, Z -> -40
  //Result := aDot.X - aDot.Y + aDot.Z;
  //X -> -40, Y -> -40, Z -> +20
  //Result := aDot.X + aDot.Y - aDot.Z;
end;
 
//Поиск "лучшей" точки в области aArea. aArea - это часть области определения функции.
//aAmount >= 1. Реально aAmount должно быть хотябы = 10.
function BestDotInArea(const aArea : TArea; const aAmountDot : Cardinal) : TFunc;
var
  i : Integer;
  Func : TFunc;
begin
  Randomize;
 
  //Выбираем произвольную точку в области aArea и первоначально считаем,
  //что в этой точке расположен минимум.
 
  //Случайная точка в области aArea.
  Result.Dot.X := aArea.Dot.X - aArea.LX / 2 + aArea.LX * Random;
  Result.Dot.Y := aArea.Dot.Y - aArea.LY / 2 + aArea.LY * Random;
  Result.Dot.Z := aArea.Dot.Z - aArea.LZ / 2 + aArea.LZ * Random;
  //Значение функции в выбранной точке.
  Result.Func := CalcFunc(Result.Dot);
 
  for i := 1 + 1 to aAmountDot do begin
    //Случайная точка в области aArea.
    Func.Dot.X := aArea.Dot.X - aArea.LX / 2 + aArea.LX * Random;
    Func.Dot.Y := aArea.Dot.Y - aArea.LY / 2 + aArea.LY * Random;
    Func.Dot.Z := aArea.Dot.Z - aArea.LZ / 2 + aArea.LZ * Random;
    //Значение функции в выбранной точке.
    Func.Func := CalcFunc(Func.Dot);
    //Если значение в очередной точке меньше минимума, значит очередную точку
    //считаем новым минимумом.
    if Func.Func < Result.Func then begin
      Result := Func;
    end;
  end;
end;
 
//Перемещение области aArea к точке aDot.
procedure MoveArea(const aAreaMain : TArea; var aArea : TArea; const aDot : TDot);
begin
  //Перемещаем область aArea к точке aDot. Т. е. в данный момент точка aDot
  //расположена в центре области aArea.
  aArea.Dot := aDot;
 
  //Корректируем положение точки aArea.Dot таким образом, чтобы область aArea
  //не выходила за пределы области aAreaMain.
 
  if aDot.X - aArea.LX / 2 < aAreaMain.Dot.X - aAreaMain.LX / 2 then
    aArea.Dot.X := aAreaMain.Dot.X - aAreaMain.LX / 2 + aArea.LX / 2
  ;
  if aDot.X + aArea.LX / 2 > aAreaMain.Dot.X + aAreaMain.LX / 2 then
    aArea.Dot.X := aAreaMain.Dot.X + aAreaMain.LX / 2 - aArea.LX / 2
  ;
 
  if aDot.Y - aArea.LY / 2 < aAreaMain.Dot.Y - aAreaMain.LY / 2 then
    aArea.Dot.Y := aAreaMain.Dot.Y - aAreaMain.LY / 2 + aArea.LY / 2
  ;
  if aDot.Y + aArea.LY / 2 > aAreaMain.Dot.Y + aAreaMain.LY / 2 then
    aArea.Dot.Y := aAreaMain.Dot.Y + aAreaMain.LY / 2 - aArea.LY / 2
  ;
 
  if aDot.Z - aArea.LZ / 2 < aAreaMain.Dot.Z - aAreaMain.LZ / 2 then
    aArea.Dot.Z := aAreaMain.Dot.Z - aAreaMain.LZ / 2 + aArea.LZ / 2
  ;
  if aDot.Z + aArea.LZ / 2 > aAreaMain.Dot.Z + aAreaMain.LZ / 2 then
    aArea.Dot.Z := aAreaMain.Dot.Z + aAreaMain.LZ / 2 - aArea.LZ / 2
  ;
 
end;
 
//Поиск решения в заданной области.
//aL - первоначальный размер грани куба в области определения.
//aDelim - максимальный делитель грани aL.
function FindDecision(const aAreaMain : TArea; const aL : Extended; const aDelim : Cardinal) : TFunc;
const
  //Количество точек в кубе.
  AmountDot = 10000;
var
  //Куб.
  AreaTmp : TArea;
  Delim   : Cardinal;
  FuncTmp : TFunc;
begin
  //Начальный размер куба.
  AreaTmp.LX := aL;
  AreaTmp.LY := aL;
  AreaTmp.LZ := aL;
  //Начальный центр куба. Делаем, например так, чтобы он совпадал с центром
  //области поиска.
  AreaTmp.Dot := aAreaMain.Dot;
 
  //Первоначальная глобальная "лучшая" точка - центр куба.
  Result.Dot := AreaTmp.Dot;
  //Начальным глобальным минимумом функции является значение функции в выбранной точке.
  Result.Func := CalcFunc(Result.Dot);
  //Нчальный делитель граней куба = 1.
  Delim := 1;
  while Delim < aDelim do begin
    //Ищем локальную "лучшую" точку внутри куба.
    FuncTmp := BestDotInArea(AreaTmp, AmountDot);
    //Сравниваем значение функции в локальной "лучшей" точке со значением функции
    //в глобальной "лучшей" точке.
    if FuncTmp.Func < Result.Func then begin
      //Если локальная точка "лучше" глобальной, тогда делаем её новой
      //глобальной "лучшей" точкой.
      Result := FuncTmp;
      //Перемещаем куб к новой глобальной "лучшей" точке.
      MoveArea(aAreaMain, AreaTmp, Result.Dot);
    end else begin
      //Если локальная точка "хуже" глобальной, тогда уменьшаем грани куба вдвое.
      Delim := Delim * 2;
      AreaTmp.LX := AreaTmp.LX / 2;
      AreaTmp.LY := AreaTmp.LY / 2;
      AreaTmp.LZ := AreaTmp.LZ / 2;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Func : TFunc;
  Area : TArea;
begin
  //Область поиска.
  Area.Dot.X := -40 + 30;
  Area.Dot.Y := -40 + 30;
  Area.Dot.Z := -40 + 30;
  Area.LX := 60;
  Area.LY := 60;
  Area.LZ := 60;
 
  //Поиск минимума функции.
  Func := FindDecision(Area, 2, 16);
 
  //Показ результатов.
  ShowMessage(
    'Func = ' + FloatToStr(Func.Func) + Char(10)
    + 'Dot.X = ' + FloatToStr(Func.Dot.X) + Char(10)
    + 'Dot.Y = ' + FloatToStr(Func.Dot.Y) + Char(10)
    + 'Dot.Z = ' + FloatToStr(Func.Dot.Z) + Char(10)
  );
end;
 
end.
0
Вложения
Тип файла: rar FindMin.rar (170.8 Кб, 441 просмотров)
raxefon
4 / 4 / 0
Регистрация: 28.09.2009
Сообщений: 36
21.02.2010, 07:21  [ТС] 10
спс!!!!!!

Добавлено через 42 минуты
только тут метод другой Метод Хука-Дживса а тот случайный поиск за него спс
0
Benjamin=)
7 / 7 / 1
Регистрация: 06.12.2009
Сообщений: 41
06.01.2011, 14:41 11
Mawrat, А не могли бы вы передолать программу, чтобы можно было вводить свои данные. зарание спасибо.
0
06.01.2011, 14:41
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
06.01.2011, 14:41

Конструктор,метод вывода на экран Display, метод для преобразования в строку toString в Delphi
Здравствуйте программисты!!! Мне в университете задали написать класс, а в этом...

Метод Эйлера и метод Рунге-Кутта: проверить код
Доброго времени суток. Хотел бы обратится к вам за помощью. Я написал...

Численные методы: метод секущих и метод Ньютона (касательных)
Пусть известны функции спроса D(p) и предложения S(p) для некоторого товара Т....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru