unit2.pas

Numeric Programs

unit Unit2;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
procedure POLINT(XA, YA:array of real; N:integer; X:real; var Y, DY:real);
procedure POLCOF(XA, YA:array of real; N:integer; var COF:array of real);

implementation
procedure POLINT(XA, YA:array of real; N:integer; X:real; var Y, DY:real);
var
    C,D:array[1..10] of real;
    DIF,DIFT,HO,HP,W,DEN,te:real;
    NS,I,M:integer;
begin
    NS:=1;
    DIF:=Abs(X - XA[1]);
    For I:=1 To N do
    begin
        DIFT:=Abs(X - XA[I]);
        If DIFT < DIF Then
        begin
            NS:=I;
            DIF:=DIFT;
        end;
        C[I]:=YA[I];
        D[I]:=YA[I];
    end;
    Y:=YA[NS];
    NS:=NS - 1;
    For M:=1 To N - 1 do
    begin
        For I:=1 To N - M do
        begin
            HO:=XA[I] - X;
            HP:=XA[I + M] - X;
            W:=C[I + 1] - D[I];
            DEN:=HO - HP;
            If DEN = 0 Then
            begin
                ShowMessage('PAUSE');
                Exit;
            end;
            DEN:=W / DEN;
            D[I]:=HP * DEN;
            C[I]:=HO * DEN;
        end;
        If 2 * NS < N - M Then
            DY:=C[NS + 1]
        Else
        begin
            DY:=D[NS];
            NS:=NS - 1;
        end;
        Y:=Y + DY;
    end;
end;

procedure POLCOF(XA, YA:array of real; N:integer; var COF:array of real);
var
    X, Y:array[0..15] of real;
    I,J,K:integer;
    XMIN,DY:real;
begin
    For J:=1 To N do
    begin
        X[J]:=XA[J];
        Y[J]:=YA[J];
    end;
    For J:=1 To N do
    begin
        POLINT(X, Y, N + 1 - J, 0, COF[J], DY);
        XMIN:=1E+38;
        K:=0;
        For I:=1 To N + 1 - J do
        begin
            If Abs(X[I]) < XMIN Then
            begin
                XMIN:=Abs(X[I]);
                K:=I;
            end;
            If X[I] <> 0 Then Y[I]:=(Y[I] - COF[J]) / X[I];
        end;
        If K < N + 1 - J Then
        begin
            For I:=K + 1 To N + 1 - J do
            begin
                Y[I - 1]:=Y[I];
                X[I - 1]:=X[I];
            end;
        end;
    end;
end;
end.