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

// File for testing: boltsize.laz, use BoltLngth variable

// NOTE: THE OUTPUT DOES NOT EXACTLY MATCH THAT OF THE PDF DOCUMENTATION !!!!

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;
    Memo1: TLabel;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    CloseBtn: 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);
    procedure VarListSelectionChange(Sender: TObject; User: boolean);
  private
    { private declarations }
    FAutoSized: Boolean;
    procedure UpdateBtnStates;
  public
    { public declarations }
  end; 

var
  SensForm: TSensForm;

implementation

uses
  Math, Utils;

{ TSensForm }

procedure TSensForm.ResetBtnClick(Sender: TObject);
var
  i: integer;
begin
  AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
  StandardizeChk.Checked := false;
  PlotChk.Checked := false;
  SlopesChk.Checked := false;
  AvgSlopeChk.Checked := false;
  SelectedList.Clear;
  VarList.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  UpdateBtnStates;
end;

procedure TSensForm.InBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < VarList.Items.Count do
  begin
    if VarList.Selected[i] then
    begin
      SelectedList.Items.Add(VarList.Items[i]);
      VarList.Items.Delete(i);
      i := 0;
    end else
      i := i + 1;
  end;
  UpdateBtnStates;
end;

procedure TSensForm.AllBtnClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to VarList.Items.Count-1 do
    SelectedList.Items.Add(VarList.Items[i]);
  VarList.Clear;
  UpdateBtnStates;
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;
  MedianSlope, MannKendall, Z, C, M1, M2, Alpha, mean, stddev: double;
  cellstring, outline: string;
  i, j, k, no2do: integer;
  Standardize, Plot, SlopePlot, AvgSlope: boolean;
  lReport: TStrings;
