⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 Delphi Pascal 数据挖掘领域算法包 回归分析
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, Grids, ExtCtrls, StdCtrls, ComCtrls, TeEngine, Series,
  TeeProcs, Chart, RegComp;

const  NUM_OF_OBS = 40;

type

  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ExitBtn: TSpeedButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    StringGrid1: TStringGrid;
    TabSheet2: TTabSheet;
    Chart1: TChart;
    RegCalcBtn: TSpeedButton;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Series4: TPointSeries;
    RegComp1: TRegComp;
    RadioGroup1: TRadioGroup;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Series1: TLineSeries;
    Series2: TLineSeries;
    Series3: TLineSeries;
    Series6: TLineSeries;
    Series5: TLineSeries;
    procedure RegCalcBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure SetStatusBarText(s: string);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private
    { Private declarations }
  public
    BVStatRec   : TBivarStatRec;   // Returns summary stats from proc
    Resids      : TResidualsArray;
    X,Y         : TResidualsArray;
    CIUpper     : TResidualsArray;
    CILower     : TResidualsArray; // For Conf Interval values
    IsFirstShow : boolean;
    AnInterval  : TIntervalRec;
  end;


var Form1: TForm1;

implementation

uses Unit2, Unit3, Math;

{$R *.DFM}

procedure TForm1.SetStatusBarText(s: string);
begin
  with StatusBar1 do
  begin
    SimpleText:= s;
    Refresh;
  end;
end;

procedure TForm1.RegCalcBtnClick(Sender: TObject);
var
  sOut,astr   : string;
  i,j         : integer;
  AIntRec     : TIntervalRec;
  Lower,Upper : extended;
  f           : textfile;
begin

  with RadioGroup1 do
  begin
    if (ItemIndex = 0) then
      RegComp1.AlphaLevel:= 99
    else if (ItemIndex = 1) then
      RegComp1.AlphaLevel:= 95
    else
      RegComp1.AlphaLevel:= 90;
  end;

  SetStatusBarText('Executing BivarRegression...');
  BVStatRec:= RegComp1.BVRegression(X,Y,NUM_OF_OBS);
  RegComp1.BVPredictedY(X,Y,Resids,NUM_OF_OBS);

  with BVStatRec do begin
    sOut:= 'Regression Summary' + #13;
    sOut:= 'R, R2: ' + FormatFloat('0.00',R) + ' ' + #13;
    sOut:= sOut + 'n     : ' + IntToStr(n) + #13 + #13;
    sOut:= sOut + 'Beta0 : ' + FloatToStr(Beta0) + #13;
    sOut:= sOut + 'Beta1 : ' + FloatToStr(Beta1) + #13;
  end;

  Chart1.Series[0].Clear;
  Chart1.Series[1].Clear;
  Chart1.Series[2].Clear;
  Chart1.Series[3].Clear;
  Chart1.Series[4].Clear;
  Chart1.Series[5].Clear;

  Chart1.Enabled:= FALSE;
  if (CheckBox1.Checked) then begin
    for i:= 0 to NUM_OF_OBS-1 do begin
      aIntRec:= RegComp1.BVRegressionCI (BVStatRec,Resids[i],X[i]);
      Chart1.Series[0].Add (aIntRec.Upper,'',clRed);
      Chart1.Series[1].Add (aIntRec.Lower,'',clRed);
    end;
  end;

  if (CheckBox2.Checked) then begin
    for i:= 0 to NUM_OF_OBS-1 do begin
      aIntRec:= RegComp1.BVRegressionPI (BVStatRec,Resids[i],X[i]);
      Chart1.Series[4].Add (aIntRec.Upper,'',clRed);
      Chart1.Series[5].Add (aIntRec.Lower,'',clRed);
    end;
  end;

  if (CheckBox3.Checked) then begin
    for i:= 0 to NUM_OF_OBS-1 do begin
      Chart1.Series[2].Add (Resids[i],'',clLime);
      Chart1.Series[3].Add (Y[i],'',clGreen);
   end;
  end;

  Chart1.Enabled:= TRUE;
  IsFirstShow:= FALSE;
  SetStatusBarText('<Done>');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j: integer;
