arraytest.~pas

灰色系统预测模型以及建模

unit ArrayTest;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  RawDataArray, DealDataArray, YNDataArray, EquationValueArray: array of double;
  DataPlanarArray,ReverseDtPlanarArray: array of array of double;
  BTBArray, ReverseBTBArray: array[1..2, 1..2] of double;
  BTYArray, ParameterVector: array[1..2] of double;
  ArrayNum, tmpInt, i, j, k: integer;
  InputStr, tmpStr: string;
  DataPlanarArrayValue: double;
  AValue,BValue,CValue:double;
begin
  ArrayNum := 0;
  InputStr := Edit1.Text;
  if length(InputStr)=0 then
  begin
    showmessage('请输入数据序列!');
    exit;
  end;
  if InputStr[length(InputStr)]<>',' then
  begin
    showmessage('输入不合法，请重新输入！');
    exit;
  end;
  for i := 1 to length(InputStr) do
  begin
    if InputStr[i] = ',' then
      inc(ArrayNum);
  end;
  SetLength(RawDataArray, ArrayNum + 1); //数组初始化
  SetLength(DealDataArray, ArrayNum + 1);
  SetLength(DataPlanarArray, ArrayNum); //二维数组初始化
  SetLength(ReverseDtPlanarArray,3);
  //SetLength(RawDataArray, ArrayNum - 1);
  SetLength(YNDataArray, ArrayNum);
  SetLength(EquationValueArray, ArrayNum+1);
  for i := 0 to ArrayNum-1 do
    SetLength(DataPlanarArray[i], 3);
  for i:=0 to 2 do
    SetLength(ReverseDtPlanarArray[i], ArrayNum);
  k := 0;
  tmpInt := 0;
  i := 1;
  for j := k to length(InputStr) do
  begin
    if InputStr[j] = ',' then
    begin
      tmpStr := copy(InputStr, tmpInt + 1, j - tmpInt - 1);
      tmpInt := j;
      try
      RawDataArray[i] := StrToFloat(tmpStr);
      except
         showmessage('输入不合法，请重新输入！');
         exit;
      end;
      inc(i);
      //k := j;
    end;
  end;
  for i := 1 to ArrayNum - 1 do
    DealDataArray[i] := 0;
  for i := 1 to ArrayNum do
    for j := 1 to i do
      DealDataArray[i] := DealDataArray[i] + RawDataArray[j];
  for i := 1 to ArrayNum - 1 do
    DataPlanarArray[i][1] := -0.5 * (DealDataArray[i] + DealDataArray[i + 1]);
  for i := 1 to ArrayNum - 1 do
    DataPlanarArray[i][2] := 1;

  for i:=1 to  ArrayNum - 1 do
    ReverseDtPlanarArray[1][i] :=DataPlanarArray[i][1];

  for i:=1 to  ArrayNum - 1 do
    ReverseDtPlanarArray[2][i] :=1;

  for i := 1 to ArrayNum - 1 do
    YNDataArray[i] := RawDataArray[i + 1];
  for i := 1 to 2 do
    for j := 1 to 2 do
      BTBArray[i][j] := 0;
  for i := 1 to 2 do
    for j := 1 to 2 do
      for k := 1 to ArrayNum - 1 do
      begin
        DataPlanarArrayValue := DataPlanarArray[i][k];
        BTBArray[i][j] := BTBArray[i][j] + DataPlanarArray[k][i] *
          ReverseDtPlanarArray[j][k];
      end;
  DataPlanarArrayValue := BTBArray[1][1] * BTBArray[2][2] -
    BTBArray[1][2] * BTBArray[2][1];
  ReverseBTBArray[1][1] := BTBArray[2][2] / DataPlanarArrayValue;
  ReverseBTBArray[1][2] := -BTBArray[2][1] / DataPlanarArrayValue;
  ReverseBTBArray[2][1] := -BTBArray[1][2] / DataPlanarArrayValue;
  ReverseBTBArray[2][2] := BTBArray[1][1] / DataPlanarArrayValue;
  for i := 1 to 2 do
  begin
    BTYArray[i]:=0;
    for j := 1 to ArrayNum - 1 do
      BTYArray[i] := BTYArray[i]+ReverseDtPlanarArray[i][j] * YNDataArray[j];
  end;
  for i := 1 to 2 do
  begin
    ParameterVector[i] := 0;
    for j := 1 to 2 do
      ParameterVector[i] := ParameterVector[i] + ReverseBTBArray[i][j] *
        BTYArray[j];
  end;
  AValue := ParameterVector[1];
  BValue := RawDataArray[1]- ParameterVector[2]/ParameterVector[1];
  CValue := ParameterVector[2]/ParameterVector[1];
  if ParameterVector[1] = 0 then
    showmessage('计算有误');
  {for i := 1 to ArrayNum - 1 do
    EquationValueArray[i + 1] :=  BValue *Exp(-AValue*i) + CValue;  }
  Label3.Caption := FloatToStr(BValue)+'*EXP('+FloatToStr(-AValue)+'k)'+ FloatToStr(CValue)+'（k=0,1,2,...）';
  Label4.Caption :='其中:a为'+FloatToStr(AValue)+';'+'u为'+FloatToStr(ParameterVector[2])+';b为'+FloatToStr(BValue)+';c为'+FloatToStr(CValue);
  Label2.Visible :=true;
  Label3.Visible :=true;
  Label4.Visible :=true;
end;

end.