lazarus-ccr/applications/lazstats/source_orig/normalityunit.pas

unit NormalityUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls, MainUnit, Globals, functionsLib, DataProcs,
  OutPutUnit;


type

  { TNormalityFrm }

  TNormalityFrm = class(TForm)
    CancelBtn: TButton;
    ResetBtn: TButton;
    PrintBtn: TButton;
    ApplyBtn: TButton;
    ReturnBtn: TButton;
    ConclusionEdit: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Panel1: TPanel;
    StatEdit: TEdit;
    KurtosisEdit: TEdit;
    SkewEdit: TEdit;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ProbEdit: TEdit;
    Label4: TLabel;
    WEdit: TEdit;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    TestVarEdit: TEdit;
    Label2: TLabel;
    VarInBtn: TBitBtn;
    VarOutBtn: TBitBtn;
    Label1: TLabel;
    VarList: TListBox;
    procedure ApplyBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PrintBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure ReturnBtnClick(Sender: TObject);
    procedure VarInBtnClick(Sender: TObject);
    procedure VarOutBtnClick(Sender: TObject);
  private
    { private declarations }
    function Norm(z : double) : double;

  public
    { public declarations }
  end; 

var
  NormalityFrm: TNormalityFrm;

implementation

{ TNormalityFrm }

procedure TNormalityFrm.FormShow(Sender: TObject);
var
   i : integer;
begin
     TestVarEdit.Text := '';
     WEdit.Text := '';
     ProbEdit.Text := '';
     ConclusionEdit.Text := '';
     SkewEdit.Text := '';
     KurtosisEdit.Text := '';
     StatEdit.Text := '';
     VarOutBtn.Visible := false;
     VarInBtn.Visible := true;
     VarList.Items.Clear;
     for i := 1 to NoVariables do
          VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;