begin
  NoSelected := SelectedList.Items.Count;
  if noselected = 0 then
  begin
    MessageDlg('First select variables to analyze.', mtError, [mbOk], 0);
    exit;
  end;

  if AlphaEdit.Text = '' then begin
    AlphaEdit.SetFocus;
    MessageDlg('Input required.', mtError, [mbOk], 0);
    exit;
  end;
  if not TryStrToFloat(AlphaEdit.Text, Alpha) or (Alpha <= 0) or (Alpha >= 1) then
  begin
    AlphaEdit.SetFocus;
    MessageDlg('Numeric value required in range > 0 and < 1.', mtError, [mbOk], 0);
    exit;
  end;
  Alpha := 1.0 - Alpha;

  Standardize := StandardizeChk.Checked;
  Plot := PlotChk.Checked;
  SlopePlot := SlopesChk.Checked;
  AvgSlope := AvgSlopeChk.Checked;

  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 := 0 to noselected-1 do
  begin
    cellstring := SelectedList.Items.Strings[i];
    for j := 1 to NoVariables do
      if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
        selected[i] := j;
  end;

  lReport := TStringList.Create;
  try
    lReport.Add('SENS DETECTION AND ESTIMATION OF TRENDS');
    lReport.Add('Number of data points: %4d', [NoCases]);
    lReport.Add('Confidence Interval:   %4.2f', [Alpha]);
    lReport.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])));  // wp: why round?
        Values[i-1, j] := 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';
      MatPrint(Values, NoCases, noselected, outline, RowLabels, ColLabels, NoCases, lReport);
      lReport.Add(DIVIDER);
      lReport.Add('');
    end;

    // standardize if more than one variable and standardization elected
    if (noselected > 1) and standardize 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 + sqr(Values[i,j]);
        end;
        stddev := stddev - sqr(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];
        lReport.Add('Variable: %s,  mean: %8.3f,  standard deviation: %8.3f', [OS3MainFrm.DataGrid.Cells[col,0], mean, stddev]);
      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
        for k := i + 1 to NoCases-1 do
          Slopes[i,k] := (Values[k,j] - Values[i,j]) / (k-i);

      if PrtSlopesChk.Checked then
      begin
        outline := 'CASE';
        MatPrint(Slopes, NoCases, NoCases, outline, RowLabels, ColLabels, NoCases, lReport);
      end;

      // get ranked slopes and median estimator
      SetLength(RankedQ, 500);       // wp: overcome initialization issue with NoVars.
      count := 0;
      for i := 0 to NoCases-2 do
        for k := i+1 to NoCases-1 do
        begin
          RankedQ[count] := Slopes[i,k];
          count := count + 1;
          if count = Length(RankedQ) then
            SetLength(RankedQ, Length(RankedQ) + 500);
        end;
      SetLength(RankedQ, count);

      //sort into ascending order
      for i := 0 to count - 2 do
        for k := i + 1 to count-1 do
          if RankedQ[i] > RankedQ[k] then
            Exchange(RankedQ[i], RankedQ[k]);

      if PrtRanksChk.Checked then
      begin
        SetLength(RankLabels, count);
        for k := 0 to count-1 do
          RankLabels[k] := IntToStr(k+1);
        lReport.Add('Ranked Slopes');
        for i := 0 to count-1 do
          lReport.Add('Label: %s, Ranked Q: %8.3f', [RankLabels[i], RankedQ[i]]);
          // lReport.Add('Label: %d, Ranked Q: %8.3f', [k+1, RankedQ[i]]); <--- wp: test this. It should avoid using the RankLabela array
        lReport.Add('');
        lReport.Add(DIVIDER);
        lReport.Add('');
        RankLabels := nil;
      end;

      // get median slope
      half := count div 2;
      if (2 * half) < count then       // wp: Isn't this the same as "odd(count)"?
        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
            Exchange(Sorted[i], Sorted[k]);
        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
        lReport.Add('Error: z: %8.3f, Mann-Kendall: %8.3f', [Z, MannKendall]);

      // show results
      if j < noselected then
        lReport.Add('Results for %s', [cellstring])
      else
        lReport.Add('Results for Averaged Values');

      if (noselected > 1) and Standardize then
      begin
        mean := 0.0;
        stddev := 0.0;
        for i := 0 to NoCases-1 do
        begin
          mean := mean + Values[i,j];
          stddev := stddev + sqr(Values[i,j]);
        end;
        stddev := stddev - sqr(mean) / NoCases;
        stddev := stddev / (NoCases - 1);
        stddev := sqrt(stddev);
        mean := mean / NoCases;
        lReport.Add('Mean: %8.3f,  Standard Deviation = %8.3f', [mean, stddev]);
      end;

      lReport.Add('Median Slope for %d values: %8.3f', [count, MedianSlope]);
      lReport.Add('Mann-Kendall Variance statistic: %8.3f (%d ties)', [MannKendall, q]);
      lReport.Add('Ranks of the lower and upper confidence: %8.3f, %8.3f', [M1, M2+1]);

      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
        lReport.Add('Corresponding lower and upper slopes: %8.3f, %8.3f', [RankedQ[low], RankedQ[hi]])
      else
        lReport.Add('ERROR! low rank = %d, hi rank = %d', [low, hi]);
      lReport.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 := GRAPH_BACK_COLOR;
        GraphFrm.WallColor := GRAPH_WALL_COLOR;
        GraphFrm.FloorColor := GRAPH_FLOOR_COLOR;
        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;
        if GraphFrm.ShowModal <> mrOK then
          exit;

        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 := GRAPH_BACK_COLOR;
        GraphFrm.WallColor := GRAPH_WALL_COLOR;
        GraphFrm.FloorColor := GRAPH_FLOOR_COLOR;
        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;
        if not GraphFrm.ShowModal = mrOK then
          exit;

        GraphFrm.Ypoints := nil;
        GraphFrm.Xpoints := nil;
      end;

      lReport.Add('');
      lReport.Add(DIVIDER);
      lReport.Add('');
    end; // next variable j

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

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

      // 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
        for j := i + 1 to count - 1 do
          if RankedQ[i] > RankedQ[j] then
            Exchange(RankedQ[i], RankedQ[j]);

      // get median slope
      half := count div 2;
      if (2 * half) < count then       // again: should be "odd(count)"
        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
        MessageDlg(Format('Error in calculating Mann-Kendall: %8.3f', [MannKendall]), mtError, [mbOK], 0);
      if MannKendall > 0.0 then
        C := Z * sqrt(MannKendall)
      else
        C := Z;
      M1 := (count - C) / 2.0;
      M2 := (count + C) / 2.0;

      // Show results
      lReport.Add('Median Slope for %d values: %8.3f for averaged measures', [count, MedianSlope]);
      lReport.Add('Mann-Kendall Variance statistic: %8.3f (%d ties observed)', [MannKendall, q]);
      lReport.Add('Ranks of the lower and upper confidence: (%8.3f, %8.3f)', [M1, M2]);

      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);
      lReport.Add('Corresponding lower and upper slopes: (%8.3f, %8.3f)', [RankedQ[low],RankedQ[hi]]);
    end; // end if average slope

    DisplayReport(lReport);

  finally
    lReport.Free;
    AvgSlopes := nil;
    Sorted := nil;
    RankedQ := nil;
    Slopes := nil;
    Values := nil;
    selected := nil;
    ColLabels := nil;
    RowLabels := nil;
  end;
end;

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

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

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

  FAutoSized := true;
end;

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

procedure TSensForm.OutBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < SelectedList.Items.Count do
  begin
    if SelectedList.Selected[i] then
    begin
      VarList.Items.Add(SelectedList.Items[i]);
      SelectedList.Items.Delete(i);
      i := 0;
    end else
      i := i + 1;
  end;
  UpdateBtnStates;
end;

procedure TSensForm.UpdateBtnStates;
begin
  InBtn.Enabled := AnySelected(VarList);
  OutBtn.Enabled := AnySelected(SelectedList);
  AllBtn.Enabled := Varlist.Items.Count > 0;
end;

procedure TSensForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;

initialization
  {$I sensunit.lrs}

end.