lazarus-ccr/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas

unit SensUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls,
  MainUnit, Globals, FunctionsLib, OutputUnit,
  ContextHelpUnit, MatrixLib, GraphLib;

type

  { TSensForm }

  TSensForm = class(TForm)
    AllBtn: TBitBtn;
    AlphaEdit: TEdit;
    Bevel1: TBevel;
    CancelBtn: TButton;
    Memo1: TLabel;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    InBtn: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    SelectedList: TListBox;
    OutBtn: TBitBtn;
    VarList: TListBox;
    PrtRanksChk: TCheckBox;
    PrtSlopesChk: TCheckBox;
    PrtDataChk: TCheckBox;
    GroupBox3: TGroupBox;
    SlopesChk: TCheckBox;
    PlotChk: TCheckBox;
    GroupBox2: TGroupBox;
    StandardizeChk: TCheckBox;
    AvgSlopeChk: TCheckBox;
    GroupBox1: TGroupBox;
    procedure AllBtnClick(Sender: TObject);
    procedure ComputeBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
  private
    { private declarations }
    FAutoSized: Boolean;
  public
    { public declarations }
  end; 

var
  SensForm: TSensForm;

implementation

uses
  Math;

{ TSensForm }

procedure TSensForm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     AlphaEdit.Text := '0.05';
     StandardizeChk.Checked := false;
     PlotChk.Checked := false;
     SlopesChk.Checked := false;
     InBtn.Enabled := true;
     OutBtn.Enabled := false;
     AvgSlopeChk.Checked := false;
     SelectedList.Clear;
     VarList.Clear;
     for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;

procedure TSensForm.InBtnClick(Sender: TObject);
VAR index, i : integer;
begin
     index := VarList.Items.Count;
     i := 0;
     while i < index do
     begin
         if (VarList.Selected[i]) then
         begin
            SelectedList.Items.Add(VarList.Items.Strings[i]);
            VarList.Items.Delete(i);
            index := index - 1;
            i := 0;
         end
         else i := i + 1;
     end;
     OutBtn.Enabled := true;
end;

procedure TSensForm.AllBtnClick(Sender: TObject);
VAR count, i : integer;
begin
     count := VarList.Items.Count;
     if count <= 0 then exit;
     for i := 0 to VarList.Items.Count-1 do
          SelectedList.Items.Add(VarList.Items.Strings[i]);
     VarList.Clear;
     OutBtn.Enabled := true;
     InBtn.Enabled := false;
end;

procedure TSensForm.ComputeBtnClick(Sender: TObject);
VAR
  NoVars, noselected, count, half, q, tp, low, hi, col : integer;
  Values, Slopes, AvgSlopes : DblDyneMat;
  RankedQ, Sorted : DblDyneVec;
  RowLabels, ColLabels, RankLabels : StrDyneVec;
  selected : IntDyneVec;
  temp, MedianSlope, MannKendall, Z, C, M1, M2, Alpha, mean, stddev : double;
  cellstring, outline : string;
  i, j, k, no2do : integer;
  Standardize, Plot, SlopePlot, AvgSlope : boolean;