procedure TNormalityFrm.PrintBtnClick(Sender: TObject);
begin
     OutPutFrm.RichEdit.Clear;
     OutPutFrm.RichEdit.Lines.Add('NORMALITY TESTS FOR '+ TestVarEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Shapiro-Wilkes W = ' + WEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('Shapiro-Wilkes Prob. = ' + ProbEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Skew = ' + SkewEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('Kurtosis = ' + KurtosisEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('Lilliefors Test Statistic = ' + StatEdit.Text);
     OutPutFrm.RichEdit.Lines.Add('Conclusion: ' + ConclusionEdit.Text);
     OutPutFrm.ShowModal;
end;

procedure TNormalityFrm.ResetBtnClick(Sender: TObject);
begin
     FormShow(self);
end;

procedure TNormalityFrm.ReturnBtnClick(Sender: TObject);
begin
     NormalityFrm.Hide;
end;

procedure TNormalityFrm.CancelBtnClick(Sender: TObject);
begin
     NormalityFrm.Hide;
end;

procedure TNormalityFrm.ApplyBtnClick(Sender: TObject);
label again;
var
   temp, w, pw : double;
   skew, kurtosis : double;
   mean, variance, stddev, deviation, devsqr, M2, M3, M4 : double;
   i, j, n, n1, n2, ier : integer;
   varlabel : string;
   selcol : integer;
   data, a, z, x : DblDyneVec;
   freq : IntDyneVec;
   fval, jval, DP : DblDyneVec;
   F1, DPP, D, D1, A0, C1, D15, D10, D05, D025, t2 : double;
   init : boolean;
   msg : string;

begin
   init := false;
   n := 0;
   selcol := 0;
   for i := 1 to NoVariables do
        if OS3MainFrm.DataGrid.Cells[i,0] = TestVarEdit.Text then selcol := i;
   if selcol <> 0 then
   begin
        varlabel := TestVarEdit.Text;
        // place values into the data array
        SetLength(data,NoCases+1); // arrays start at 1
        SetLength(a,NoCases+1);
        SetLength(freq, NoCases+1);
        SetLength(z, NoCases+1);
        SetLength(x, NoCases+1);
        SetLength(fval,NoCases+1);
        SetLength(jval,NoCases+1);
        SetLength(DP,NoCases+1);
        for i := 1 to NoCases do
        begin
             if NOT ValidValue(i,selcol) then continue;
             n := n + 1;
             data[n] := StrToFloat(OS3MainFrm.DataGrid.Cells[selcol,i]);
        end;
        n1 := n;
        n2 := n div 2;
        // sort into ascending order
        for i := 1 to n - 1 do
        begin
             for j := i + 1 to n do
             begin
                  if data[i] > data[j] then
                  begin
                       temp := data[i];
                       data[i] := data[j];
                       data[j] := temp;
                  end;
             end;
        end;
        // call Shapiro-Wilks function
        swilk(init, data, n, n1, n2, a, w, pw, ier);
        if ier <> 0 then
        begin
             Msg := 'Error encountered = ' + IntToStr(ier);
             ShowMessage(Msg);
             DP := nil;
             jval := nil;
             fval := nil;
             data := nil;
             a := nil;
             freq := nil;
             z := nil;
             x := nil;
             exit;
        end;
        WEdit.Text := format('%8.4f',[w]);
        ProbEdit.Text := format('%8.4f',[pw]);

        // Now do Lilliefors
        // get unique scores and their frequencies
        n1 := 1;
        i := 1;
        freq[1] := 1;
        x[1] := data[1];
again:  for j := i + 1 to n do
        begin
             if data[j] = x[n1] then freq[n1] := freq[n1] + 1;
        end;
        i := i + freq[n1];
        if i <= n then
        begin
             n1 := n1 + 1;
             x[n1] := data[i];
             freq[n1] := 1;
             goto again;
        end;
        // now get skew and kurtosis of scores
        mean := 0.0;
        variance := 0.0;
        for i := 1 to n do
        begin
             mean := mean + data[i];
             variance := variance + (data[i] * data[i]);
        end;
        variance := variance - (mean * mean) / n;
        variance := variance / (n - 1);
        stddev := sqrt(variance);
        mean := mean / n;
        // obtain skew, kurtosis and z scores
        M2 := 0.0;
        M3 := 0.0;
        M4 := 0.0;
        for i := 1 to n do
        begin
             deviation := data[i] - mean;
             devsqr := deviation * deviation;
             M2 := M2 + devsqr;
             M3 := M3 + (deviation * devsqr);
             M4 := M4 + (devsqr * devsqr);
             z[i] := (data[i] - mean) / stddev;
        end;
        for i := 1 to n1 do x[i] := (x[i] - mean) / stddev;
        skew := (n * M3) / ((n - 1) * (n - 2) * stddev * variance);
        kurtosis := (n * (n + 1) * M4) - (3 * M2 * M2 * (n - 1));
        kurtosis := kurtosis /( (n - 1) * (n - 2) * (n - 3) * (variance * variance) );
        SkewEdit.Text := format('%8.3f',[skew]);
        KurtosisEdit.Text := format('%8.3f',[kurtosis]);
        // obtain the test statistic
        for i := 1 to n1 do
        begin
             F1 := Norm(x[i]);
             if x[i] >= 0 then fval[i] := 1.0 - (F1 / 2.0)
             else fval[i] := F1 / 2.0;
        end;
        // cumulative proportions
        jval[1] := freq[1] / n;
        for i := 2 to n1 do jval[i] := jval[i-1] + freq[i] / n;
        for i := 1 to n1 do DP[i] := abs(jval[i] - fval[i]);
        // sort DP
        for i := 1 to n1-1 do
        begin
             for j := i+1 to n1 do
             begin
                  if DP[j] < DP[i] then
                  begin
                       temp := DP[i];
                       DP[i] := DP[j];
                       DP[j] := temp;
                  end;
             end;
        end;
        DPP := DP[n1];
        D := DPP;
        D1 := D;
        StatEdit.Text := format('%8.3f',[D]);
        A0 := sqrt(n);
        C1 := A0 - 0.01 + (0.85 / A0);
        D15 := 0.775 / C1;
        D10 := 0.819 / C1;
        D05 := 0.895 / C1;
        D025 := 0.995 / C1;
        t2 := D;
        if t2 > D025 then ConclusionEdit.Text := 'Strong evidence against normality.';
        if ((t2 <= D025) and (t2 > D05)) then ConclusionEdit.Text := 'Sufficient evidence against normality.';
        if ((t2 <= D05) and (t2 > D10)) then ConclusionEdit.Text := 'Suggestive evidence against normality.';
        if ((t2 <= D10) and (t2 > D15)) then ConclusionEdit.Text := 'Little evidence against normality.';
        if (t2 <= D15) then ConclusionEdit.Text := 'No evidence against normality.';
   end;
   DP := nil;
   jval := nil;
   fval := nil;
   data := nil;
   a := nil;
   freq := nil;
   z := nil;
   x := nil;
end;

procedure TNormalityFrm.VarInBtnClick(Sender: TObject);
var
   i : integer;
begin
   i := VarList.ItemIndex;
   if i < 0 then exit;
   TestVarEdit.Text := VarList.Items.Strings[i];
   VarList.Items.Delete(i);
   VarInBtn.Visible := false;
   VarOutBtn.Visible := true;

end;

procedure TNormalityFrm.VarOutBtnClick(Sender: TObject);
begin
     if TestVarEdit.Text = '' then exit;
     VarList.Items.Add(TestVarEdit.Text);
     TestVarEdit.Text := '';
     VarOutBtn.Visible := false;
     VarInBtn.Visible := true;
end;

function TNormalityFrm.Norm(z : double) : double;
var
   p : double;
begin
     z := abs(z);
     p := 1.0 + z * (0.04986735 + z * (0.02114101 + z * (0.00327763 +
          z * (0.0000380036 + z * (0.0000488906 + z * 0.000005383)))));
     p := p * p;
     p := p * p;
     p := p * p;
     Result := 1.0 / (p * p);
end;
//-------------------------------------------------------------------

initialization
  {$I normalityunit.lrs}

end.