Приветсвую всех, нужна ваша помощь: Необходмо заменить в программе функцию f(x) = (x1-2)4+(x1-2x2)2, на функцию:
http://s2.ipicture.ru/Gallery/Viewfull/7575341.html
Программа предназначена для решения задач методом Давидона-Флетчера-Пауэлла, для того что бы запустить её необходимо создать ещё один файл
dat_1.pas (в нём задать точки Xo)
Помогите разобраться в паскале не силён
| Код |
program pr1;
Uses {DFP,}CRT;
type
vector= array[1..2] of real;
matrix= array[1..2,1..2] of real;
const
n=2;
fres='res_01.pas';
fdata='dat_1.pas';
Var fr,fd:text;
E,h:real;
i:integer;
b,f:vector;
procedure matvect(n:integer; at:matrix;b:vector;Var atb:vector);
Var i,j:integer;S:real;
begin
for i:=1 to n do begin
s:=0;
for j:=1 to n do
S:=S+at[i,j]*b[j];
atb[i]:=S;
end;
end;
procedure vect(n:integer;a,b:vector;Var c:real);
Var i:integer;S:real;
begin
S:=0;
for i:=1 to n do
S:=S+a[i]*b[i];
c:=S;
end;
{$F+}
procedure IsxFunc(n:integer;b:vector;Var fy:real);
begin
fy:=sqr(sqr(b[1]-2))+sqr(b[1]-2*b[2]);
end;
{$F-}
{$F+}
procedure funkcii(n:integer;b:vector;Var f:vector);
begin
f[1]:=4*sqr(b[1]-2)*(b[1]-2)+2*(b[1]-2*b[2]);
f[2]:=-4*(b[1]-2*b[2]);
end;
{$F-}
procedure MDFP(h:real;n:integer;E:real;Var b:vector;Var fr:text{;IsxFuncroc1; funkcii: proc});
Var lambd,G1,G,norma:real;
i,k,o,j,z:integer;
p,q,d,lf,u3,f2,f,r:vector;
u5,u2:real;
a:matrix;
begin
For i:=1 to n do
For j:=1 to n do
if i=j then a[i,j]:=1
else a[i,j]:=0;
o:=0;
Repeat
writeln(fr,' -------------------------------------------------');
funkcii(n,b,f);
norma:=sqrt(sqr(f[1])+sqr(f[2]));
writeln(fr,'norma= ',norma:2:6);
matvect(n,a,f,d);
lambd:=-1;
for z:=1 to n do
r[z]:=b[z]-lambd*d[z];
Repeat
Isxfunc(n,r,G);
lambd:=lambd+h;
for z:=1 to n do
r[z]:=b[z]-lambd*d[z];
Isxfunc(n,r,G1);
Until G<G1;
Lambd:=lambd-h;
writeln(fr,'lambda=',lambd:2:6);
for i:=1 to n do
b[i]:=b[i]-lambd*d[i];
writeln(fr,'b[n]');
for i:=1 to n do
writeln(fr,b[i]:2:6);
writeln(fr);
for i:=1 to n do
p[i]:=-lambd*d[i];
funkcii(n,b,f2);
for i:=1 to n do
q[i]:=f2[i]-f[i];
writeln(fr,'p[n]');
for i:=1 to n do
writeln(fr,p[i]:0:2);
writeln(fr);
writeln(fr,'q[n]');
for i:=1 to n do
writeln(fr,q[i]:0:2);
writeln(fr);
vect(n,p,q,u2);
matvect(n,a,q,u3);
vect(n,u3,q,u5);
for i:=1 to n do
for k:=1 to n do
a[i,k]:=a[i,k]+p[i]*p[k]/u2-u3[i]*u3[k]/u5;
writeln(fr,'a[n,n]');
for i:=1 to n do begin
for k:=1 to n do
write(fr,a[i,k]:2:6,' ');
writeln(fr);
end;
o:=o+1;
until norma<E;
writeln(fr,'точность достигается за ',o,'итераций');
end;
begin
clrscr;
Assign(fd,fdata);
reset(fd);
Assign(fr,fres);
rewrite(fr);
for i:=1 to n do
read(fd,b[i]);
writeln(fr,'b[n]');
for i:=1 to n do
writeln(fr,b[i]:0:6);
writeln(fr);
writeln('Введите точность E');
readln(E);
writeln('Введите шаг h');
readln(h);
MDFP(h,n,E,b,fr{,IsxFunc,funkcii});
close(fd);
close(fr);
end.
|
|