begin
  Randomize;
  IsFirstShow:= TRUE;

  // Generate some bogus numbers for the input data arrays...
  screen.cursor:= crHourglass;
  for i:= 0 to NUM_OF_OBS-1 do
    X[i]:= i;

  for j:= 0 to NUM_OF_OBS-1 do  // data array (ANOVAData)
    Y[j]:= randG(40,20) + random(j);

  for i:= 0 to NUM_OF_OBS do
    StringGrid1.Cells[2,i+1]:= FloatToStr(Y[i]);

  for i:= 0 to NUM_OF_OBS-1 do
    StringGrid1.Cells[1,i+1]:= FloatToStr(X[i]);

  StringGrid1.Cells[1,0]:= 'X';
  StringGrid1.Cells[2,0]:= 'Y';
  for i:= 1 to NUM_OF_OBS do
    StringGrid1.Cells[0,i]:= 'Obs: ' + IntToStr(i);

  screen.cursor:= crDefault;
  SetStatusBarText('<Done>');
end;

procedure TForm1.ExitBtnClick(Sender: TObject);
begin
  close;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  IntRec: TIntervalRec;
  i: word;
begin
  Chart1.Enabled:= FALSE;
  Chart1.Series[0].Clear;
  Chart1.Series[1].Clear;
  Chart1.Series[2].Clear;
  Chart1.Series[3].Clear;
  Chart1.Series[4].Clear;
  Chart1.Series[5].Clear;

  for i:= 0 to NUM_OF_OBS-1 do
  begin
    IntRec:= RegComp1.BVRegressionPI (BVStatRec,Resids[i],X[i]);
    Chart1.Series[0].Add (IntRec.Upper,'',clYellow);
    Chart1.series[1].Add (IntRec.Lower,'',clYellow);
  end;

  Chart1.Enabled:= TRUE;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  IntRec: TIntervalRec;
  i: word;
begin
  Chart1.Enabled:= FALSE;
  Chart1.Series[0].Clear;
  Chart1.Series[1].Clear;
  Chart1.Series[2].Clear;
  Chart1.Series[3].Clear;
  Chart1.Series[4].Clear;
  Chart1.Series[5].Clear;

  for i:= 0 to NUM_OF_OBS-1 do begin
    IntRec:= RegComp1.BVRegressionCI (BVStatRec,Resids[i],X[i]);
    Chart1.Series[4].Add (IntRec.Upper,'',clLime);
    Chart1.Series[5].Add (IntRec.Lower,'',clLime);
  end;

  Chart1.Refresh;
  Chart1.Enabled:= TRUE;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
  i : word;
begin
  Chart1.Enabled:= FALSE;
  Chart1.Series[0].Clear;
  Chart1.Series[1].Clear;
  Chart1.Series[2].Clear;
  Chart1.Series[3].Clear;
  Chart1.Series[4].Clear;
  Chart1.Series[5].Clear;

  for i:= 0 to NUM_OF_OBS-1 do begin
    Chart1.Series[2].Add (Resids[i],'',clRed);
    Chart1.Series[3].Add (Y[i],'',clGreen);
  end;

  Chart1.Enabled:= TRUE;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
  aBVSRec : TBivarStatRec;
begin
  SetStatusBarText('Executing BivarRegression...');
  aBVSRec:= RegComp1.BVRegression(X,Y,NUM_OF_OBS);

  with Memo1 do begin
    Lines.Clear;
    Lines.Add('r          : ' + FloatToStr(aBVSRec.r));
    Lines.Add('n          : ' + IntToStr(aBVSRec.n));
    Lines.Add('Intercept  : ' + FloatToSTr(aBVSRec.Beta0));
    Lines.Add('Slope      : ' + FloatToStr(aBVSRec.Beta1));
    Lines.Add('MeanX      : ' + FloatToStr(aBVSRec.XMean));
    Lines.Add('MeanY      : ' + FloatToStr(aBVSRec.YMean));
  end;

  Memo1.Refresh;
  SetStatusBarText('Done.');
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -