unit1.~pas

采用Grubbs方式实现粗大误差的剔除.源码中包含一个自定义长度的数组.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,math,Uarrays, Coolbtn2;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    CoolButton21: TCoolButton2;
    Edit2: TEdit;
    Button2: TButton;
    R1: TRadioButton;
    R2: TRadioButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CoolButton21Click(Sender: TObject);
  private
    { Private declarations }
  public
    Procedure deleteX(A:  double ) ;
    { Public declarations }
  end;

var
  Form1: TForm1;
  k:double;  DA:TDoubleArray; Idx:Integer;
implementation

{$R *.dfm}

Function xxx(A: array of double):string;
var i:integer;
begin
  for i:=0 to high(A) do
  result:=result+floattostr(A[i])+#13#10;
end;


procedure SortTo(SrcA: array of double; var DstA: array of double);
var
  I, J: Integer;      T  :Double;
begin
  for I := High(SrcA) downto Low(SrcA) do DstA[i]:=SrcA[i];
  for I := High(DstA) downto Low(DstA) do begin

    for J := Low(DstA) to High(DstA) - 1 do
      if DstA[J] > DstA[J + 1] then
      begin
        T := DstA[J];
        DstA[J] := DstA[J + 1];
        DstA[J + 1] := T;
      end;

 end;
end;

Function GetP(N:integer):Integer;
begin
   if odd(N) then result:=(N+1) div 2
             else result:= N div 2;
end;

Procedure MakeSA(A:array of double; var SA:  array of double ) ;
 var  i:integer;  T:double;
begin

 T:=0;
 for i:=low(A)  to  high(A) do begin
      T:= T+A[i];
      SA[i]:=T;
 end;
end;


Function MaxIsErr(RA:array of double; X,maxp:double;p:integer):Boolean;
   var T:double;  N:integer;
begin
   N:=high(RA)+1;
   T:=X+k*maxp/(N-p);
   Result:=   (RA[N-1]< X) or( RA[N-1] > T)  ;
end;

Function MinIsErr(RA:array of double; X,maxp:double;p:integer):Boolean;
   var T:double;
begin

   T:=X-k*maxp/p;
   Result:=   (RA[0]> X) or( RA[0] < T)  ;
end;




procedure TForm1.SpeedButton1Click(Sender: TObject);
 var RA,sortA,SA:array of double;
  N, p, i:integer; X, MaxP:double;
begin
memo4.Clear;  k:=strtofloat(edit1.Text);

  N:= memo1.Lines.Count ;
  setlength(RA,N);  setlength(SA,N);   setlength(sortA,N);
  for i:=0 to N -1 do begin
     RA[i]:=strtofloat(memo1.Lines[i]);
  end;
  SORTto(RA,sortA);         memo2.text:= xxx(sortA);
  makeSA(sortA,SA);    memo3.text:= xxx(SA);
  p:=Getp(N);   X:= Mean(RA);    memo4.Lines.Add(floattostr(p)) ;     memo4.Lines.Add(floattostr(x)) ;
  Maxp:=abs(SA[p-1]- X* p);   memo4.Lines.Add(floattostr(maxp)) ;

  if MinIsErr(sortA,X,maxp,P) then begin
    memo4.Lines.Add('最小值是异常数据') ;
    deleteX(sortA[0]);
  end;
  if MaxIsErr(sortA,X,maxp,P) then begin
    memo4.Lines.Add('最大值是异常数据') ;
    deleteX(sortA[N-1]);
  end;


end;

 const aa:array[0..19]of double=
 (20.002,20.000,20.000,20.001,20.000,
  19.998,19.998,20.000,20.001,19.998,
  20.002,20.002,20.000,20.004,20.000,
  20.002,19.992,19.998,20.002,19.998);

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
   memo1.Clear;
   for i:=0 to 19 do
    memo1.Lines.add(floattostr(aa[i]));
end;

procedure TForm1.deleteX(A: double);
 var s:string;   i:integer;
begin
  s:=floattostr(A);
  i:=memo1.lines.IndexOf(s) ;
  if i<>-1 then memo1.Lines.Delete(i);
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
DA:=TDoubleArray.Create(strtoint(edit2.text));
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
if DA<>nil then DA.Free;
DA:=TDoubleArray.Create(strtoint(edit2.text));
Idx:=0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 DA.Free;
end;

procedure TForm1.CoolButton21Click(Sender: TObject);
 var R:double;
begin
  DA.Add(strtoFloat(memo1.lines[Idx]));
  Idx:=Idx+1;
  if Idx>= memo1.Lines.Count then Idx:=0;


  if DA.Over then begin
     if R1.Checked then R:=DA.DoGrbbs else  R:=DA.DoGray ;
     if R<>-10000000000000 then memo4.Lines.add( floattostr(R) );
     
  end;

  memo2.Text:=DA.AsString;

end;

end.