d8r12.txt

《Delphi常用数值算法集》的配书源码

implementation
//PROGRAM D8R12
//Driver for routine QROOTS
uses
  unit2;
  {$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
const
  s1='%14.6f';  s2='0';
  N = 7; NTRY = 10; EPS = 0.000001; TINY = 0.00001;
var
  F:TextFile;
  P:array[0..7] of real; B,C:array[0..10] of real;
  I,J,IFLAG,NROOT,NFLAG:integer;   AAA,BBB:real;
begin
  P[1]:=10;  P[2]:=-18;  P[3]:=25;  P[4]:=-24;  P[5]:=16;
  P[6]:=-6;  P[7]:=1;
  //输出计算结果到文件
  AssignFile(F, 'd:\delphi_shu\p8\d8r12.dat');
  Rewrite(F);
  Writeln(F, 'P(x)=x^6-6x^5+16x^4-24x^3+25x^2-18x+10');
  Writeln(F);
  Writeln(F, 'Quadratic factors x^2+Bx+C');
  Writeln(F);
  Writeln(F, '    Factor       B             C');
  NROOT:= 0;
  For I:= 1 To NTRY do
  begin
    C[I]:=0.5 * I;
    B[I]:=-0.5 * I;
    QROOT(P, N, B[I], C[I], EPS);
    If NROOT = 0 Then
    begin
      Writeln(F,'       ',FormatFloat(s2,NROOT),Format(s1,[B[I]]),
                          Format(s1,[C[I]]));
      NROOT:=1;
    end
    Else
    begin
      NFLAG:=0;
      For J:=1 To NROOT do
      begin
        AAA:=Abs(B[I] - B[J]);
        BBB:=Abs(C[I] - C[J]);
        If (AAA < TINY) And (BBB < TINY) Then NFLAG:=1;
      end;
      If NFLAG = 0 Then
      begin
        Writeln(F, '      ',FormatFloat(s2,NROOT),Format(s1,[B[I]]),
                          Format(s1,[C[I]]));
        NROOT:=NROOT + 1;
      end;
    end;
  end;
  CloseFile(F);
  //屏幕显示计算结果
  memo1.Lines.LoadFromFile('d:\delphi_shu\p8\d8r12.dat');
end;