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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2011, 17:13   #1
shiftseo
Новичок
Джуниор
 
Регистрация: 06.09.2010
Сообщений: 2
По умолчанию Паскаль необходимо заменить функцию

Приветсвую всех, нужна ваша помощь: Необходмо заменить в программе функцию f(x) = (x1-2)4+(x1-2x2)2, на функцию:



Программа предназначена для решения задач методом Давидона-Флетчера-Пауэлла, для того что бы запустить её необходимо создать ещё один файл
dat_1.pas (в нём задать точки Xo)

Помогите разобраться в паскале не силён

PHP код:
program pr1;
Uses {DFP,}CRT;
type
vector
= array[1..2of real;
matrix= array[1..2,1..2of 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:integerat: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{;IsxFuncroc1funkciiproc});
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
shiftseo вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Необходимо оформить код как функцию в Delphi Idris Помощь студентам 1 26.01.2011 00:25
Чем заменить функцию? kity Помощь студентам 8 29.06.2010 16:08
Подскажите пожалуйста какую функцию необходимо использовать... Андрю)(@ Паскаль, Turbo Pascal, PascalABC.NET 1 10.12.2008 00:03
Подскажите пожалуйста какую функцию необходимо использовать... Андрю)(@ Помощь студентам 1 09.12.2008 23:53
необходимо ограничить функцию с нижней стороны значением y=0.4 Diller Помощь студентам 5 05.10.2007 18:43