Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.10.2008, 19:38   #1
varvara16
Пользователь
 
Регистрация: 05.11.2007
Сообщений: 57
По умолчанию Метод градиентного спуска

Помогите, пожалуйста, исправить код, приведенный ниже

Код:
    type
        TXArray = array of Extended; 
        TFunArray = array of function(XArray:TXArray):Extended;
        TResArray = array of array of Extended;
const
a=11;
b=-0.4;
c=1;
d=0.21;
eps=0.001;
var
  Form1: TForm1;
  g:txArray;
implementation

{$R *.dfm}
function f(x1:TXArray):real;
begin
f:=a*x1[0]+b*x1[1]+exp(c*x1[0]*x1[0]+d*x1[1]*x1[1]);
 end;

procedure funcdx(x1:TXArray);
begin
setlength(g,length(x1));
g[0]:=a+2*c*x1[0]*exp(c*x1[0]*x1[0]+d*x1[1]*x1[1]);
g[1]:=b+2*d*x1[1]*exp(c*x1[0]*x1[0]+d*x1[1]*x1[1]);
  end;

procedure TForm1.Button1Click(Sender: TObject);
label 1;
var
n,i,k:integer;
fxy:array[0..9999] of real;
x:txarray;
a:real;

begin
memo1.Lines.Clear;
n:=0;
setlength(x,2);
setlength(g,2);
1: //inc(n);
for i:=0 to length(x)-1 do begin
   x[i]:=0;
   a:=0.05;
   fxy[0]:=0;
   funcdx(x);
   x[i+1]:=x[i]-a*g[i];
   fxy[i]:=f(x);
 if (fxy[i]>fxy[i-1]) then begin
  a:=a/2; end
  else
   begin
    memo1.Lines.Add(inttostr(i)+'.  x['+inttostr(i)+']='+floattostrf(x[i],ffgeneral,3,4)+'  f['+inttostr(i)+']='+floattostr(fxy[i]));
   end;
if (abs(g[i])>=eps/2) then goto 1
else begin
    memo1.Lines.Add('');
    memo1.Lines.Add('Minimum pri  x='+floattostrf(x[i],ffgeneral,3,4)+'  f(x,y)='+floattostrf(fxy[i],ffgeneral,4,4)+'  a='+floattostrf(a,ffgeneral,4,4));
end;  end;
end;

end.
Я попыталась переделать код программы, сделать его более универсальным для нескольких переменных Х, ввести динамические массивы. Эта программа работает правильно. Помогите, пожалуйста, ее усовершенствовать

Код:
  type vec=array[1..8] of real;
const
a=11;
b=-0.4;
c=1;
d=0.21;
eps=0.001;
var
  Form1: TForm1;
  g:vec; //вектор производных

implementation

{$R *.dfm}

function func(x1,x2:real):real;
begin
func:=a*x1+b*x2+exp(c*x1*x1+d*x2*x2);
 end;

procedure funcdx(x1,x2:real);	//производные
begin
g[1]:=a+2*c*x1*exp(c*x1*x1+d*x2*x2);
g[2]:=b+2*d*x2*exp(c*x1*x1+d*x2*x2);
  end;

procedure TForm1.Button1Click(Sender: TObject);
label 1;
var
n:integer;
x,y,fxy,ak:array[0..9999] of real;

begin
memo1.Lines.Clear;
n:=0;
1: inc(n);
   x[0]:=strtofloat(edit1.Text);
   y[0]:=strtofloat(edit2.Text);
   ak[0]:=0.05;
   fxy[0]:=0;
   funcdx(x[n-1],y[n-1]);
   x[n]:=x[n-1]-ak[n-1]*g[1];
   y[n]:=y[n-1]-ak[n-1]*g[2];
   fxy[n]:=func(x[n],y[n]);
 if (fxy[n]>fxy[n-1]) then begin
  ak[n]:=ak[n-1]/2; end
  else
   begin
    ak[n]:=ak[n-1];
    memo1.Lines.Add(inttostr(n)+'.  x['+inttostr(n)+']='+floattostrf(x[n],ffgeneral,3,4)+'  y['+inttostr(n)+']='+floattostrf(y[n],ffgeneral,3,4)+'  f['+inttostr(n)+']='+floattostr(fxy[n]));
   end;
if (abs(a+2*c*x[n-1]*exp(c*x[n-1]*x[n-1]+d*y[n-1]*y[n-1]))>=eps/2) and (abs(b+2*d*y[n-1]*exp(c*x[n-1]*x[n-1]+d*y[n-1]*y[n-1]))>=eps/2) then goto 1
else begin
    memo1.Lines.Add('');
    memo1.Lines.Add('Minimum pri  x='+floattostrf(x[n],ffgeneral,3,4)+'  y='+floattostrf(y[n],ffgeneral,3,4)+'  f(x,y)='+floattostrf(fxy[n],ffgeneral,4,4)+'  ak='+floattostrf(ak[n],ffgeneral,4,4));
end;
end;

end.
Заранее благодарю.
varvara16 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сиплекс метод ChipLink Помощь студентам 1 20.06.2009 08:09
Help!!! Метод Гаусса Надя Microsoft Office Excel 7 07.05.2008 00:45
Метод Ньютона Durak Помощь студентам 1 30.04.2008 21:55
Сиплекс метод ChipLink Паскаль, Turbo Pascal, PascalABC.NET 3 11.12.2007 18:55