qroot.txt

最近开发的,比较使用,曲线拟合,谢谢下载 ,没问题

Procedure QROOT(P:array of real; N:integer; var B, C:real; EPS:real);
const
    ITMAX = 20;  TINY = 0.000001;
var
    Q,REM1,QQ:array[0..20] of real; D:array[0..3] of real;
    ITER,I:integer;  S,SB,RB,R,SC,RC,DIV1,DELB,DELC,DB,DC:real;
begin 
    D[3]:=1; 
    For ITER:=1 To ITMAX do
    begin
        D[2]:=B;
        D[1]:=C;
        POLDIV(P, N, D, 3, Q, REM1);
        S:=REM1[1];
        R:=REM1[2];
        POLDIV(Q, N - 1, D, 3, QQ, REM1);
        SC:=-REM1[1];
        RC:=-REM1[2];
        For I:=N - 1 DownTo 1 do
            Q[I + 1]:=Q[I];
        Q[1]:=0; 
        POLDIV(Q, N, D, 3, QQ, REM1);
        SB:=-REM1[1];
        RB:=-REM1[2];
        DIV1:=1 / (SB * RC - SC * RB);
        DELB:=(R * SC - S * RC) * DIV1;
        DELC:=(-R * SB + S * RB) * DIV1;
        B:=B + DELB;
        C:=C + DELC;
        DB:=Abs(DELB) - EPS * Abs(B);
        DC:=Abs(DELC) - EPS * Abs(C);
        If (DB<=0) Or (Abs(B)<TINY) And (DC<=0) Or (Abs(C)<TINY) Then
            Exit;
    end; 
    ShowMessage('too many iterations in QROOT');
end;