From a6ac93ef34c5ad997d1a8daaad02b3b8af12f803 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 13 Nov 2020 13:16:59 +0000 Subject: [PATCH] LazStats: Refactor ABCNestedUnit git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7865 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../analysis/comparisons/abcnestedunit.lfm | 8 +- .../analysis/comparisons/abcnestedunit.pas | 453 ++++++++++-------- .../analysis/comparisons/blkanovaunit.pas | 16 +- .../lazstats/source/forms/mainunit.pas | 4 +- .../lazstats/source/units/anovatestsunit.pas | 42 -- .../lazstats/source/units/matrixunit.pas | 155 +++++- 6 files changed, 425 insertions(+), 253 deletions(-) diff --git a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm index 5a828a0cd..2afcda621 100644 --- a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm +++ b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm @@ -377,12 +377,12 @@ inherited ABCNestedForm: TABCNestedForm inherited ReportPage: TTabSheet Caption = 'ANOVA Results' end - object MeansPage: TTabSheet[1] - Caption = 'Means' - end - inherited ChartPage: TTabSheet[2] + inherited ChartPage: TTabSheet Caption = 'Plots' end + object MeansPage: TTabSheet[2] + Caption = 'Means' + end end object ChartStyles: TChartStyles[3] Styles = <> diff --git a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas index 4b5127e72..103d1a5d0 100644 --- a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas +++ b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas @@ -73,19 +73,20 @@ type ACount, BCount, CCount : IntDyneVec; ACCount, ABCount : IntDyneMat; CellSDs, SS, SumSqr, CellMeans : DblDyneCube; - MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer; - CCol, MinC, MaxC, NoCLevels : integer; + MinA, MaxA, NoALevels: Integer; + MinB, MaxB, NoBLevels: Integer; //ACol, BCol, CCol, YCol : integer; + MinC, MaxC, NoCLevels: integer; SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double; SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double; TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer; - ColNoSelected: IntDyneVec; +// ColNoSelected: IntDyneVec; AMeans, BMeans, CMeans: DblDyneVec; ABMeans, ACMeans: DblDyneMat; - function GetVariables: Boolean; + function GetVariables(out AValues, BValues, CValues, DepValues: DblDyneVec): Boolean; procedure GetMemory; - procedure GetSums; + procedure GetSums(const AValues, BValues, CValues, DepValues: DblDyneVec); procedure ShowMeans; procedure GetResults; procedure ShowResults; @@ -106,6 +107,7 @@ type 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; @@ -122,7 +124,7 @@ implementation uses TAChartUtils, TACustomSource, TALegend, TASeries, - Utils, Math, MathUnit, ChartFrameUnit; + Utils, Math, MathUnit, MatrixUnit, GridProcs, ChartFrameUnit; { TABCNestedForm } @@ -236,11 +238,16 @@ end; procedure TABCNestedForm.Compute; +var + dataA: DblDyneVec = nil; + dataB: DblDyneVec = nil; + dataC: DblDyneVec = nil; + dataDep: DblDyneVec = nil; begin - if GetVariables then + if GetVariables(dataA, dataB, dataC, dataDep) then begin GetMemory; - GetSums; + GetSums(dataA, dataB, dataC, dataDep); ShowMeans; GetResults; ShowResults; @@ -319,13 +326,73 @@ begin end; -function TABCNestedForm.GetVariables: Boolean; +function TABCNestedForm.GetVariables( + out AValues, BValues, CValues, DepValues: DblDyneVec): Boolean; var - i, group: integer; - strvalue, cellstring: string; + ColNoSelected: IntDyneVec = nil; + mn, mx: Double; + msg: String; begin Result := false; + SetLength(ColNoSelected, 4); + ColNoSelected[0] := GetVariableIndex(OS3MainFrm.DataGrid, FactorAEdit.Text); // A + ColNoSelected[1] := GetVariableIndex(OS3MainFrm.DataGrid, FactorBEdit.Text); // B + ColNoSelected[2] := GetVariableIndex(OS3MainFrm.DataGrid, FactorCEdit.Text); // C + ColNoSelected[3] := GetVariableindex(OS3MainFrm.DataGrid, DepEdit.Text); // Dependent + + AValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[0], ColNoSelected); + if not CheckFactorCodes(FactorAEdit.Text, AValues, msg) then + begin + ErrorMsg(msg); + exit; + end; + + BValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[1], ColNoSelected); + if not CheckFactorCodes(FactorBEdit.Text, BValues, msg) then + begin + ErrorMsg(msg); + exit; + end; + + CValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[2], ColNoSelected); + if not CheckFactorCodes(FactorCEdit.Text, CValues, msg) then + begin + ErrorMsg(msg); + exit; + end; + + DepValues := CollectVecValues(OS3MainFrm.DataGrid, ColNoSelected[3], ColNoSelected); + + if (Length(DepValues) <> Length(AValues)) or + (Length(DepValues) <> Length(BValues)) or + (Length(DepValues) <> Length(CValues)) then + begin + ErrorMsg('All variables must contain equal amounts of cases.'); + exit; + end; + + VecMaxMin(AValues, mx, mn); + MaxA := round(mx); + MinA := round(mn); + + VecMaxMin(BValues, mx, mn); + MaxB := round(mx); + MinB := round(mn); + + VecMaxMin(CValues, mx, mn); + MaxC := round(mx); + MinC := round(mn); + + NoALevels := MaxA - MinA + 1; + NoBLevels := MaxB - MinB + 1; + NoCLevels := MaxC - MinC + 1; + + Result := true; +end; + +(* + SetLength(ColNoSelected, 4); ACol := -1; BCol := -1; @@ -392,218 +459,165 @@ begin Result := true; end; +*) - +{ Allocates memory for all arrays needed. Setting the dynamic arrays to nil + before allocation automatically resets the array contents. } procedure TABCNestedForm.GetMemory; begin - SetLength(SS,NoBLevels,NoALevels,NoCLevels); - SetLength(SumSqr,NoBLevels,NoALevels,NoCLevels); - SetLength(CellCount,NoBLevels,NoALevels,NoCLevels); - SetLength(CellMeans,NoBLevels,NoALevels,NoCLevels); - SetLength(CellSDs,NoBLevels,NoALevels,NoCLevels); - SetLength(ASS,NoALevels); - SetLength(BSS,NoBLevels); - SetLength(CSS,NoCLevels); - SetLength(ASumSqr,NoALevels); - SetLength(BSumSqr,NoBLevels); - SetLength(CSumSqr,NoCLevels); - SetLength(AMeans,NoALevels); - SetLength(BMeans,NoBLevels); - SetLength(CMeans,NoCLevels); - SetLength(ACount,NoALevels); - SetLength(BCount,NoBLevels); - SetLength(CCount,NoCLevels); - SetLength(ASDs,NoALevels); - SetLength(BSDs,NoBLevels); - SetLength(CSDs,NoCLevels); - SetLength(ACSS,NoALevels,NoCLevels); - SetLength(ACSumSqr,NoALevels,NoCLevels); - SetLength(ACCount,NoALevels,NoCLevels); - SetLength(ACMeans,NoALevels,NoCLevels); - SetLength(ACSDs,NoALevels,NoCLevels); - SetLength(ABSS,NoALevels,NoBLevels); - SetLength(ABSumSqr,NoALevels,NoBLevels); - SetLength(ABMeans,NoALevels,NoBLevels); - SetLength(ABCount,NoALevels,NoBLevels); - SetLength(ABSDs,NoALevels,NoBLevels); + SS := CubeCreate(NoBLevels, NoALevels, NoCLevels); + SumSqr := CubeCreate(NoBLevels, NoALevels, NoCLevels); + CellCount := IntCubeCreate(NoBLevels, NoALevels, NoCLevels); + CellMeans := CubeCreate(NoBLevels, NoALevels, NoCLevels); + CellSDs := CubeCreate(NoBLevels, NoALevels, NoCLevels); + ASS := VecCreate(NoALevels); + BSS := VecCreate(NoBLevels); + CSS := VecCreate(NoCLevels); + ASumSqr := VecCreate(NoALevels); + BSumSqr := VecCreate(NoBLevels); + CSumSqr := VecCreate(NoCLevels); + AMeans := VecCreate(NoALevels); + BMeans := VecCreate(NoBLevels); + CMeans := VecCreate(NoCLevels); + ACount := IntVecCreate(NoALevels); + BCount := IntVecCreate(NoBLevels); + CCount := IntVecCreate(NoCLevels); + ASDs := VecCreate(NoALevels); + BSDs := VecCreate(NoBLevels); + CSDs := VecCreate(NoCLevels); + ACSS := MatCreate(NoALevels, NoCLevels); + ACSumSqr := MatCreate(NoALevels, NoCLevels); + ACCount := IntMatCreate(NoALevels, NoCLevels); + ACMeans := MatCreate(NoALevels, NoCLevels); + ACSDs := MatCreate(NoALevels, NoCLevels); + ABSS := MatCreate(NoALevels, NoBLevels); + ABSumSqr := MatCreate(NoALevels, NoBLevels); + ABMeans := MatCreate(NoALevels, NoBLevels); + ABCount := IntMatCreate(NoALevels, NoBLevels); + ABSDs := MatCreate(NoALevels,NoBLevels); end; -procedure TABCNestedForm.GetSums; +procedure TABCNestedForm.GetSums(const AValues, BValues, CValues, DepValues: DblDyneVec); VAR Aindex, Bindex, Cindex, i, j, k: integer; - YValue: double; - strvalue: string; + YValue, YValueSqr: double; begin // clear memory SSTot := 0.0; SumSqrTot := 0.0; - for i := 0 to NoBLevels-1 do - begin - for j := 0 to NoALevels-1 do - begin - for k := 0 to NoCLevels-1 do - begin - SS[i,j,k] := 0.0; - SumSqr[i,j,k] := 0.0; - CellCount[i,j,k] := 0; - CellMeans[i,j,k] := 0.0; - end; - end; - end; + TotN := 0; - for i := 0 to NoALevels-1 do - begin - ACount[i] := 0; - AMeans[i] := 0.0; - ASS[i] := 0.0; - ASumSqr[i] := 0.0; - end; - for j := 0 to NoBLevels-1 do - begin - BCount[j] := 0; - BMeans[j] := 0.0; - BSS[j] := 0.0; - BSumSqr[j] := 0.0; - end; - for k := 0 to NoCLevels-1 do - begin - CCount[k] := 0; - CMeans[k] := 0.0; - CSS[k] := 0.0; - CSumSqr[k] := 0.0; - end; + // Accumulate sums and sums of squared values + for i := 0 to High(DepValues) do + begin + AIndex := round(AValues[i]) - MinA; + BIndex := round(BValues[i]) - MinB; + CIndex := round(CValues[i]) - MinC; + YValue := DepValues[i]; + YValueSqr := YValue * YValue; - for i := 0 to NoALevels-1 do - begin - for j := 0 to NoBLevels-1 do - begin - ABSS[i,j] := 0.0; - ABSumSqr[i,j] := 0.0; - ABCount[i,j] := 0; - ABSDs[i,j] := 0.0; - end; - end; - for i := 0 to NoALevels-1 do - begin - for k := 0 to NoCLevels-1 do - begin - ACSS[i,k] := 0.0; - ACSumSqr[i,k] := 0.0; - ACCount[i,k] := 0; - ACSDs[i,k] := 0.0; - end; - end; + SS[Bindex,Aindex,Cindex] := SS[Bindex,Aindex,Cindex] + YValueSqr; + SumSqr[Bindex,Aindex,Cindex] := SumSqr[Bindex,Aindex,Cindex] + YValue; // wp: why no square? + CellCount[Bindex,Aindex,Cindex] := CellCount[Bindex,Aindex,Cindex] + 1; + ACount[Aindex] := ACount[Aindex] + 1; + BCount[Bindex] := BCount[Bindex] + 1; + CCount[Cindex] := CCount[Cindex] + 1; + ASS[Aindex] := ASS[Aindex] + YValueSqr; + BSS[Bindex] := BSS[Bindex] + YValueSqr; + CSS[Cindex] := CSS[Cindex] + YValueSqr; + ASumSqr[Aindex] := ASumSqr[Aindex] + YValue; + BSumSqr[Bindex] := BSumSqr[Bindex] + YValue; + CSumSqr[Cindex] := CSumSqr[Cindex] + YValue; + ACSS[Aindex,Cindex] := ACSS[Aindex,Cindex] + YValueSqr; + ACSumSqr[Aindex,Cindex] := ACSumSqr[Aindex,Cindex] + YValue; + ACCount[Aindex,Cindex] := ACCount[Aindex,Cindex] + 1; + ABSS[Aindex,Bindex] := ABSS[Aindex,Bindex] + YValueSqr; + ABSumSqr[Aindex,Bindex] := ABSumSqr[Aindex,Bindex] + YValue; + ABCount[Aindex,Bindex] := ABCount[Aindex,Bindex] + 1; + SSTot := SSTot + YValueSqr; + SumSqrTot := SumSqrTot + YValue; + TotN := TotN + 1; + end; - // accumulate sums and sums of squared values - for i := 1 to NoCases do - begin - strvalue := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); - Aindex := round(StrToFloat(strvalue)); - strvalue := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); - Bindex := round(StrToFloat(strvalue)); - strvalue := Trim(OS3MainFrm.DataGrid.Cells[CCol,i]); - Cindex := round(StrToFloat(strvalue)); - strvalue := Trim(OS3MainFrm.DataGrid.Cells[YCol,i]); - YValue := StrToFloat(strvalue); - Aindex := Aindex - MinA; - Bindex := Bindex - MinB; - Cindex := Cindex - MinC; - SS[Bindex,Aindex,Cindex] := SS[Bindex,Aindex,Cindex] + YValue * YValue; - SumSqr[Bindex,Aindex,Cindex] := SumSqr[Bindex,Aindex,Cindex] + YValue; - CellCount[Bindex,Aindex,Cindex] := CellCount[Bindex,Aindex,Cindex] + 1; - ACount[Aindex] := ACount[Aindex] + 1; - BCount[Bindex] := BCount[Bindex] + 1; - CCount[Cindex] := CCount[Cindex] + 1; - ASS[Aindex] := ASS[Aindex] + YValue * YValue; - BSS[Bindex] := BSS[Bindex] + YValue * YValue; - CSS[Cindex] := CSS[Cindex] + YValue * YValue; - ASumSqr[Aindex] := ASumSqr[Aindex] + YValue; - BSumSqr[Bindex] := BSumSqr[Bindex] + YValue; - CSumSqr[Cindex] := CSumSqr[Cindex] + YValue; - ACSS[Aindex,Cindex] := ACSS[Aindex,Cindex] + YValue * YValue; - ACSumSqr[Aindex,Cindex] := ACSumSqr[Aindex,Cindex] + YValue; - ACCount[Aindex,Cindex] := ACCount[Aindex,Cindex] + 1; - ABSS[Aindex,Bindex] := ABSS[Aindex,Bindex] + YValue * YValue; - ABSumSqr[Aindex,Bindex] := ABSumSqr[Aindex,Bindex] + YValue; - ABCount[Aindex,Bindex] := ABCount[Aindex,Bindex] + 1; - SSTot := SSTot + YValue * YValue; - SumSqrTot := SumSqrTot + YValue; - TotN := TotN + 1; - end; - - // get cell means and marginal means plus square of sums + // Get cell means and marginal means plus square of sums for i := 0 to NoBLevels-1 do + begin + for j := 0 to NoALevels-1 do + begin + for k := 0 to NoCLevels-1 do begin - for j := 0 to NoALevels-1 do - begin - for k := 0 to NoCLevels-1 do - begin - if CellCount[i,j,k] > 0 then - begin - CellMeans[i,j,k] := SumSqr[i,j,k] / CellCount[i,j,k]; - SumSqr[i,j,k] := SumSqr[i,j,k] * SumSqr[i,j,k]; - CellSDs[i,j,k] := SS[i,j,k] - (SumSqr[i,j,k] / CellCount[i,j,k]); - CellSDs[i,j,k] := CellSDs[i,j,k] / (CellCount[i,j,k] - 1); - CellSDs[i,j,k] := sqrt(CellSDs[i,j,k]); - end; - end; - end; + if CellCount[i,j,k] > 0 then + begin + CellMeans[i,j,k] := SumSqr[i,j,k] / CellCount[i,j,k]; + SumSqr[i,j,k] := SumSqr[i,j,k] * SumSqr[i,j,k]; + CellSDs[i,j,k] := SS[i,j,k] - (SumSqr[i,j,k] / CellCount[i,j,k]); + CellSDs[i,j,k] := CellSDs[i,j,k] / (CellCount[i,j,k] - 1); + CellSDs[i,j,k] := sqrt(CellSDs[i,j,k]); + end; end; + end; + end; + for i := 0 to NoBLevels-1 do - begin - if BCount[i] > 0 then - begin - BMeans[i] := BSumSqr[i] / BCount[i]; - BSumSqr[i] := BSumSqr[i] * BSumSqr[i]; - BSDs[i] := BSS[i] - (BSumSqr[i] / BCount[i]); - BSDs[i] := BSDs[i] / (BCount[i] - 1); - BSDs[i] := sqrt(BSDs[i]); - end; - end; + begin + if BCount[i] > 0 then + begin + BMeans[i] := BSumSqr[i] / BCount[i]; + BSumSqr[i] := BSumSqr[i] * BSumSqr[i]; + BSDs[i] := BSS[i] - (BSumSqr[i] / BCount[i]); + BSDs[i] := BSDs[i] / (BCount[i] - 1); + BSDs[i] := sqrt(BSDs[i]); + end; + end; + for i := 0 to NoALevels-1 do - begin - AMeans[i] := ASumSqr[i] / ACount[i]; - ASumSqr[i] := ASumSqr[i] * ASumSqr[i]; - ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]); - ASDs[i] := ASDs[i] / (ACount[i] - 1); - ASDs[i] := Sqrt(ASDs[i]); - end; + begin + AMeans[i] := ASumSqr[i] / ACount[i]; + ASumSqr[i] := ASumSqr[i] * ASumSqr[i]; + ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]); + ASDs[i] := ASDs[i] / (ACount[i] - 1); + ASDs[i] := Sqrt(ASDs[i]); + end; + for i := 0 to NoCLevels-1 do - begin - CMeans[i] := CSumSqr[i] / CCount[i]; - CSumSqr[i] := CSumSqr[i] * CSumSqr[i]; - CSDs[i] := CSS[i] - (CSumSqr[i] / CCount[i]); - CSDs[i] := CSDs[i] / (CCount[i] - 1); - CSDs[i] := sqrt(CSDs[i]); - end; + begin + CMeans[i] := CSumSqr[i] / CCount[i]; + CSumSqr[i] := CSumSqr[i] * CSumSqr[i]; + CSDs[i] := CSS[i] - (CSumSqr[i] / CCount[i]); + CSDs[i] := CSDs[i] / (CCount[i] - 1); + CSDs[i] := sqrt(CSDs[i]); + end; + for i := 0 to NoALevels-1 do - begin - for k := 0 to NoCLevels-1 do - begin - ACMeans[i,k] := ACMeans[i,k] / ACCount[i,k]; - ACSumSqr[i,k] := ACSumSqr[i,k] * ACSumSqr[i,k]; - ACSDs[i,k] := ACSS[i,k] - (ACSumSqr[i,k] / ACCount[i,k]); - ACSDs[i,k] := ACSDs[i,k] / (ACCount[i,k] - 1); - ACSDs[i,k] := sqrt(ACSDs[i,k]); - end; - end; + begin + for k := 0 to NoCLevels-1 do + begin + ACMeans[i,k] := ACMeans[i,k] / ACCount[i,k]; + ACSumSqr[i,k] := ACSumSqr[i,k] * ACSumSqr[i,k]; + ACSDs[i,k] := ACSS[i,k] - (ACSumSqr[i,k] / ACCount[i,k]); + ACSDs[i,k] := ACSDs[i,k] / (ACCount[i,k] - 1); + ACSDs[i,k] := sqrt(ACSDs[i,k]); + end; + end; + for i := 0 to NoALevels-1 do - begin - for j := 0 to NoBLevels-1 do - begin - if ABCount[i,j] > 0 then - begin - ABMeans[i,j] := ABSumSqr[i,j] / ABCount[i,j]; - ABSumSqr[i,j] := ABSumSqr[i,j] * ABSumSqr[i,j]; - ABSDs[i,j] :=ABSS[i,j] - (ABSumSqr[i,j] / ABCount[i,j]); - ABSDs[i,j] := ABSDs[i,j] / (ABCount[i,j] - 1); - ABSDs[i,j] := sqrt(ABSDs[i,j]); - end; - end; - end; - TotMean := SumSqrTot / TotN; - SumSqrTot := SumSqrTot * SumSqrTot; + begin + for j := 0 to NoBLevels-1 do + begin + if ABCount[i,j] > 0 then + begin + ABMeans[i,j] := ABSumSqr[i,j] / ABCount[i,j]; + ABSumSqr[i,j] := ABSumSqr[i,j] * ABSumSqr[i,j]; + ABSDs[i,j] := ABSS[i,j] - (ABSumSqr[i,j] / ABCount[i,j]); + ABSDs[i,j] := ABSDs[i,j] / (ABCount[i,j] - 1); + ABSDs[i,j] := sqrt(ABSDs[i,j]); + end; + end; + end; + + TotMean := SumSqrTot / TotN; + SumSqrTot := SumSqrTot * SumSqrTot; end; @@ -829,7 +843,7 @@ end; procedure TABCNestedForm.ReleaseMemory; begin - ColNoSelected := nil; +// ColNoSelected := nil; ABSDs := nil; ABCount := nil; // ABMeans := nil; @@ -1259,6 +1273,43 @@ begin end; +function TABCNestedForm.Validate(out AMsg: String; + out AControl: TWinControl): Boolean; +begin + Result := false; + + if DepEdit.Text = '' then + begin + AMsg := 'Dependent variable not specified.'; + AControl := VarList; + exit; + end; + + if FactorAEdit.Text = '' then + begin + AMsg := 'Factor A variable not specified.'; + AControl := VarList; + exit; + end; + + if FactorBEdit.Text = '' then + begin + AMsg := 'Factor B variable not specified.'; + AControl := VarList; + exit; + end; + + if FactorCEdit.Text = '' then + begin + AMsg := 'Factor C variable not specified.'; + AControl := VarList; + exit; + end; + + Result := true; +end; + + procedure TABCNestedForm.VarListDblClick(Sender: TObject); var index: Integer; diff --git a/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas index ce53eac63..9343c74cb 100644 --- a/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas +++ b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas @@ -1159,6 +1159,7 @@ function TBlksAnovaForm.GetLevels( out DepValues, F1Values, F2Values, F3Values: DblDyneVec): Boolean; var mx, mn: Double; + msg: String; begin Result := false; @@ -1176,8 +1177,11 @@ begin MaxF1 := round(mx); MinF1 := round(mn); NF1Cells := MaxF1 - MinF1 + 1; - if not CheckFactorCodes(Factor1Edit.Text, F1Values) then + if not CheckFactorCodes(Factor1Edit.Text, F1Values, msg) then + begin + ErrorMsg(msg); exit; + end; // Extract factor 2 values when available if NoFactors >= 2 then @@ -1187,8 +1191,11 @@ begin MaxF2 := round(mx); MinF2 := round(mn); NF2Cells := MaxF2 - MinF2 + 1; - if not CheckFactorCodes(Factor2Edit.Text, F2Values) then + if not CheckFactorCodes(Factor2Edit.Text, F2Values, msg) then + begin + ErrorMsg(msg); exit; + end; end else NF2Cells := 0; @@ -1200,8 +1207,11 @@ begin MaxF3 := round(mx); MinF3 := round(mn); NF3Cells := MaxF3 - MinF3 + 1; - if not CheckFactorCodes(Factor3Edit.Text, F3Values) then + if not CheckFactorCodes(Factor3Edit.Text, F3Values, msg) then + begin + ErrorMsg(msg); exit; + end; end else NF3cells := 0; diff --git a/applications/lazstats/source/forms/mainunit.pas b/applications/lazstats/source/forms/mainunit.pas index 77c7ad63b..be0bd64c5 100644 --- a/applications/lazstats/source/forms/mainunit.pas +++ b/applications/lazstats/source/forms/mainunit.pas @@ -1864,7 +1864,7 @@ procedure TOS3MainFrm.mnuAnalysisComp_BinAClick(Sender: TObject); begin if BNestedAForm = nil then Application.CreateForm(TBNestedAForm, BNestedAForm); - BNestedAForm.ShowModal; + BNestedAForm.Show; end; // Menu "Analysis" > "Comparisons" > "Difference Between Correlations" @@ -1888,7 +1888,7 @@ procedure TOS3MainFrm.mnuAnalysisComp_NestedABCClick(Sender: TObject); begin if ABCNestedForm = nil then Application.CreateForm(TABCNestedForm, ABCNestedForm); - ABCNestedForm.ShowModal; + ABCNestedForm.Show; end; // Menu "Analysis" > "Comparisons" > "2 or 3 Way Anova with One Case Per Cell" diff --git a/applications/lazstats/source/units/anovatestsunit.pas b/applications/lazstats/source/units/anovatestsunit.pas index db0728ab3..fd71837a3 100644 --- a/applications/lazstats/source/units/anovatestsunit.pas +++ b/applications/lazstats/source/units/anovatestsunit.pas @@ -100,54 +100,12 @@ procedure HomogeneityTest( NoCases : integer ); -function CheckFactorCodes(AFactorName: String; const ACodes: DblDyneVec): Boolean; implementation uses Utils, MatrixUnit, MathUnit; -{ Checks whether the codes provided are integers and whether the codes are - consecutive, i.e. without gaps. } -function CheckFactorCodes(AFactorName: String; const ACodes: DblDyneVec): Boolean; -const - EPS = 1E-9; - NonIntegerError = 'Factor "%s" contains non-integer values.'; - NonConsecutiveError = 'Factor "%s" does not contain consecutive codes.'; -var - values: DblDyneVec; - i, prev, curr: Integer; -begin - Result := false; - values := VecCopy(ACodes); - SortOnX(values); - if abs(values[0] - trunc(values[0])) > EPS then - begin - ErrorMsg(NonIntegerError, [AFactorName]); - exit; - end; - prev := round(values[0]); - - for i := 1 to High(values) do - begin - if abs(values[i] - trunc(values[i])) > EPS then - begin - ErrorMsg(NonIntegerError, [AFactorName]); - exit; - end; - curr := round(values[i]); - if curr - prev > 1 then - begin - ErrorMsg(NonConsecutiveError, [AFactorName]); - exit; - end; - prev := curr; - end; - - Result := true; -end; - - procedure Tukey(error_ms : double; { mean squared for residual } error_df : double; { deg. freedom for residual } value : double; { size of smallest group } diff --git a/applications/lazstats/source/units/matrixunit.pas b/applications/lazstats/source/units/matrixunit.pas index 275c50cd4..7bcf4d2aa 100644 --- a/applications/lazstats/source/units/matrixunit.pas +++ b/applications/lazstats/source/units/matrixunit.pas @@ -11,10 +11,15 @@ uses Globals; type - TDblMatrix = DblDyneMat; TDblVector = DblDyneVec; + TDblMatrix = DblDyneMat; + TDblCube = DblDyneCube; + TDblQuad = DblDyneQuad; + TIntVector = IntDyneVec; TIntMatrix = IntDyneMat; + TIntCube = IntDyneCube; + TIntQuad = IntDyneQuad; EMatrix = class(Exception); @@ -28,6 +33,7 @@ operator * (A, B: TDblVector): Double; operator * (A: TDblVector; b: Double): TDblVector; operator * (a: Double; B: TDblVector): TDblVector; +function VecCreate(ALength: Integer; ADefault: Double = 0.0): TDblVector; procedure VecCheck(A, B: TDblVector; out n: Integer); function VecCopy(A: TDblVector): TDblVector; function VecMultiply(A, B: TDblVector): TDblVector; @@ -64,6 +70,7 @@ operator - (A, B: TDblMatrix): TDblMatrix; operator * (A, B: TDblMatrix): TDblMatrix; operator * (A: TDblMatrix; v: TDblVector): TDblVector; +function MatCreate(n, m: Integer; ADefault: Double = 0.0): TDblMatrix; function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix; procedure MatCheck(A: TDblMatrix); procedure MatCheckSquare(A: TDblMatrix; out n: Integer); @@ -113,6 +120,17 @@ type end; +function IntVecCreate(n: Integer; ADefault: Integer = 0): TIntVector; +function IntMatCreate(n, m: Integer; ADefault: Integer = 0): TIntMatrix; +function CubeCreate(n1, n2, n3: Integer; ADefault: Double = 0.0): TDblCube; +function IntCubeCreate(n1, n2, n3: Integer; ADefault: Integer = 0): TIntCube; +function QuadCreate(n1, n2, n3, n4: Integer; ADefault: Double = 0.0): TDblQuad; +function IntQuadCreate(n1, n2, n3, n4: Integer; ADefault: Integer = 0): TIntQuad; + +function CheckFactorCodes(AFactorName: String; const ACodes: TDblVector; + out AErrMsg: String): Boolean; + + implementation uses @@ -203,6 +221,16 @@ begin end; +function VecCreate(ALength: Integer; ADefault: Double = 0.0): TDblVector; +var + i: Integer; +begin + SetLength(Result, ALength); + for i := 0 to High(Result) do + Result[i] := ADefault; +end; + + procedure VecCheck(A, B: TDblVector; out n: Integer); var na, nb: Integer; @@ -481,6 +509,17 @@ begin end; +function MatCreate(n, m: Integer; ADefault: Double = 0.0): TDblMatrix; +var + i, j: Integer; +begin + SetLength(Result, n,m); + for i := 0 to n-1 do + for j := 0 to m-1 do + Result[i, j] := ADefault; +end; + + { Adds the elements of the vector v to the rows of the matrix A, i.e. the number of columns increases by 1 } function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix; @@ -1092,5 +1131,119 @@ begin end; +{ Checks whether the codes provided are integers and whether the codes are + consecutive, i.e. without gaps. } +function CheckFactorCodes(AFactorName: String; const ACodes: TDblVector; + out AErrMsg: String): Boolean; +const + EPS = 1E-9; + NonIntegerError = 'Factor "%s" contains non-integer values.'; + NonConsecutiveError = 'Factor "%s" does not contain consecutive codes.'; +var + values: DblDyneVec; + i, prev, curr: Integer; +begin + Result := false; + values := VecCopy(ACodes); + SortOnX(values); + if abs(values[0] - trunc(values[0])) > EPS then + begin + AErrMsg := Format(NonIntegerError, [AFactorName]); + exit; + end; + prev := round(values[0]); + + for i := 1 to High(values) do + begin + if abs(values[i] - trunc(values[i])) > EPS then + begin + AErrMsg := Format(NonIntegerError, [AFactorName]); + exit; + end; + curr := round(values[i]); + if curr - prev > 1 then + begin + AErrMsg := Format(NonConsecutiveError, [AFactorName]); + exit; + end; + prev := curr; + end; + + Result := true; + AErrMsg := ''; +end; + + +function IntVecCreate(n: Integer; ADefault: Integer = 0): TIntVector; +var + i: Integer; +begin + SetLength(Result, n); + for i := 0 to High(Result) do + Result[i] := ADefault; +end; + + +function IntMatCreate(n, m: Integer; ADefault: Integer = 0): TIntMatrix; +var + i, j: Integer; +begin + SetLength(Result, n,m); + for i := 0 to n-1 do + for j := 0 to m-1 do + Result[i, j] := ADefault; +end; + + +function CubeCreate(n1, n2, n3: Integer; ADefault: Double = 0.0): TDblCube; +var + i,j,k: Integer; +begin + SetLength(Result, n1, n2, n3); + for i := 0 to n1 - 1 do + for j := 0 to n2 - 1 do + for k := 0 to n3 - 1 do + Result[i, j, k] := ADefault; +end; + + +function IntCubeCreate(n1, n2, n3: Integer; ADefault: Integer = 0): TIntCube; +var + i, j, k: Integer; +begin + SetLength(Result, n1, n2, n3); + for i := 0 to n1 - 1 do + for j := 0 to n2 - 1 do + for k := 0 to n3 - 1 do + Result[i, j, k] := ADefault; +end; + + +function QuadCreate(n1, n2, n3, n4: Integer; ADefault: Double = 0.0): TDblQuad; +var + i, j, k, l: Integer; +begin + SetLength(Result, n1, n2, n3, n4); + for i := 0 to n1 - 1 do + for j := 0 to n2 - 1 do + for k := 0 to n3 - 1 do + for l := 0 to n4 - 1 do + Result[i, j, k, l] := ADefault; +end; + + +function IntQuadCreate(n1, n2, n3, n4: Integer; ADefault: Integer = 0): TIntQuad; +var + i, j, k, l: Integer; +begin + SetLength(Result, n1, n2, n3, 4); + for i := 0 to n1 - 1 do + for j := 0 to n2 - 1 do + for k := 0 to n3 - 1 do + for l := 0 to n4 - 1 do + Result[i, j, k, l] := ADefault; +end; + + end.