From b0c06dc9c521d1df1228afa28de4e020d7fdefd7 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 1 Nov 2020 22:27:12 +0000 Subject: [PATCH] LazStats: Refactor SensUnit. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7834 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../forms/analysis/nonparametric/sensunit.lfm | 37 +- .../forms/analysis/nonparametric/sensunit.pas | 937 +++++++++++------- .../analysis/nonparametric/spearmanunit.pas | 1 + .../lazstats/source/forms/mainunit.lfm | 2 +- .../lazstats/source/forms/mainunit.pas | 2 +- .../lazstats/source/units/dataprocs.pas | 12 +- 6 files changed, 612 insertions(+), 379 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm index 2a0c15e5b..0cbb2064f 100644 --- a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm +++ b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm @@ -173,7 +173,7 @@ inherited SensForm: TSensForm ClientHeight = 52 ClientWidth = 120 TabOrder = 9 - object PlotChk: TCheckBox + object PlotSlopesChk: TCheckBox Left = 12 Height = 19 Top = 6 @@ -181,7 +181,7 @@ inherited SensForm: TSensForm Caption = 'Each Variable' TabOrder = 0 end - object SlopesChk: TCheckBox + object PlotRankedSlopesChk: TCheckBox Left = 12 Height = 19 Top = 27 @@ -212,7 +212,7 @@ inherited SensForm: TSensForm ClientHeight = 31 ClientWidth = 337 TabOrder = 10 - object StandardizeChk: TRadioButton + object StandardizeChk: TCheckBox Left = 12 Height = 19 Top = 6 @@ -220,7 +220,7 @@ inherited SensForm: TSensForm Caption = 'Standardize the measures' TabOrder = 0 end - object AvgSlopeChk: TRadioButton + object AvgSlopeChk: TCheckBox Left = 178 Height = 19 Top = 6 @@ -292,9 +292,36 @@ inherited SensForm: TSensForm Left = 356 Height = 416 end - inherited PageControl: TPageControl + object PageControl: TPageControl[2] Left = 365 Height = 400 + Top = 8 Width = 563 + ActivePage = RankedSlopesPage + Align = alClient + BorderSpacing.Left = 4 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabIndex = 3 + TabOrder = 2 + object ResultsPage: TTabSheet + Caption = 'Results' + end + object DataPage: TTabSheet + Caption = 'Data' + end + object SlopesMatrixPage: TTabSheet + Caption = 'Slopes Matrix' + end + object RankedSlopesPage: TTabSheet + Caption = 'Ranked Slopes' + end + object SlopesPlotPage: TTabSheet + Caption = 'Slopes Plots' + end + object RankedSlopesPlotPage: TTabSheet + Caption = 'Ranked Slopes Plot' + end end end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas index 9275728b5..d96ba4462 100644 --- a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas +++ b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas @@ -11,31 +11,39 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, - MainUnit, Globals, FunctionsLib, - ContextHelpUnit, MatrixLib, GraphLib, BasicStatsReportAndChartFormUnit; + MainUnit, Globals, FunctionsLib, MatrixLib, + ReportFrameUnit, ChartFrameUnit, BasicStatsReportFormUnit; type { TSensForm } - TSensForm = class(TBasicStatsReportAndChartForm) + TSensForm = class(TBasicStatsReportForm) AllBtn: TBitBtn; AlphaEdit: TEdit; - AvgSlopeChk: TRadioButton; + AvgSlopeChk: TCheckBox; InBtn: TBitBtn; Label1: TLabel; Label2: TLabel; Label3: TLabel; + PageControl: TPageControl; SelectedList: TListBox; OutBtn: TBitBtn; - StandardizeChk: TRadioButton; + RankedSlopesChartPage: TTabSheet; + DataPage: TTabSheet; + SlopesMatrixPage: TTabSheet; + RankedSlopesPage: TTabSheet; + SlopesPlotPage: TTabSheet; + RankedSlopesPlotPage: TTabSheet; + ResultsPage: TTabSheet; + StandardizeChk: TCheckBox; VarList: TListBox; PrtRanksChk: TCheckBox; PrtSlopesChk: TCheckBox; PrtDataChk: TCheckBox; GroupBox3: TGroupBox; - SlopesChk: TCheckBox; - PlotChk: TCheckBox; + PlotRankedSlopesChk: TCheckBox; + PlotSlopesChk: TCheckBox; GroupBox2: TGroupBox; GroupBox1: TGroupBox; procedure AllBtnClick(Sender: TObject); @@ -45,12 +53,46 @@ type procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); private - + FDataReportFrame: TReportFrame; + FSlopesReportFrame: TReportFrame; + FRankedSlopesReportFrame: TReportFrame; + + FSlopesChartFrame: TChartFrame; + FRankedSlopesChartFrame: TChartFrame; + + procedure DisplayData(const AValues: DblDyneMat; ANumSelected: Integer; + const ARowLabels, AColLabels: StrDyneVec); + + procedure GetData(out ARowLabels, AColLabels: StrDyneVec; + out ANumSelected: Integer; out ASelected: IntDyneVec; + out AValues: DblDyneMat); + + procedure GetMannKendall(AIndex: Integer; const AValues: DblDyneMat; + out MannKendall: Double; out ANumTies: Integer); + + function GetMedianSlope(ARankedQ: DblDyneVec): Double; + + procedure PlotRankedSlopes(AIndex: Integer; const ARankedQ: DblDyneVec; ATitle: String); + procedure PlotSlopes(AIndex: Integer; const AValues: DblDyneMat; ATitle: String); + + procedure PrepareChart(AChartFrame: TChartFrame; ATitle, XTitle, YTitle: String); + + procedure ProcessRankedQ(AReport: TStrings; const ASlopes: DblDyneMat; + const ATitle: String; out ARankedQ: DblDyneVec); + + procedure ProcessSlopes(AReport: TStrings; AIndex: Integer; + const AValues: DblDyneMat; const ARowLabels, AColLabels: StrDyneVec; + const ATitle: String; out ASlopes: DblDyneMat); + + procedure StandardizeValuesAndDisplay(AValues: DblDyneMat; + ASelected: IntDyneVec; ANumSelected: Integer; AReport: TStrings); + protected procedure AdjustConstraints; override; procedure Compute; override; procedure UpdateBtnStates; override; - + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override; + public constructor Create(AOwner: TComponent); override; procedure Reset; override; @@ -66,15 +108,51 @@ implementation uses Math, - Utils, MatrixUnit; + TACustomSeries, + Utils, MatrixUnit, GridProcs; + { TSensForm } constructor TSensForm.Create(AOwner: TComponent); begin inherited; - if GraphFrm = nil then - Application.CreateForm(TGraphFrm, GraphFrm); + + FReportFrame.Parent := ResultsPage; + FReportFrame.BorderSpacing.Left := 0; + FReportFrame.BorderSpacing.Top := 0; + FReportFrame.BorderSpacing.Right := 0; + FReportFrame.BorderSpacing.Bottom := 0; + InitToolbar(FReportFrame.ReportToolbar, tpTop); + + FDataReportFrame := TReportFrame.Create(self); + FDataReportFrame.Name := ''; + FDataReportFrame.Parent := DataPage; + FDataReportFrame.Align := alClient; + + FSlopesReportFrame := TReportFrame.Create(self); + FSlopesReportFrame.Name := ''; + FSlopesReportFrame.Parent := SlopesMatrixPage; + FSlopesReportFrame.Align := alClient; + + FRankedSlopesReportFrame := TReportFrame.Create(self); + FRankedSlopesReportFrame.Name := ''; + FRankedSlopesReportFrame.Parent := RankedSlopesPage; + FRankedSlopesReportFrame.Align := alClient; + + FSlopesChartFrame := TChartFrame.Create(self); + FSlopesChartFrame.Parent := SlopesPlotPage; + FSlopesChartFrame.Align := alClient; + FSlopesChartFrame.Chart.BottomAxis.Intervals.MaxLength := 80; + FSlopesChartFrame.Chart.BottomAxis.Intervals.MinLength := 30; + + FRankedSlopesChartFrame := TChartFrame.Create(self); + FRankedSlopesChartFrame.Parent := RankedSlopesPlotPage; + FRankedSlopesChartFrame.Align := alClient; + FRankedSlopesChartFrame.Chart.BottomAxis.Intervals.MaxLength := 80; + FRankedSlopesChartFrame.Chart.BottomAxis.Intervals.MinLength := 30; + + PageControl.ActivePageIndex := 0; end; @@ -103,286 +181,105 @@ begin end; -procedure TSensForm.Reset; -var - i: integer; -begin - inherited; - 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.Compute; var - //NoVars, - noselected, count, half, q, tp, low, hi, col: integer; - Values, Slopes, AvgSlopes: DblDyneMat; - RankedQ, Sorted: DblDyneVec; - RowLabels, ColLabels, RankLabels: StrDyneVec; - selected: IntDyneVec; + NoSelected, count, half, q, tp, low, hi, col: integer; + Values: DblDyneMat = nil; + Slopes: DblDyneMat = nil; + AvgSlopes: DblDyneMat = nil; + RankedQ: DblDyneVec = nil; + RowLabels: StrDyneVec = nil; + ColLabels: StrDyneVec = nil; + Selected: IntDyneVec = nil; MedianSlope, MannKendall, Z, C, M1, M2, Alpha, mean, stddev: double; - cellstring, outline: string; + lTitle: String; i, j, k, no2do: integer; - Standardize, Plot, SlopePlot, AvgSlope: boolean; lReport: TStrings; + lSlopesReport: TStrings; + lRankedReport: TStrings; begin - NoSelected := SelectedList.Items.Count; - if noselected = 0 then - begin - MessageDlg('First select variables to analyze.', mtError, [mbOk], 0); - exit; - end; + Alpha := 1.0 - StrToFloat(AlphaEdit.Text); - 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; + // Prepare charts + if PlotSlopesChk.Checked then + PrepareChart(FSlopesChartFrame, 'Slopes', 'Time', 'Measure'); + SlopesPlotPage.TabVisible := PlotSlopesChk.Checked; - Standardize := StandardizeChk.Checked; - Plot := PlotChk.Checked; - SlopePlot := SlopesChk.Checked; - AvgSlope := AvgSlopeChk.Checked; + if PlotRankedSlopesChk.Checked then + PrepareChart(FRankedSlopesChartFrame, 'Ranked Slopes', 'Rank', 'Slope'); + RankedSlopesPlotPage.TabVisible := PlotRankedslopesChk.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); + // Get the data values from the grid, calc averages if needed. + GetData(RowLabels, ColLabels, NoSelected, selected, Values); - 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; + // Print data values + DisplayData(Values, NoSelected, RowLabels, ColLabels); lReport := TStringList.Create; + lSlopesReport := TStringList.Create; + lRankedReport := 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; + // Standardize if more than one variable and standardization are selected + if (noSelected > 1) and StandardizeChk.Checked then + StandardizeValuesAndDisplay(Values, selected, NoSelected, lReport); - for j := 0 to noselected-1 do + // Get interval slopes + if AvgSlopeChk.Checked then + no2do := NoSelected + 1 + else + no2do := NoSelected; + + for j := 0 to no2do-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 j < NoSelected then + lTitle := OS3MainFrm.DataGrid.Cells[selected[j], 0] + else + lTitle := 'Combined scores'; - if PrtDataChk.Checked then - begin - outline := 'CASE'; - MatPrint(Values, NoCases, noselected, outline, RowLabels, ColLabels, NoCases, lReport); - lReport.Add(DIVIDER); - lReport.Add(''); - end; + // Calculate slopes + ProcessSlopes(lSlopesReport, j, Values, RowLabels, ColLabels, lTitle, Slopes); - // 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; + // Get ranked slopes and median estimator + ProcessRankedQ(lRankedReport, Slopes, lTitle, RankedQ); + count := Length(RankedQ); - // average the values if elected - if AvgSlope then - for i := 0 to NoCases - 1 do - Values[i, noselected] := Values[i,noselected] / noselected; + // Get median slope + MedianSlope := GetMedianSlope(RankedQ); - // 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 + // Get Mann-Kendall statistic based on tied values + GetMannKendall(j, Values, MannKendall, q); + 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]); + 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); // ??? wp: This is the same as in the line above + end; // show results + lReport.Add(''); + lReport.Add(DIVIDER_SMALL_AUTO); + lReport.Add(''); if j < noselected then - lReport.Add('Results for %s', [cellstring]) - else - lReport.Add('Results for Averaged Values'); + begin + col := Selected[j]; + lReport.Add('RESULTS FOR %s', [lTitle]); + end else + begin + col := 0; + lReport.Add('RESULTS FOR AVERAGED VALUES'); + end; + lReport.Add(''); - if (noselected > 1) and Standardize then + if (NoSelected > 1) and StandardizeChk.Checked then begin mean := 0.0; stddev := 0.0; @@ -395,107 +292,46 @@ begin stddev := stddev / (NoCases - 1); stddev := sqrt(stddev); mean := mean / NoCases; - lReport.Add('Mean: %8.3f, Standard Deviation = %8.3f', [mean, stddev]); + 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(''); + lReport.Add( 'Median Slope for %d values: %8.3f', [count, MedianSlope]); + if MannKendall > 0 then begin + lReport.Add('Mann-Kendall Variance statistic: %8.3f (%d ties)', [MannKendall, q]); + lReport.Add('Ranks of the lower and upper confidence: %8.3f ... %.3f', [M1, M2+1]); + if (low > 0) or (hi <= count) then + lReport.Add('Corresponding lower and upper slopes: %8.3f and %.3f', [RankedQ[low], RankedQ[hi]]) + else + lReport.Add('INDEX ERROR: low rank = %d, hi rank = %d', [low, hi]); + end else + lReport.Add('ERROR: z = %.3f, Mann-Kendall = %.3f', [Z, MannKendall]); // plot slopes if elected - if Plot then + if PlotSlopesChk.Checked 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; + if j = NoSelected then lTitle := 'Average values'; + PlotSlopes(j, Values, lTitle); 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; + // Plot ranked slopes if elected + if PlotRankedSlopesChk.Checked then + PlotRankedSlopes(j, RankedQ,lTitle); - GraphFrm.Ypoints := nil; - GraphFrm.Xpoints := nil; - end; - - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); end; // next variable j - if AvgSlope then + // Average multiple measures + if AvgSlopeChk.Checked then + begin + SetLength(AvgSlopes, NoCases, NoCases); 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 + // Get ranked slopes and median estimator count := 0; for i := 0 to NoCases-2 do begin @@ -505,19 +341,16 @@ begin 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]); + SortOnX(RankedQ); - // get median slope + // Get median slope half := count div 2; - if (2 * half) < count then // again: should be "odd(count)" + if odd(count) then MedianSlope := RankedQ[half + 1] else MedianSlope := (RankedQ[half] + RankedQ[half+1]) / 2.0; - // get Mann-Kendall statistic based on tied values + // Get Mann-Kendall statistic based on tied values MannKendall := 0.0; q := 0; i := -1; @@ -542,35 +375,182 @@ begin 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; + if MannKendall >= 0.0 then + begin + C := Z * sqrt(MannKendall); + M1 := (count - C) / 2.0; + M2 := (count + C) / 2.0; + 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); + end; // 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]); + lReport.Add(''); + lReport.Add(DIVIDER_AUTO); + lReport.Add( ''); + lReport.Add( 'RESULTS FOR AVERAGED SLOPES'); + lReport.Add( ''); + lReport.Add( 'Median Slope for %3d values: %8.3f for averaged measures', [count, MedianSlope]); - 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 + if MannKendall >= 0 then + begin + lReport.Add('Mann-Kendall Variance statistic: %8.3f (%d ties observed)', [MannKendall, q]); + lReport.Add('Ranks of the lower and upper confidence: %8.3f ... %.3f', [M1, M2]); + lReport.Add('Corresponding lower and upper slopes: %8.3f and %.3f)', [RankedQ[low],RankedQ[hi]]); + end else + lReport.Add('ERROR in calculating Mann-Kendall: %.3f. Cannot be negative.', [MannKendall]); + end; FReportFrame.DisplayReport(lReport); + FSlopesReportFrame.DisplayReport(lSlopesReport); + FRankedSlopesReportFrame.DisplayReport(lRankedReport); finally lReport.Free; + lSlopesReport.Free; + lRankedReport.Free; end; end; +procedure TSensForm.DisplayData(const AValues: DblDyneMat; ANumSelected: Integer; + const ARowLabels, AColLabels: StrDyneVec); +var + lReport: TStrings; +begin + DataPage.TabVisible := PrtDataChk.Checked; + if PrtDataChk.Checked then + begin + lReport := TStringList.Create; + try + MatPrint(AValues, NoCases, ANumSelected, 'CASE', ARowLabels, AColLabels, NoCases, lReport); + FDataReportFrame.DisplayReport(lReport); + finally + lReport.Free; + end; + end; +end; + + +procedure TSensForm.GetData(out ARowLabels, AColLabels: StrDyneVec; + out ANumSelected: Integer; out ASelected: IntDyneVec; + out AValues: DblDyneMat); +var + i, j, col: Integer; +begin + ARowLabels := nil; + AColLabels := nil; + SetLength(ARowLabels, NoCases); + SetLength(AColLabels, NoCases); + for i := 0 to NoCases-1 do + begin + ARowLabels[i] := OS3MainFrm.DataGrid.Cells[0 ,i+1]; + AColLabels[i] := ARowLabels[i]; + end; + + ANumSelected := SelectedList.Items.Count; + + // Get indices of selected variables + ASelected := nil; + SetLength(ASelected, ANumSelected); + for i := 0 to ANumSelected-1 do + ASelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, SelectedList.Items[i]); + + // Get the data + AValues := nil; + SetLength(AValues, NoCases, ANumSelected+1); // +1 for AvgSlope + + for j := 0 to ANumSelected-1 do + begin + col := ASelected[j]; + for i := 0 to NoCases-1 do + begin + AValues[i, j] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, i+1])); + if AvgSlopeChk.Checked then + AValues[i, ANumSelected] := AValues[i, ANumSelected] + AValues[i, j]; + end; + end; + + // average the values if elected + if AvgSlopeChk.Checked then + for i := 0 to NoCases - 1 do + AValues[i, ANumSelected] := AValues[i, ANumSelected] / ANumSelected; +end; + + +procedure TSensForm.GetMannKendall(AIndex: Integer; const AValues: DblDyneMat; + out MannKendall: Double; out ANumTies: Integer); +var + i, k, q, tp: Integer; + sorted: DblDyneVec; +begin + SetLength(sorted, NoCases); + for i := 0 to NoCases-1 do + sorted[i] := AValues[i, AIndex]; + SortOnX(sorted); + + 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; + MannKendall := (NoCases * (NoCases-1) * (2 * NoCases + 5) - MannKendall) / 18.0; + ANumTies := q; +end; + + +function TSensForm.GetMedianSlope(ARankedQ: DblDyneVec): Double; +var + half, count: Integer; +begin + count := Length(ARankedQ); + half := count div 2; + if odd(count) then + Result := ARankedQ[half] + else + Result := (ARankedQ[half-1] + ARankedQ[half]) * 0.5; +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.OutBtnClick(Sender: TObject); var i: integer; @@ -589,6 +569,149 @@ begin UpdateBtnStates; end; + +// Plot slopes +procedure TSensForm.PlotSlopes(AIndex: Integer; const AValues: DblDyneMat; ATitle: String); +var + ser: TChartSeries; + i: Integer; +begin + ser := FSlopesChartFrame.PlotXY(ptLinesAndSymbols, nil, nil, nil, nil, ATitle, + DATA_COLORS[AIndex mod Length(DATA_COLORS)]); + for i := 0 to NoCases - 1 do + ser.AddXY(i+1, AValues[i, AIndex]); +end; + + +procedure TSensForm.PlotRankedSlopes(AIndex: Integer; const ARankedQ: DblDyneVec; + ATitle: String); +var + ser: TChartSeries; + i, count: Integer; +begin + count := Length(ARankedQ); + ser := FRankedSlopesChartFrame.PlotXY(ptLines, nil, nil, nil, nil, ATitle, + DATA_COLORS[AIndex mod Length(DATA_COLORS)]); + for i := 0 to count-1 do + ser.AddXY(i+1, ARankedQ[i]); +end; + + +procedure TSensForm.PrepareChart(AChartFrame: TChartFrame; + ATitle, XTitle, YTitle: String); +begin + AChartFrame.Clear; + AChartFrame.SetTitle(ATitle); + AChartFrame.SetXTitle(XTitle); + AChartFrame.SetYTitle(YTitle); +end; + + +procedure TSensForm.ProcessRankedQ(AReport: TStrings; const ASlopes: DblDyneMat; + const ATitle: String; out ARankedQ: DblDyneVec); +var + count: Integer; + i, k: Integer; +begin + ARankedQ := nil; + SetLength(ARankedQ, 500); // prelimiary dimension to some length, trim later. + + count := 0; + for i := 0 to NoCases-2 do + for k := i+1 to NoCases-1 do + begin + ARankedQ[count] := ASlopes[i, k]; + count := count + 1; + if count = Length(ARankedQ) then + SetLength(ARankedQ, Length(ARankedQ) + 500); + end; + + // Trim to length needed. + SetLength(ARankedQ, count); + + // Sort into ascending order + SortOnX(ARankedQ); + + if PrtRanksChk.Checked then + begin + AReport.Add('RANKED SLOPES FOR ' + ATitle); + AReport.Add(''); + AReport.Add(' Label Ranked Q'); + AReport.Add('---------- ----------'); + for i := 0 to count-1 do + AReport.Add('%8d %9.4f', [i+1, ARankedQ[i]]); + + AReport.Add(''); + AReport.Add(DIVIDER_SMALL_AUTO); + AReport.Add(''); + end; + + RankedSlopesPage.TabVisible := PrtRanksChk.Checked; +end; + + +procedure TSensForm.ProcessSlopes(AReport: TStrings; AIndex: Integer; + const AValues: DblDyneMat; const ARowLabels, AColLabels: StrDyneVec; + const ATitle: String; out ASlopes: DblDyneMat); +var + i, k: Integer; +begin + ASlopes := nil; + SetLength(ASlopes, NoCases, NoCases); + + for i := 0 to NoCases-2 do + for k := i + 1 to NoCases-1 do + ASlopes[i,k] := (AValues[k, AIndex] - AValues[i, AIndex]) / (k-i); + + if PrtSlopesChk.Checked then + begin + MatPrint(ASlopes, NoCases, NoCases, ATitle, ARowLabels, AColLabels, NoCases, AReport); + AReport.Add(''); + AReport.Add(DIVIDER_SMALL_AUTO); + AReport.Add(''); + end; + + SlopesMatrixPage.TabVisible := PrtSlopesChk.Checked; +end; + + +procedure TSensForm.Reset; +var + i: integer; +begin + inherited; + + DataPage.TabVisible := false; + SlopesMatrixPage.TabVisible := false; + RankedSlopesPage.TabVisible := false; + SlopesPlotPage.TabVisible := false; + RankedSlopesPlotPage.TabVisible := false; + + if FDataReportFrame <> nil then + FDataReportFrame.Clear; + if FSlopesReportFrame <> nil then + FSlopesReportFrame.Clear; + if FRankedSlopesReportFrame <> nil then + FRankedSlopesReportFrame.Clear; + + if FSlopesChartFrame <> nil then + FSlopesChartFrame.Clear; + if FRankedSlopesChartFrame <> nil then + FRankedSlopesChartFrame.Clear; + + AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + StandardizeChk.Checked := false; + PlotSlopesChk.Checked := false; + PlotRankedSlopesChk.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.SelectedListDblClick(Sender: TObject); var index: Integer; @@ -603,15 +726,92 @@ begin end; +procedure TSensForm.StandardizeValuesAndDisplay(AValues: DblDyneMat; + ASelected: IntDyneVec; ANumSelected: Integer; AReport: TStrings); +var + i, j: Integer; + mean, stddev: Double; + col: Integer; +begin + AReport.Add(''); + AReport.Add(' Variable Mean Std.Dev. '); + AReport.Add('------------ ---------- ----------'); + + for j := 0 to ANumSelected-1 do + begin + mean := 0.0; + stddev := 0.0; + for i := 0 to NoCases-1 do + begin + mean := mean + AValues[i, j]; + stddev := stddev + sqr(AValues[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 + AValues[i,j] := (AValues[i,j] - mean) / stddev; + + col := ASelected[j]; + AReport.Add('%12s %10.3f %10.3f', [OS3MainFrm.DataGrid.Cells[col, 0], mean, stddev]); + end; +end; + + procedure TSensForm.UpdateBtnStates; begin inherited; + + if FDataReportFrame <> nil then + FDataReportFrame.UpdateBtnStates; + if FSlopesReportFrame <> nil then + FSlopesReportFrame.UpdateBtnStates; + if FRankedSlopesReportFrame <> nil then + FRankedSlopesReportFrame.UpdateBtnStates; + + if FSlopesChartFrame <> nil then + FSlopesChartFrame.UpdateBtnStates; + if FRankedSlopesChartFrame <> nil then + FRankedSlopesChartFrame.UpdateBtnStates; + InBtn.Enabled := AnySelected(VarList); OutBtn.Enabled := AnySelected(SelectedList); AllBtn.Enabled := Varlist.Items.Count > 0; end; +function TSensForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; +begin + Result := false; + + if SelectedList.Items.Count = 0 then + begin + AMsg := 'First select variables to analyze.'; + AControl := SelectedList; + exit; + end; + + if AlphaEdit.Text = '' then begin + AControl := AlphaEdit; + AMsg := 'Input required.'; + exit; + end; + + if not TryStrToFloat(AlphaEdit.Text, x) or (x <= 0) or (x >= 1) then + begin + AControl := AlphaEdit; + AMsg := 'Numeric value required in range > 0 and < 1.'; + exit; + end; + + Result := true; +end; + + procedure TSensForm.VarListDblClick(Sender: TObject); var index: Integer; @@ -631,5 +831,6 @@ begin UpdateBtnStates; end; + end. diff --git a/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas index adf9563f8..ac975f88f 100644 --- a/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas +++ b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas @@ -31,6 +31,7 @@ type procedure XOutClick(Sender: TObject); procedure YInClick(Sender: TObject); procedure YOutClick(Sender: TObject); + private protected diff --git a/applications/lazstats/source/forms/mainunit.lfm b/applications/lazstats/source/forms/mainunit.lfm index 116c9874d..8f1684b68 100644 --- a/applications/lazstats/source/forms/mainunit.lfm +++ b/applications/lazstats/source/forms/mainunit.lfm @@ -881,7 +881,7 @@ object OS3MainFrm: TOS3MainFrm OnClick = mnuAnalysisNonPar_KSTestClick end object mnuAnalysisNonPar_SRH: TMenuItem - Caption = 'Scheirer-Ray-Hart 2-way ANOVA' + Caption = 'Scheirer-Ray-Hare 2-way ANOVA' OnClick = mnuAnalysisNonPar_SRHClick end object mnuAnalysisNonPar_LifeTable: TMenuItem diff --git a/applications/lazstats/source/forms/mainunit.pas b/applications/lazstats/source/forms/mainunit.pas index 0de7547b2..7f9722feb 100644 --- a/applications/lazstats/source/forms/mainunit.pas +++ b/applications/lazstats/source/forms/mainunit.pas @@ -1911,7 +1911,7 @@ begin SimpleChiSqrForm.ShowModal; end; -// Menu "Analysis" > "Nonparametric" > "Schreier-Ray-Heart Two-Way mnuAnalysisComp_Anova" +// Menu "Analysis" > "Nonparametric" > "Schreier-Ray-Hare Two-Way ANOVA" procedure TOS3MainFrm.mnuAnalysisNonPar_SRHClick(Sender: TObject); begin if SRHTest = nil then diff --git a/applications/lazstats/source/units/dataprocs.pas b/applications/lazstats/source/units/dataprocs.pas index 894579fc2..13f84decc 100644 --- a/applications/lazstats/source/units/dataprocs.pas +++ b/applications/lazstats/source/units/dataprocs.pas @@ -223,10 +223,8 @@ end; procedure SaveOS2File; var F: TextFile; - filename: string; - s: string; - NRows, NCols: integer; - i, j: integer; + filename, s: string; + i, j, res, NRows, NCols: integer; begin // check for valid cases - at least one value entered NRows := StrToInt(OS3MainFrm.NoCasesEdit.Text); @@ -248,6 +246,12 @@ begin if OS3MainFrm.SaveDialog.Execute then begin filename := ExpandFileName(OS3MainFrm.SaveDialog.FileName); + if FileExists(filename) then + begin + res := MessageDlg(Format('File "%s" already exists. Overwrite?', [filename]), mtConfirmation, [mbYes, mbNo], 0); + if res <> mrYes then + exit; + end; OS3MainFrm.FileNameEdit.Text := filename; AssignFile(F, filename); Rewrite(F);