unit1.~pas

delphi语言实现的二次样条拟合离散样本程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label2: TLabel;
    Label6: TLabel;
    Label3: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Initial;
    procedure GetarrayH;
    procedure GetarrayC;
    procedure GetarrayD;
    procedure GetarrayDy;
    procedure Checkresult;

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x:     array of real;
  y:     array of real;
  n:     integer;
  c:     array of real;
  d:     array of real;
  h:     array of real;
  dy:    array of real;

  xx:    array of real;

implementation

{$R *.DFM}

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
   Close;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   Initial;
   GetarrayH;
   GetarrayC;
   GetarrayDy;
   GetarrayD;
   Checkresult;
end;

procedure TForm1.Initial;
var
   i: integer;
begin
   n := 10;
   Setlength(x,n);
   Setlength(y,n);
   Setlength(c,n);
   Setlength(d,n);
   Setlength(h,n);
   Setlength(dy,n);
   Setlength(xx,n);
   for i := 0 to n-1 do x[i] := i;
   y[0] := 5;
   y[1] := 2;
   y[2] := 8;
   y[3] := 4;
   y[4] := 9;
   y[5] := 3;
   y[6] := 6;
   y[7] := 1;
   y[8] := 10;
   y[9] := 7;
end;

procedure TForm1.GetarrayH;
var
   i: integer;
begin
   for i := 1 to n-1 do
       h[i] := x[i]-x[i-1];
end;

procedure TForm1.GetarrayC;
var
   i: integer;
begin
   for i := 1 to n-1 do
       c[i-1] := 2*(y[i]-y[i-1])/h[i];
end;

procedure TForm1.GetarrayDy;
var
   i: integer;
begin
   dy[0] := 0;
   for i := 1 to n-1 do
       dy[i] := c[i-1]-dy[i-1];
end;

procedure TForm1.GetarrayD;
var
   i: integer;
begin
   for i := 1 to n-1 do
       d[i] := y[i]-dy[i]*h[i]/2;
end;

procedure TForm1.Checkresult;
var
   i: integer;
   s: string;
begin
   xx[0] := -dy[0]*(x[1]-x[0])*(x[1]-x[0])/(2*h[1])+d[1];
   for i := 1 to n-1 do
       xx[i] := dy[i]*(x[i]-x[i-1])*(x[i]-x[i-1])/(2*h[i])+ d[i];
   s := '';
   for i := 0 to n-1 do
       s := s + format('%0.5f',[xx[i]]) + chr(13);
   showmessage(s);
end;

end.