freepascal.ru

Код: Выделить всё

type
tfunc=function(x:single):single;
tfunc2=function(x,x0,eps:single):single;
tfunc3=function(x,x0,eps:single;fp:tfunc2):single;
tfunc4=function(x,x0,eps:single;fp1:tfunc2;fp2:tfunc3):single;

function dfdx(x0,eps:single;f:tfunc4):single;
var
dx,dy,dy2:single;
fz2:tfunc2;
fz3:tfunc3;
begin
dx:=1;
repeat
dx:=dx/2;
dy:=f(x0+dx/2,x0,eps,fz2,fz3)-F(x0-dx/2,x0,eps,fz2,fz3);
dy2:=F(5*x0/4+dx,x0,eps,fz2,fz3)-2*F(5*x0/4,x0,eps,fz2,fz3);
dy2:=dy2+F(5*x0/4-dx,x0,eps,fz2,fz3);
until abs(dy2*dy2*F(x0,x0,eps,fz2,fz3)/(2*dx))<eps;
dfdx:=dy/dx;
end;

function yn(x,x0,eps:single;fp1:tfunc2;fp2:tfunc3){(x:single)}:single;
begin
yn:=146.60715*exp(-0.18192*x);
end;

function ykn(x,x0,eps:single;fp1:tfunc4):single;
var
fz2:tfunc2;
fz3:tfunc3;
begin
ykn:=fp1(x0,x0,eps,fz2,fz3)+dfdx(x0,eps,fp1)*(x-x0);
end;

function fdif(x,x0,eps:single;fp1:tfunc2;fp2:tfunc3):single;
begin
fdif:=fp1(x,x0,eps)-fp2(x,x0,eps,fp1);;
end;

var
f1,f2:text;
i,n,j:integer;
xt,yt,EPP,MPP:array[1..100] of single;
k1,eps1,eps2,x0,y0:single;

y1:tfunc4;
fp3:tfunc3;
fp2:tfunc2;

begin
//for j:=1 to n do begin
//x0:=xt[n-(j-1)];
{Итерация 1}
x0:=xt[n];
y1:=yn;
y0:=ykn(0,x0,eps1,y1); {!}

{Итерация 2}
x0:=xt[n-1];
y1:=fdif; {!}
y0:=ykn(0,x0,eps1,y1);

//end;{j}
readln;
end.


Код: Выделить всё

type
tfunc=function(x:single):single;

function R_F(x:single):single;
begin
R_F:=Sin(X)*x;
end;
Var 
F:tfunc;
Y,X:single;
begin
X:=1;
F:=tfunc(@R_F);
Y:=F(X);
Writeln('Y=',y);
end.


Mavlyudov писал(а):Alex2013
У меня вроде тоже самое сделано.
Ну а без процедурного типа не понимаю как сделать. Если знаешь, напиши как

Код: Выделить всё

function ykn(x,x0,eps:single;fp1:tfunc4):single;
var
fz2:tfunc2;
fz3:tfunc3;
begin
ykn:=fp1(x0,x0,eps,fz2,fz3)+dfdx(x0,eps,fp1)*(x-x0);
end;


Alex2013 писал(а):Сделано так y1:=fdif; а нужно y1:=tfunc4 (@fdif); то есть нет "привидения типа".

Код: Выделить всё

y1:=tfunc4(@fdif);

Код: Выделить всё

y1:=tfunc4(@fdif(x,x0,eps1,fp1,fp2));


Alex2013 писал(а):Вникать в алгоритм если честно лень, но без приведения типа этот код вообще компилироваться не должен. ( разве что "дельфи моде" и то сомневаюсь )

Mavlyudov писал(а):y1:=tfunc4(@fdif(x,x0,eps1,fp1,fp2));

Mavlyudov писал(а):Alex2013
Помоги тогда поправить

Код: Выделить всё

program TangentApproximation;

uses Math; // Для использования exp и других математических функций

const
  n = 3;  // Число точек
  a = 1.0;
  b = 0.5;

type
  TArray = array[1..n] of real;

var
  x: TArray = (1.0, 2.0, 3.0); // Массив точек
  i: integer;
  yk, yk_prev: real;

// Функция y1(x) = a * exp(b * x)
function y1(x: real): real;
begin
  y1 := a * exp(b * x);
end;

// Производная dy1(x)/dx = a * b * exp(b * x)
function dy1(x: real): real;
begin
  dy1 := a * b * exp(b * x);
end;

// Функция y(x) для итераций: y2(x), y3(x), ..., вычитая предыдущие касательные
function y_diff(x: real; yk_prev: real; x0: real): real;
begin
  y_diff := y1(x) - yk_prev;
end;

// Функция касательной к y(x) в точке x0
function tangent_line(x: real; x0: real; dy_dx: real): real;
begin
  tangent_line := y1(x0) + dy_dx * (x - x0);
end;

begin
  writeln('Итерационный процесс:');
  yk_prev := 0.0;  // Начальное значение касательной
  for i := n downto 1 do
  begin
    // x0 = x[i], расчет касательной
    yk := tangent_line(0, x[i], dy1(x[i]));  // Вычисляем yk в точке x[i]

    writeln('Итерация ', n - i + 1, ':');
    writeln('x0 = ', x[i]:4:2);
    writeln('Касательная yk(x) в точке x0 = ', x[i]:4:2, ' равна ', yk:8:4);
    writeln('Производная в x0: dy1(x0)/dx = ', dy1(x[i]):8:4);

    // Вычисляем разницу функции y_diff
    if i > 1 then
    begin
      yk_prev := tangent_line(0, x[i-1], dy1(x[i-1]));  // Касательная для следующей итерации
      writeln('y0 на следующем шаге = ', yk_prev:8:4);
    end;

    writeln;
  end;

  readln;
end.