begin
     Standardize := false;
     Plot := false;
     SlopePlot := false;
     AvgSlope := false;

     if StandardizeChk.Checked then Standardize := true;
     if PlotChk.Checked then Plot := true;
     if SlopesChk.Checked then SlopePlot := true;
     if AvgSlopeChk.Checked then AvgSlope := true;
     Alpha := 1.0 - StrToFloat(AlphaEdit.Text);
     noselected := SelectedList.Items.Count;
     if noselected = 0 then
     begin
        ShowMessage('ERROR!  First select variables to analyze.');
        exit;
     end;
     SetLength(RowLabels,NoCases);
     SetLength(ColLabels,NoCases);
     SetLength(selected,noselected);
     SetLength(Values,NoCases,noselected+1);
     SetLength(Slopes,NoCases,NoCases);
     SetLength(RankedQ,NoVars);    // !!!!!!!!!!!!!!!!!!! NoVars is not initialized !!!!!!!!!!!!!!!!!!!!!!
     SetLength(Sorted,NoCases);
     SetLength(AvgSlopes,NoCases,NoCases);

     for i := 0 to NoCases-1 do
          begin
              RowLabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1];
              ColLabels[i] := RowLabels[i];
              for j := 0 to NoCases-1 do Slopes[i,j] := 0.0;
          end;

     // get selected variables
     for i := 1 to noselected do
          begin
              cellstring := SelectedList.Items.Strings[i-1];
              for j := 1 to NoVariables do
                   if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
                      selected[i-1] := j;
          end;

     OutputFrm.RichEdit.Clear;
     OutputFrm.RichEdit.Lines.Add('Sens Detection and Estimation of Trends');
     outline := format('Number of data points = %d, Confidence Interval = %4.2f',
        [NoCases,Alpha]);
     OutputFrm.RichEdit.Lines.Add(outline);
     OutputFrm.RichEdit.Lines.Add('');

     //Get the data
     if AvgSlope then for i := 0 to NoCases-1 do Values[i,noselected] := 0.0;
     for j := 0 to noselected-1 do
          begin
              col := selected[j];
              for i := 1 to NoCases do
                   begin
                       Values[i-1,j] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])));
                       if AvgSlope then Values[i-1,noselected] := Values[i-1,noselected] +
                          Values[i-1,j];
                   end;
          end;

     if PrtDataChk.Checked then
     begin
        outline:= 'CASE';
        MAT_PRINT(Values,NoCases,noselected,outline,RowLabels,ColLabels,NoCases);
        OutputFrm.ShowModal;
     end;

     // standardize if more than one variable and standardization elected
     if (noselected > 1) and (standardize = true) then
     begin
        for j := 0 to noselected-1 do
             begin
                  mean := 0.0;
                  stddev := 0.0;
                  for i := 0 to NoCases-1 do
                       begin
                           mean := mean + Values[i,j];
                           stddev := stddev + (Values[i,j] * Values[i,j]);
                       end;
                       stddev := stddev - (mean * mean) / NoCases;
                       stddev := stddev / (NoCases -  1);
                       stddev := sqrt(stddev);
                       mean := mean / NoCases;
                       for i := 0 to NoCases-1 do
                                Values[i,j] := (Values[i,j] - mean)/ stddev;
                       col := selected[j];
                       outline := format('Variable = %s, mean = %8.3f, standard deviation = %8.3f',
                               [OS3MainFrm.DataGrid.Cells[col,0],mean,stddev]);
                       OutputFrm.RichEdit.Lines.Add(outline);
             end;
     end;

     // average the values if elected
     if AvgSlope then for i := 0 to NoCases - 1 do Values[i,noselected] :=
        Values[i,noselected] / noselected;

     // get interval slopes
     no2do := noselected;
     if AvgSlope then no2do := no2do + 1;
     for j := 0 to no2do - 1 do
          begin
              if j < noselected then
              begin
                 col := selected[j];
                 cellstring := OS3MainFrm.DataGrid.Cells[col,0];
              end
              else
              begin
                  col := 0;
                  cellstring := 'Combined Scores';
              end;
              for i := 0 to NoCases-2 do
                   begin
                       for k := i + 1 to NoCases-1 do
                            Slopes[i,k] := (Values[k,j] - Values[i,j]) / (k-i);
                   end;
              if PrtSlopesChk.Checked then
              begin
                   outline := 'CASE';
                   MAT_PRINT(Slopes,NoCases,NoCases,outline,RowLabels,ColLabels,NoCases);
              end;

              // get ranked slopes and median estimator
              count := 0;
              for i := 0 to NoCases-2 do
                  begin
                       for k := i+1 to NoCases-1 do
                           begin
                                RankedQ[count] := Slopes[i,k];
                                count := count + 1;
                           end;
                  end;

              //sort into ascending order
              for i := 0 to count - 2 do
                  begin
                       for k := i + 1 to count-1 do
                       begin
                            if RankedQ[i] > RankedQ[k] then
                            begin
                                 temp := RankedQ[i];
                                 RankedQ[i] := RankedQ[k];
                                 RankedQ[k] := temp;
                            end;
                       end;
                  end;

              if PrtRanksChk.Checked then
              begin
                   SetLength(RankLabels,count);
                   for k := 0 to count-1 do RankLabels[k] := IntToStr(k+1);
                   OutputFrm.RichEdit.Lines.Add('Ranked Slopes');
                   for i := 0 to count-1 do
                   begin
                        outline := format('Label = %s, Ranked Q = %8.3f',
                                [RankLabels[i],RankedQ[i]]);
                        OutputFrm.RichEdit.Lines.Add(outline);
                   end;
                   OutputFrm.ShowModal;
                   RankLabels := nil;
              end;

              // get median slope
              half := count div 2;
              if (2 * half) < count then MedianSlope := RankedQ[half]
              else MedianSlope := (RankedQ[half-1] + RankedQ[half]) / 2.0;

              // get Mann-Kendall statistic based on tied values
              for i := 0 to NoCases-1 do Sorted[i] := Values[i,j];
              for i := 0 to NoCases-2 do
                  begin
                       for k := i+1 to NoCases-1 do
                           begin
                               if Sorted[i] > Sorted[k] then
                               begin
                                 temp := Sorted[i];
                                 Sorted[i] := Sorted[k];
                                 Sorted[k] := temp;
                               end;
                           end;
                  end;

                  MannKendall := 0.0;
                  q := 0;
                  i := -1;
                  while (i < NoCases-2) do
                      begin
                          i := i + 1;
                          tp := 1; // no. of ties for pth (i) value
                          for k := i + 1 to NoCases-1 do
                              begin
                                  if Sorted[k] <> Sorted[i] then
                                  begin
                                    i := k-1;
                                    break;
                                  end
                                  else tp := tp + 1;
                              end; // next k
                          if tp > 1 then
                          begin
                            q := q + 1;
                            MannKendall := MannKendall + (tp * (tp-1) * (2 * tp + 5));
                          end;
                      end; // end next i
                  MannKendall := (NoCases * (NoCases-1) * (2 * NoCases + 5) -
                     MannKendall) / 18.0;
                  Z := inversez(Alpha);
                  if MannKendall > 0 then
                  begin
                    C := Z * sqrt(MannKendall);
                    M1 := (count - C) / 2.0;
                    M2 := (count + C) / 2.0;
                  end
                  else begin
                      outline := format('Error: z = %8.3f, Mann-Kendall = %8.3f',
                         [Z,MannKendall]);
                      OutputFrm.RichEdit.Lines.Add(outline);
                  end;

                  // show results
                  if j < noselected then
                  begin
                     outline := format('Results for %s',[cellstring]);
                     OutputFrm.RichEdit.Lines.Add(outline);
                  end
                  else
                    OutputFrm.RichEdit.Lines.Add('Results for Averaged Values');
                  if (noselected > 1) and (Standardize = true) then
                  begin
                    mean := 0.0;
                    stddev := 0.0;
                    for i := 0 to NoCases-1 do
                        begin
                            mean := mean + Values[i,j];
                            stddev := stddev + (Values[i,j] * Values[i,j]);
                        end;
                    stddev := stddev - (mean * mean) / NoCases;
                    stddev := stddev / (NoCases - 1);
                    stddev := sqrt(stddev);
                    mean := mean / NoCases;
                    outline := format('Mean = %8.3f, Standard Deviation = %8.3f',
                      [mean,stddev]);
                    OutputFrm.RichEdit.Lines.Add(outline);
                  end;
                  outline := format('Median Slope for %d values = %8.3f',
                    [count,MedianSlope]);
                  OutputFrm.RichEdit.Lines.Add(outline);
                  outline := format('Mann-Kendall Variance statistic = %8.3f (%d ties)',
                    [MannKendall,q]);
                  OutputFrm.RichEdit.Lines.Add(outline);
                  outline := format('Ranks of the lower and upper confidence = %8.3f, %8.3f',
                    [M1, M2+1]);
                  OutputFrm.RichEdit.Lines.Add(outline);
                  low := round(M1 - 1.0);
                  if ((M1-1) - low) > 0.5 then low := round(M1-1);
                  hi := round(M2);
                  if (M2 - hi) > 0.5 then hi := round(M2);
                  if (low > 0) or (hi <= count) then
                  begin
                    outline := format('Corresponding lower and upper slopes = %8.3f, %8.3f',
                      [RankedQ[low],RankedQ[hi]]);
                    OutputFrm.RichEdit.Lines.Add(outline);
                  end
                  else begin
                      outline := format('ERROR! low rank = %d, hi rank = %d',
                        [low, hi]);
                      OutputFrm.RichEdit.Lines.Add(outline);
                  end;
                  OutputFrm.RichEdit.Lines.Add('');

                  // plot slopes if elected
                  if Plot then
                  begin
                    SetLength(GraphFrm.Xpoints,1,NoCases+1);
                    SetLength(GraphFrm.Ypoints,1,NoCases+1);
                    GraphFrm.GraphType := 2;
                    GraphFrm.nosets := 1;
                    GraphFrm.nbars := NoCases;
                    GraphFrm.BackColor := clYellow;
                    GraphFrm.WallColor := clBlue;
                    GraphFrm.FloorColor := clGray;
                    if j < noselected then GraphFrm.Heading := OS3MainFrm.DataGrid.Cells[col,0]
                    else GraphFrm.Heading := 'Average Values';
                    GraphFrm.barwideprop := 1.0;
                    GraphFrm.AutoScaled := true;
                    GraphFrm.ShowLeftWall := true;
                    GraphFrm.ShowRightWall := true;
                    GraphFrm.ShowBottomWall := true;
                    GraphFrm.YTitle := 'Measure';
                    GraphFrm.XTitle := 'Time';
                    for k := 0 to NoCases - 1 do
                        begin
                            GraphFrm.Ypoints[0,k] := Values[k,j];
                            GraphFrm.Xpoints[0,k] := k+1;
                        end;
                    GraphFrm.ShowModal;
                    GraphFrm.Ypoints := nil;
                    GraphFrm.Xpoints := nil;
                  end;

                  // plot ranked slopes if elected
                  if SlopePlot then
                  begin
                    SetLength(GraphFrm.Xpoints,1,count+1);
                    SetLength(GraphFrm.Ypoints,1,count+1);
                    GraphFrm.GraphType := 2;
                    GraphFrm.nosets := 1;
                    GraphFrm.nbars := count;
                    GraphFrm.BackColor := clYellow;
                    GraphFrm.WallColor := clBlue;
                    GraphFrm.FloorColor := clGray;
                    GraphFrm.Heading := 'Ranked Slopes';
                    GraphFrm.barwideprop := 1.0;
                    GraphFrm.AutoScaled := true;
                    GraphFrm.ShowLeftWall := true;
                    GraphFrm.ShowRightWall := true;
                    GraphFrm.ShowBottomWall := true;
                    GraphFrm.YTitle := 'Slope';
                    GraphFrm.XTitle := 'Rank';
                    for k := 0 to count - 1 do
                        begin
                            GraphFrm.Ypoints[0,k] := RankedQ[k];
                            GraphFrm.Xpoints[0,k] := k+1;
                        end;
                    GraphFrm.ShowModal;
                    GraphFrm.Ypoints := nil;
                    GraphFrm.Xpoints := nil;
                  end;
                  OutputFrm.ShowModal;
                  OutputFrm.RichEdit.Clear;
          end; // next variable j

     if AvgSlope then
     begin
       for i := 0 to NoCases-2 do
           begin
           for k := i + 1 to NoCases-1 do
               begin
                    AvgSlopes[i,k] := AvgSlopes[i,k] + Slopes[i,k];
               end;
           end;
     end;

     // Average multiple measures
     if AvgSlope then
     begin
       OutputFrm.RichEdit.Lines.Add('Results for Averaged Slopes');
       for i := 0 to NoCases-2 do
           begin
               for k := i + 1 to NoCases-1 do
                   AvgSlopes[i,k] := AvgSlopes[i,k] / noselected;
           end;

           // get ranked slopes and median estimator
           count := 0;
           for i := 0 to NoCases-2 do
           begin
                for j := i + 1 to NoCases-1 do
                    begin
                         RankedQ[count] := AvgSlopes[i,j];
                         count := count + 1;
                    end;
           end;
           for i := 0 to Count-2 do
               begin
                    for j := i + 1 to count - 1 do
                        begin
                             if RankedQ[i] > RankedQ[j] then
                                begin
                                     temp := RankedQ[i];
                                     RankedQ[i] := RankedQ[j];
                                     RankedQ[j] := temp;
                                end;
                        end;
               end;
           // get median slope
           half := count div 2;
           if (2 * half) < count then MedianSlope := RankedQ[half + 1]
           else MedianSlope := (RankedQ[half] + RankedQ[half+1]) / 2.0;
           // get Mann-Kendall statistic based on tied values
           MannKendall := 0.0;
           q := 0;
           i := -1;
           while (i < count-1) do
              begin
                   i := i + 1;
                   tp := 1; // no. of ties for pth (i) value
                   for j := i + 1 to count-1 do
                       begin
                            if RankedQ[j] <> RankedQ[i] then
                               begin
                                    i := j - 1;
                                    break;
                               end
                               else tp := tp + 1;
                       end;
                       if tp > 1 then
                          begin
                               q := q + 1;
                               MannKendall := MannKendall + (tp * (tp-1) * (2 * tp + 5));
                          end;
              end; // end do while
              MannKendall := (NoCases * (NoCases-1) * (2 * NoCases + 5) - MannKendall) / 18.0;
              Z := inversez(Alpha);
              if MannKendall < 0.0 then
                 begin
                       outline := format('Error in calculating Mann-Kendall = %8.3f',
                         [MannKendall]);
                       ShowMessage(outline);
                 end;
              if MannKendall > 0.0 then C := Z * sqrt(MannKendall)
              else C := Z;
              M1 := (count - C) / 2.0;
              M2 := (count + C) / 2.0;
              // Show results
              outline := format('Median Slope for %d values = %8.3f for averaged measures',
                [count,MedianSlope]);
              OutputFrm.RichEdit.Lines.Add(outline);
              outline := format('Mann-Kendall Variance statistic = %8.3f (%d ties observed)',
                  [MannKendall,q]);
              OutputFrm.RichEdit.Lines.Add(outline);
              outline := format('Ranks of the lower and upper confidence = (%8.3f, %8.3f)',
                    [M1, M2]);
              OutputFrm.RichEdit.Lines.Add(outline);
              low := round(M1) - 1;
              if ((M1-1) - low) > 0.5 then low := round(M1 - 1);
              hi := round(M2);
              if (M2 - hi) > 0.5 then hi := round(M2);
              outline := format('Corresponding lower and upper slopes = (%8.3f, %8.3f)',
                    [RankedQ[low],RankedQ[hi]]);
              OutputFrm.RichEdit.Lines.Add(outline);
     end; // end if average slope
     OutputFrm.ShowModal;

     // cleanup
     AvgSlopes := nil;
     Sorted := nil;
     RankedQ := nil;
     Slopes := nil;
     Values := nil;
     selected := nil;
     ColLabels := nil;
     RowLabels := nil;
end;

procedure TSensForm.FormActivate(Sender: TObject);
var
  w: Integer;
begin
  if FAutoSized then
    exit;

  w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
  ResetBtn.Constraints.MinWidth := w;
  CancelBtn.Constraints.MinWidth := w;
  ComputeBtn.Constraints.MinWidth := w;
  ReturnBtn.Constraints.MinWidth := w;

  Constraints.MinWidth := Width;
  Constraints.MinHeight := Height;

  FAutoSized := true;
end;

procedure TSensForm.FormCreate(Sender: TObject);
begin
  Assert(OS3MainFrm <> nil);
  if OutputFrm = nil then
    Application.CreateForm(TOutputFrm, OutputFrm);
  if GraphFrm = nil then
    Application.CreateForm(TGraphFrm, GraphFrm);
end;

procedure TSensForm.OutBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := SelectedList.ItemIndex;
     VarList.Items.Add(SelectedList.Items.Strings[index]);
     SelectedList.Items.Delete(index);
     InBtn.Enabled := true;
     if SelectedList.Items.Count = 0 then OutBtn.Enabled := false;
end;

initialization
  {$I sensunit.lrs}

end.