main.pas

最小二乘法拟合 最小二乘法拟合 最小二乘法拟合

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sgr_def, sgr_data, Grids, ToolWin, ComCtrls, Menus, ImgList,
  StdCtrls, Spin;

type
  TMyData = record
    N:byte;
    x,y:array[1..20] of real;
  end;
  TMainForm = class(TForm)
    StatusBar: TStatusBar;
    ToolBar: TToolBar;
    sg: TStringGrid;
    sp_XYPlot: Tsp_XYPlot;
    sp_XYLine1: Tsp_XYLine;
    sp_XYLine2: Tsp_XYLine;
    ImageList: TImageList;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    SaveAs1: TMenuItem;
    Close1: TMenuItem;
    Edit1: TMenuItem;
    Fit1: TMenuItem;
    Picture1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    se: TSpinEdit;
    Label1: TLabel;
    od: TOpenDialog;
    sd: TSaveDialog;
    rb1: TRadioButton;
    rb2: TRadioButton;
    open: TButton;
    save: TButton;
    fit: TButton;
    picture: TButton;
    LineStyle1: TMenuItem;
    line1: TMenuItem;
    line2: TMenuItem;
    AvailableDigits1: TMenuItem;
    N4digits1: TMenuItem;
    N6digits1: TMenuItem;
    N8digits1: TMenuItem;
    procedure seChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure SaveClick(Sender: TObject);
    procedure OpenClick(Sender: TObject);
    procedure FitClick(Sender: TObject);
    procedure PictureClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure line1Click(Sender: TObject);
    procedure line2Click(Sender: TObject);
    procedure rb2Click(Sender: TObject);
    procedure rb1Click(Sender: TObject);
    procedure N4digits1Click(Sender: TObject);
    procedure N6digits1Click(Sender: TObject);
    procedure N8digits1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  MyData: TMyData;
  F: file of TMyData;
  Pathname: String;
  x1,x2,x3: real;

implementation

{$R *.dfm}

procedure TMainForm.seChange(Sender: TObject);
var
  i: byte;
begin
  sg.RowCount:=se.Value+1;
  if se.Value>10 then
    sg.Width:=256
  else sg.Width:=241;
  for i:=1 to se.Value do
    sg.Cells[0,i]:=IntToStr(i);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  sg.Cells[1,0]:='Xi';
  sg.Cells[2,0]:='Yi';
  sg.Cells[3,0]:='Yi*';
  Pathname:=ExtractFilePath(application.ExeName);
end;

procedure TMainForm.Close1Click(Sender: TObject);
begin
  close;
end;

procedure TMainForm.SaveClick(Sender: TObject);
var
  i:byte;
begin
  sd.InitialDir:=pathname;
  if sd.Execute then
  begin
    if sd.FilterIndex=1 then
    if pos('.dat',sd.FileName)=0 then
      sd.FileName:=sd.FileName+'.dat';
    with MyData do
    begin
      N:=sg.RowCount-1;
      for i:=1 to N do
      begin
        x[i]:=strtofloat(sg.Cells[1,i]);
        y[i]:=strtofloat(sg.Cells[2,i]);
      end;
      assignfile(F,sd.FileName);
      rewrite(f);
      write(f,MyData);
      mainform.Caption:='MainForm '+sd.FileName;
      fit.Enabled:=true;
      closefile(f);
    end;
  end;
end;

procedure TMainForm.OpenClick(Sender: TObject);
var
  i:byte;
begin
  od.InitialDir:=pathname;
  if od.Execute then
  begin
    assignfile(f,od.FileName);
    reset(f);
    read(f,MyData);
    closefile(f);
    mainform.Caption:='MainForm '+od.FileName;
    with MyData do
    for i:=1 to N do
    begin
      sg.cells[1,i]:=FloatToStr(X[i]);
      sg.cells[2,i]:=FloatToStr(Y[i]);
      sg.Cells[3,i]:='';
    end;
    sg.RowCount:=MyData.N+1;
    se.Value:=MyData.N;
    fit.Enabled:=true;
    fit1.Enabled:=true;
  end;
end;

procedure TMainForm.FitClick(Sender: TObject);
var
  i:integer;
  a11,a12,a13,a21,a22,a23,a31,a32,a33,b1,b2,b3:real;

begin
  with Mydata do
  begin
    N:=sg.RowCount-1;    //在没有存取数据时直接拟合绘图前的条件；
    a11:=0;a12:=0;a21:=0;a22:=0;b1:=0;b2:=0;

    for i:=1 to N do
    begin
      if sg.Cells[1,i]<>'' then
        x[i]:=StrToFloat(sg.cells[1,i])
      else  begin
        showmessage('There is a blank cell!');
        close;
      end;
      if sg.Cells[1,i]<>'' then
        y[i]:=StrToFloat(sg.cells[2,i])
      else  begin
        showmessage('There is a blank cell!');
        close;
      end;   //这里将老师的两句代码合为一起，简化程序；

      a11:=a11+1;
      a12:=a12+x[i];
      b1:=b1+y[i];
      a22:=a22+x[i]*x[i];
      b2:=b2+x[i]*y[i];
      if rb2.Checked=true then
      begin
        a13:=a22;
        a23:=a23+x[i]*x[i]*x[i];
        a31:=a13;
        a32:=a23;
        a33:=a33+x[i]*x[i]*x[i]*x[i];
        b3:=b3+x[i]*x[i]*y[i];
      end;
    end;
      a21:=a12;

    if rb1.Checked=true then
    begin
      x1:=(b1*a22-b2*a12)/(a11*a22-a21*a12);
      x2:=(a11*b2-b1*a21)/(a11*a22-a21*a12);
      if N4digits1.Checked=true then
      begin
        x1:=trunc(x1*10000)/10000;
        x2:=trunc(x2*10000)/10000;
      end
        else if N6digits1.Checked=true then
        begin
          x1:=trunc(x1*1000000)/1000000;
          x2:=trunc(x2*1000000)/1000000;
        end
          else begin
            x1:=trunc(x1*100000000)/100000000;
            x2:=trunc(x2*100000000)/100000000;
          end;
      label1.caption:='Y = '+FloatToSTr(x1)+' + '+FloatToSTr(x2)+' * X';
      for i:=1 to N do
        sg.Cells[3,i]:=floattostr(x1+x2*x[i]);

    end
    else if rb2.Checked=true then
    begin
      x1:=(b1*a22*a33+a12*a23*b3+a13*b2*a32-b1*a23*a32-a12*b2*a33-a13*a22*b3)/(a11*a22*a33+a12*a23*a31+a13*a21*a32-a11*a23*a32-a12*a21*a33-a13*a22*a31);
      x2:=(a11*b2*a33+b1*a23*a31+a13*a21*b3-a11*a23*b3-b1*a21*a33-a13*b2*a31)/(a11*a22*a33+a12*a23*a31+a13*a21*a32-a11*a23*a32-a12*a21*a33-a13*a22*a31);
      x3:=(a11*a22*b3+a12*b2*a31+b1*a21*a32-a11*b2*a32-a12*a21*b3-b1*a22*a31)/(a11*a22*a33+a12*a23*a31+a13*a21*a32-a11*a23*a32-a12*a21*a33-a13*a22*a31);
      if N4digits1.Checked=true then
      begin
        x1:=trunc(x1*10000)/10000;
        x2:=trunc(x2*10000)/10000;
        x3:=trunc(x3*10000)/10000;
      end
        else if N6digits1.Checked=true then
        begin
          x1:=trunc(x1*1000000)/1000000;
          x2:=trunc(x2*1000000)/1000000;
          x3:=trunc(x3*1000000)/1000000;
        end
          else begin
            x1:=trunc(x1*100000000)/100000000;
            x2:=trunc(x2*100000000)/100000000;
            x3:=trunc(x3*100000000)/100000000;
          end;
      label1.caption:='Y = '+FloatToSTr(x1)+' + '+FloatToSTr(x2)+' * X '+' + '+FloatToSTr(x3)+' * X^2';
      for i:=1 to N do
        sg.Cells[3,i]:=floattostr(x1+x2*x[i]+x3*x[i]*x[i]);
    end;


  end;


  picture.Enabled:=true;
  picture1.Enabled:=true;    //这样只有拟合完成之后才能实现绘图；
end;

procedure TMainForm.PictureClick(Sender: TObject);
var
  i,j:byte;
  x0:real;
begin
  sp_xyline1.Clear;
  sp_xyline2.Clear;

  with MyData do
  begin
    for i:=1 to N do
      sp_xyline1.AddXY(x[i],y[i]);
    if rb1.Checked=true then
    begin
      statusbar.panels[1].Text:=' Y = A + B * X';
      x0:=x[1];
      sp_xyline2.AddXY(x0,x1+x2*x0);
      x0:=x[N];
      sp_xyline2.AddXY(X0,x1+x2*X0);
    end
    else if rb2.Checked=true then
    begin
      for j:=0 to 10 do
      begin
        x0:=x[N]-j*(x[N]-x[1])/10+1;
        sp_xyline2.AddXY(x0,x1+x2*x0+x3*x0*x0);
      end;
    end;
  end;

end;

procedure TMainForm.About1Click(Sender: TObject);
begin
  ShowMessage('The program is developed by Hu Chao and his group. Welcome to contract us: [e-mail].')
end;

procedure TMainForm.line1Click(Sender: TObject);
begin
  line1.Checked:=true;
  rb1.Checked:=true;
end;

procedure TMainForm.line2Click(Sender: TObject);
begin
  line1.Checked:=false;
  line2.Checked:=true;
  rb2.Checked:=true;
end;

procedure TMainForm.rb2Click(Sender: TObject);
begin
  statusbar.panels[1].Text:=' Y = A + B * X + C * X^2';
end;

procedure TMainForm.rb1Click(Sender: TObject);
begin
  statusbar.Panels[1].Text:=' Y = A + B * X';
end;

procedure TMainForm.N4digits1Click(Sender: TObject);
begin
  N6digits1.Checked:=false;
  N8digits1.Checked:=false;
  N4digits1.Checked:=true;
end;

procedure TMainForm.N6digits1Click(Sender: TObject);
begin
  N4digits1.Checked:=false;
  N8digits1.Checked:=false;
  N6digits1.checked:=true;
end;

procedure TMainForm.N8digits1Click(Sender: TObject);
begin
  N4digits1.Checked:=false;
  N6digits1.Checked:=false;
  N8digits1.checked:=true;
end;

end.