unitlinearregress.pas

一个多元非线性回归分析源码以及其中的公式列表

        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[0,i]);
            x:=tan(x);
            self.VLE_Data.Cells[0,i]:=floattostr(x);
        end;
    end
    else if self.RadioButton2.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            x:=strtofloat(self.VLE_Data.Cells[1,i]);
            x:=tan(x);
            self.VLE_Data.Cells[1,i]:=floattostr(x);
        end;
    end
    else
    begin
        application.MessageBox('请先选定是针对x轴还是y轴进行计算。','提醒：',MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('Sin计算在计算第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.Button5Click(Sender: TObject);
var x       :double;
    i       :integer;
    n       :integer;
    DataOld :string;
begin
    n:=1;
    DataOld:=VLE_Data.Strings.Text;
  try
    if self.RadioButton1.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[0,i]);
            x:=arcsin(x);
            self.VLE_Data.Cells[0,i]:=floattostr(x);
        end;
    end
    else if self.RadioButton2.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            x:=strtofloat(self.VLE_Data.Cells[1,i]);
            x:=arcsin(x);
            self.VLE_Data.Cells[1,i]:=floattostr(x);
        end;
    end
    else
    begin
        application.MessageBox('请先选定是针对x轴还是y轴进行计算。','提醒：',MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('ArcSin计算在计算第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.Button7Click(Sender: TObject);
var x       :double;
    i       :integer;
    n       :integer;
    DataOld :string;
begin
    n:=1;
    DataOld:=VLE_Data.Strings.Text;
  try
    if self.RadioButton1.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[0,i]);
            x:=arccos(x);
            self.VLE_Data.Cells[0,i]:=floattostr(x);
        end;
    end
    else if self.RadioButton2.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            x:=strtofloat(self.VLE_Data.Cells[1,i]);
            x:=arccos(x);
            self.VLE_Data.Cells[1,i]:=floattostr(x);
        end;
    end
    else
    begin
        application.MessageBox('请先选定是针对x轴还是y轴进行计算。','提醒：',MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('ArcCos计算在计算第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.Button9Click(Sender: TObject);
var x       :double;
    i       :integer;
    n       :integer;
    DataOld :string;
begin
    n:=1;
    DataOld:=VLE_Data.Strings.Text;
  try
    if self.RadioButton1.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[0,i]);
            x:=Arctan(x);
            self.VLE_Data.Cells[0,i]:=floattostr(x);
        end;
    end
    else if self.RadioButton2.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            x:=strtofloat(self.VLE_Data.Cells[1,i]);
            x:=Arctan(x);
            self.VLE_Data.Cells[1,i]:=floattostr(x);
        end;
    end
    else
    begin
        application.MessageBox('请先选定是针对x轴还是y轴进行计算。','提醒：',MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('Arctg计算在计算第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.MuStartClick(Sender: TObject);
var Datax   :array of Double;
    Datay   :array of Double;
    XX      :TXX;

begin
  try
    self.Label6.Caption:='y=A+B*x';
    self.VLE_Data.TitleCaptions.Text:='           x'    
                                     +#13+#10
                                     +'           y';
    self.VLE_Data.Refresh;
    xx.n:=VLE_Data.RowCount-1;
    setlength(Datax,xx.n);
    setlength(Datay,xx.n);
    getVLEData(VLE_Data,Datax,Datay);

    Calculate(Datax,Datay,xx);

    self.ImgLine.Visible:=false;
    self.ImgLine.Canvas.FillRect(Rect(0,0,self.ImgLine.Width,self.ImgLine.Height));
    DarwPic(self.ImgLine,Datax,Datay,xx);
    self.ImgLine.Visible:=true;
    SetVLEData(VLE_Value,xx);
  except
    application.MessageBox(Pchar('计算时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmLR.xy1Click(Sender: TObject);
var strTemp :string;
    i       :integer;
    n       :integer;
    DataOld :string;
begin
    n:=1;
    DataOld:=VLE_Data.Strings.Text;
  try
    for i:=1 to self.VLE_Data.RowCount-1 do
    begin
        n:=i;
        strTemp:=self.VLE_Data.Cells[1,i];
        self.VLE_Data.Cells[1,i]:=self.VLE_Data.Cells[0,i];
        self.VLE_Data.Cells[0,i]:=strTemp;
    end;
  except
    application.MessageBox(Pchar('交换操作在第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.X1Click(Sender: TObject);
begin
    self.Close;
end;

procedure TfrmLR.Button12Click(Sender: TObject);
var x,y     :double;
    i       :integer;
    n       :integer;
    DataOld :string;
begin            
    n:=1;
    DataOld:=VLE_Data.Strings.Text;
  try
    if self.RadioButton1.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[0,i]);
            y:=strtofloat(self.Edit5.Text);
            x:=Power(y,x);
            self.VLE_Data.Cells[0,i]:=floattostr(x);
        end;
    end
    else if self.RadioButton2.Checked  then
    begin
        for i:=1 to self.VLE_Data.RowCount-1 do
        begin
            n:=i;
            x:=strtofloat(self.VLE_Data.Cells[1,i]);
            y:=strtofloat(self.Edit5.Text);
            x:=Power(y,x);
            self.VLE_Data.Cells[1,i]:=floattostr(x);
        end;
    end
    else
    begin
        application.MessageBox('请先选定是针对x轴还是y轴进行计算。','提醒：',MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('求指数计算在计算第'+inttostr(n)+'行数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.N3Click(Sender: TObject);
var strFName   :string;
begin
  try
    self.SaveDialog1.FileName:='';
    if self.SaveDialog1.Execute then
    begin
        strFName:=SaveDialog1.FileName;
        if SaveDialog1.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.TXT' then
                strFName:=strFName
            else
                strFName:=strFName+'.TXT';
        end 
        else if SaveDialog1.Filterindex=2 then
        begin
            strFName:=strFName;
        end;
        if FileExists(strFName) then
        begin
            if not ( application.MessageBox(pchar('文件 “'+strFName+'” 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;    
          DeleteFile(strFName);
        end;

        self.VLE_Data.Strings.SaveToFile(strFName)
    end;
  except
    application.MessageBox(Pchar('保存数据时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmLR.N2Click(Sender: TObject);
var DataOld :string;
begin
    DataOld:=VLE_Data.Strings.Text;
  try
    self.OpenDialog1.FileName:='';
    if self.OpenDialog1.Execute then
    begin
        if self.OpenDialog1.FileName<>'' then
        begin
            self.VLE_Data.Strings.LoadFromFile(self.OpenDialog1.FileName);
        end;
    end;
  except
    application.MessageBox(Pchar('打开文件时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.S1Click(Sender: TObject);
var jg          :Tjpegimage;
    strFName    :string;
    DBImagePIC  :Timage;
begin
    application.ProcessMessages;
    DBImagePIC:=self.ImgLine;
  try
    SavePictureDialog.FileName:='';
    if SavePictureDialog.Execute then
    begin
        strFName:=SavePictureDialog.FileName;
        if SavePictureDialog.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.BMP' then
                strFName:=strFName
            else
                strFName:=strFName+'.bmp';
        end 
        else if SavePictureDialog.Filterindex=2 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.JPG' then
                strFName:=strFName
            else
                strFName:=strFName+'.jpg';
        end
        else if SavePictureDialog.Filterindex=3 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.GIF' then
                strFName:=strFName
            else
                strFName:=strFName+'.gif';
        end
        else
            strFName:=strFName+'.bmp';
        if FileExists(strFName) then
        begin
            if not ( application.MessageBox(pchar('文件 “'+strFName+'” 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;     
          DeleteFile(strFName);
        end;
        if UpperCase(copy(strFName,length(strFName)-3,4))='.BMP' then
        begin
            DBImagePIC.Picture.Bitmap.SaveToFile(strFName);
        end
        else if UpperCase(copy(strFName,length(strFName)-3,4))='.JPG' then
        begin
            Jg := TJPEGImage.Create;
            jg.CompressionQuality:=82;
            jg.Assign(DBImagePIC.Picture.Bitmap);
            jg.SaveToFile(strFName);
            jg.Free;
        end
        else  if UpperCase(copy(strFName,length(strFName)-3,4))='.GIF' then
        begin
            Rx_To_GIF.Image.Assign(DBImagePIC.Picture.Bitmap);
            Rx_To_GIF.Image.SaveToFile(strFName);
        end;
        application.MessageBox(pchar('文件“'+strFName+'”保存完成！'),'说明：',MB_OK+MB_ICONINFORMATION);
    end;
  except
    application.MessageBox(Pchar('保存图形时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmLR.E1Click(Sender: TObject);
var strFName   :string;
begin
  try
    self.SaveDialog2.FileName:='';
    if self.SaveDialog2.Execute then
    begin
        strFName:=SaveDialog2.FileName;
        if SaveDialog2.Filterindex=1 then
        begin
            if UpperCase(copy(strFName,length(strFName)-3,4))='.TXT' then
                strFName:=strFName
            else
                strFName:=strFName+'.TXT';
        end 
        else if SaveDialog2.Filterindex=2 then
        begin
            strFName:=strFName;
        end;
        if FileExists(strFName) then
        begin
            if not ( application.MessageBox(pchar('文件 “'+strFName+'” 已经存在，要覆盖吗？'),'警告：',MB_OKCANCEL+MB_ICONWARNING)=IDOK )	 then
                exit;     
          DeleteFile(strFName);
        end;
        self.VLE_Value.Strings.SaveToFile(strFName);
    end;
  except
    application.MessageBox(Pchar('保存计算结果时出现错误。'),'出错：',MB_ICONERROR);
  end;
end;

procedure TfrmLR.N6Click(Sender: TObject);
begin
  try
     RunExe('帮助\'+'线性回归(最小二乘法).htm');
  except
  end;
end;

procedure TfrmLR.C1Click(Sender: TObject);
begin
    Clipboard.Clear;
    Clipboard.AsText:=self.VLE_Data.Strings.Text;
end;

procedure TfrmLR.V1Click(Sender: TObject);
var DataOld :string;
begin    
    DataOld:=VLE_Data.Strings.Text;
  try
    self.VLE_Data.Strings.Text:=Clipboard.AsText;
  except
    application.MessageBox(Pchar('粘贴实验数据时出现错误。'),'出错：',MB_ICONERROR);
    VLE_Data.Strings.Text:=DataOld;
  end;
end;

procedure TfrmLR.D1Click(Sender: TObject);
begin
    self.VLE_Data.Strings.Text:='';
end;

procedure TfrmLR.N7Click(Sender: TObject);
begin
  try
    if Application.FindComponent('frmAbout')=nil then
       Application.CreateForm(TfrmAbout, frmAbout);
    frmAbout.ShowModal;
  except
  end;
end;

procedure TfrmLR.E3Click(Sender: TObject);
begin
    Clipboard.Clear;
    Clipboard.AsText:=self.VLE_Value.Strings.Text;
end;

procedure TfrmLR.C3Click(Sender: TObject);
var
    MyFormat    : Word;
    AData       : THandle;
    APalette    : HPALETTE;
begin
    Clipboard.Clear;
    self.ImgLine.Picture.Bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);
    ClipBoard.SetAsHandle(MyFormat,AData);
end;

procedure TfrmLR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

end.