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

📄 unit1.pas

📁 Delphi 的数学控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Spin, Printers;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    GroupBox2: TGroupBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    GroupBox3: TGroupBox;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    LabeledEdit6: TLabeledEdit;
    LabeledEdit7: TLabeledEdit;
    LabeledEdit8: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    LabeledEdit9: TLabeledEdit;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    CheckBox1: TCheckBox;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    ColorBox1: TColorBox;
    Label4: TLabel;
    SpinEdit3: TSpinEdit;
    RadioGroup1: TRadioGroup;
    LabeledEdit10: TLabeledEdit;
    LabeledEdit11: TLabeledEdit;
    LabeledEdit12: TLabeledEdit;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  FMath, Matrices, Regress, Models, PaString, PlotVar, WinPlot;

var
  InFName      : String;      { Name of input file }
  OutFName     : String;      { Name of output file }
  Title        : String;      { Title of study }
  XName, YName : String;      { Names of variables }
  N            : Integer;     { Number of points }
  X, Y         : TVector;     { Point coordinates }
  RegModel     : Byte;        { Regression model }
  B            : TVector;     { Regression parameters }
  Calc         : Boolean;     { Calculation successful }
  CurvParam    : TCurvParam;  { Parameters for plotted curve }
  Npts         : Integer;     { Nb of points in plotted curve }

  function ReadInputFile(InFName                 : String;
                         var Title, XName, YName : String;
                         var N                   : Integer;
                         var X, Y                : TVector) : Integer;
{ ----------------------------------------------------------------------
  Reads an input file for linear or polynomial regression.
  The input file is an ASCII file with the following structure :

    Line 1 : Title of study
    Line 2 : Number of variables (must be 2 here !)
    Line 3 : Name of variable x
    Line 4 : Name of variable y
    Line 5 : Number of points (must be > number of fitted parameters !)

    The next lines contain the coordinates (x, y) of the points (1 point
    by line). The values of x and y must be separated by spaces or tabs.
  ---------------------------------------------------------------------- }
  var
    InF  : Text;     { Input file }
    Nvar : Integer;  { Number of variables }
    K    : Integer;  { Loop variable }
  begin
    Assign(InF, InFName);
    Reset(InF);

    ReadLn(InF, Title);
    ReadLn(InF, Nvar);

    if Nvar <> 2 then
      begin
        WriteLn('Data file must contain 2 variables !');
        ReadInputFile := - 1;
        Exit;
      end;

    ReadLn(InF, XName);
    ReadLn(InF, YName);
    ReadLn(InF, N);

    DimVector(X, N);
    DimVector(Y, N);

    for K := 1 to N do
      ReadLn(InF, X[K], Y[K]);

    Close(InF);
    ReadInputFile := 0;
  end;

  procedure UpdateAxes;
  { Update axis parameters and display them in the dialog boxes }
  begin
    AutoScale(X, 1, N, XAxis);
    AutoScale(Y, 1, N, YAxis);

    GraphTitle  := Title;
    XAxis.Title := XName;
    YAxis.Title := YName;

    with Form1 do
      begin
        LabeledEdit1.Text := FloatToStr(XAxis.Min);
        LabeledEdit2.Text := FloatToStr(XAxis.Max);
        LabeledEdit3.Text := FloatToStr(XAxis.Step);

        LabeledEdit4.Text := FloatToStr(YAxis.Min);
        LabeledEdit5.Text := FloatToStr(YAxis.Max);
        LabeledEdit6.Text := FloatToStr(YAxis.Step);

        LabeledEdit7.Text := XAxis.Title;
        LabeledEdit8.Text := YAxis.Title;
        LabeledEdit9.Text := GraphTitle;
      end;
  end;

  procedure TForm1.Button1Click(Sender: TObject);
  { Read data file }
  begin
    if OpenDialog1.Execute then
      begin
        InFName := OpenDialog1.FileName;
        if ReadInputFile(InFName, Title, XName, YName, N, X, Y) = 0 then
          UpdateAxes
        else
          MessageDlg('Error reading file ' + InFName, mtError, [mbOk], 0);
      end;
  end;

  procedure TForm1.ComboBox1Change(Sender: TObject);
  begin
    case ComboBox1.ItemIndex of
      0 : RegModel := REG_LIN;
      1 : RegModel := REG_POL;
      2 : RegModel := REG_FRAC;
      3 : RegModel := REG_EXPO;
      4 : RegModel := REG_IEXPO;
      5 : RegModel := REG_EXLIN;
      6 : RegModel := REG_POWER;
      7 : RegModel := REG_MICH;
      8 : RegModel := REG_MINT;
      9 : RegModel := REG_HILL;
     10 : RegModel := REG_LOGIS;
     11 : RegModel := REG_PKA;
    end;

    Label1.Visible := (RegModel in [REG_POL, REG_FRAC, REG_EXPO]);
    Label2.Visible := (RegModel = REG_FRAC);

    SpinEdit1.Visible := Label1.Visible;
    SpinEdit2.Visible := Label2.Visible;

    CheckBox1.Visible := (RegModel in [REG_FRAC, REG_EXPO, REG_IEXPO, REG_LOGIS]);
    CheckBox3.Visible := (RegModel = REG_LOGIS);

    RadioGroup1.Visible := (RegModel = REG_MINT);
    LabeledEdit10.Visible := RadioGroup1.Visible;
    LabeledEdit11.Visible := RadioGroup1.Visible;
    LabeledEdit12.Visible := RadioGroup1.Visible;
    CheckBox2.Visible := RadioGroup1.Visible;

    case RegModel of
      REG_POL  : Label1.Caption := 'Degree of polynomial';
      REG_FRAC : begin
                   Label1.Caption := 'Degree of numerator';
                   Label2.Caption := 'Degree of denominator';
                 end;
      REG_EXPO : Label1.Caption := 'Number of exponentials';
    end;
  end;

  procedure TForm1.RadioGroup1Click(Sender: TObject);
  var
    L1, L2 : string[2];
  begin
    case RadioGroup1.ItemIndex of
      0 : begin
            L1 := 's0';
            L2 := 'e0';
          end;
      1 : begin
            L1 := 'e0';
            L2 := 'T ';
          end;
      2 : begin
            L1 := 's0';
            L2 := 'T ';
          end;
    end;
    LabeledEdit10.EditLabel.Caption := L1;
    LabeledEdit11.EditLabel.Caption := L2;
  end;

  procedure WriteOutputFile(InFName             : String;
                            var OutFName        : String;
                            Title, XName, YName : String;
                            N                   : Integer;
                            Y, Ycalc, S, B      : TVector;
                            V                   : TMatrix;
                            Test                : TRegTest);
{ ----------------------------------------------------------------------
  Writes the result of the regression to an output file
  ---------------------------------------------------------------------- }
  var
    OutF     : Text;     { Output file }
    Line1,
    Line2    : String;   { Separating lines }
    Sr       : Float;    { Residual standard deviation }
    Delta    : Float;    { Residual }
    SB       : TVector;  { Standard deviations of parameters }
    T        : TVector;  { Student's t }
    Prob     : TVector;  { Probabilities }
    I, K     : Integer;  { Loop variables }
  begin
    DimVector(SB, LastParam);
    DimVector(T, LastParam);
    DimVector(Prob, LastParam);

    K := Pos('.', InFName);
    OutFName := Copy(InFName, 1, Pred(K)) + '.out';
    Assign(OutF, OutFName);
    Rewrite(OutF);

    Line1 := StrChar(73, '-');
    Line2 := StrChar(73, '=');

⌨️ 快捷键说明

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