pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Refactor ABCNestedUnit

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7865 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-13 13:16:59 +00:00
parent aed12b6bbd
commit a6ac93ef34
6 changed files with 425 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm
View File

@ -377,12 +377,12 @@ inherited ABCNestedForm: TABCNestedForm
inherited ReportPage: TTabSheet inherited ReportPage: TTabSheet
Caption = 'ANOVA Results' Caption = 'ANOVA Results'
end end
object MeansPage: TTabSheet[1] inherited ChartPage: TTabSheet
Caption = 'Means'
end
inherited ChartPage: TTabSheet[2]
Caption = 'Plots' Caption = 'Plots'
end end
object MeansPage: TTabSheet[2]
Caption = 'Means'
end
end end
object ChartStyles: TChartStyles[3] object ChartStyles: TChartStyles[3]
Styles = <> Styles = <>

453
applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas
View File

@ -73,19 +73,20 @@ type
ACount, BCount, CCount : IntDyneVec; ACount, BCount, CCount : IntDyneVec;
ACCount, ABCount : IntDyneMat; ACCount, ABCount : IntDyneMat;
CellSDs, SS, SumSqr, CellMeans : DblDyneCube; CellSDs, SS, SumSqr, CellMeans : DblDyneCube;
MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer; MinA, MaxA, NoALevels: Integer;
CCol, MinC, MaxC, NoCLevels : 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; SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double;
SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double; SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double;
TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer; TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer;
ColNoSelected: IntDyneVec; // ColNoSelected: IntDyneVec;
AMeans, BMeans, CMeans: DblDyneVec; AMeans, BMeans, CMeans: DblDyneVec;
ABMeans, ACMeans: DblDyneMat; ABMeans, ACMeans: DblDyneMat;
function GetVariables: Boolean; function GetVariables(out AValues, BValues, CValues, DepValues: DblDyneVec): Boolean;
procedure GetMemory; procedure GetMemory;
procedure GetSums; procedure GetSums(const AValues, BValues, CValues, DepValues: DblDyneVec);
procedure ShowMeans; procedure ShowMeans;
procedure GetResults; procedure GetResults;
procedure ShowResults; procedure ShowResults;
@ -106,6 +107,7 @@ type
procedure AdjustConstraints; override; procedure AdjustConstraints; override;
procedure Compute; override; procedure Compute; override;
procedure UpdateBtnStates; override; procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -122,7 +124,7 @@ implementation
uses uses
TAChartUtils, TACustomSource, TALegend, TASeries, TAChartUtils, TACustomSource, TALegend, TASeries,
Utils, Math, MathUnit, ChartFrameUnit; Utils, Math, MathUnit, MatrixUnit, GridProcs, ChartFrameUnit;
{ TABCNestedForm } { TABCNestedForm }
@ -236,11 +238,16 @@ end;
procedure TABCNestedForm.Compute; procedure TABCNestedForm.Compute;
var
dataA: DblDyneVec = nil;
dataB: DblDyneVec = nil;
dataC: DblDyneVec = nil;
dataDep: DblDyneVec = nil;
begin begin
if GetVariables then if GetVariables(dataA, dataB, dataC, dataDep) then
begin begin
GetMemory; GetMemory;
GetSums; GetSums(dataA, dataB, dataC, dataDep);
ShowMeans; ShowMeans;
GetResults; GetResults;
ShowResults; ShowResults;
@ -319,13 +326,73 @@ begin
end; end;
function TABCNestedForm.GetVariables: Boolean; function TABCNestedForm.GetVariables(
out AValues, BValues, CValues, DepValues: DblDyneVec): Boolean;
var var
i, group: integer; ColNoSelected: IntDyneVec = nil;
strvalue, cellstring: string; mn, mx: Double;
msg: String;
begin begin
Result := false; 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); SetLength(ColNoSelected, 4);
ACol := -1; ACol := -1;
BCol := -1; BCol := -1;
@ -392,218 +459,165 @@ begin
Result := true; Result := true;
end; end;
*)
{ Allocates memory for all arrays needed. Setting the dynamic arrays to nil
before allocation automatically resets the array contents. }
procedure TABCNestedForm.GetMemory; procedure TABCNestedForm.GetMemory;
begin begin
SetLength(SS,NoBLevels,NoALevels,NoCLevels); SS := CubeCreate(NoBLevels, NoALevels, NoCLevels);
SetLength(SumSqr,NoBLevels,NoALevels,NoCLevels); SumSqr := CubeCreate(NoBLevels, NoALevels, NoCLevels);
SetLength(CellCount,NoBLevels,NoALevels,NoCLevels); CellCount := IntCubeCreate(NoBLevels, NoALevels, NoCLevels);
SetLength(CellMeans,NoBLevels,NoALevels,NoCLevels); CellMeans := CubeCreate(NoBLevels, NoALevels, NoCLevels);
SetLength(CellSDs,NoBLevels,NoALevels,NoCLevels); CellSDs := CubeCreate(NoBLevels, NoALevels, NoCLevels);
SetLength(ASS,NoALevels); ASS := VecCreate(NoALevels);
SetLength(BSS,NoBLevels); BSS := VecCreate(NoBLevels);
SetLength(CSS,NoCLevels); CSS := VecCreate(NoCLevels);
SetLength(ASumSqr,NoALevels); ASumSqr := VecCreate(NoALevels);
SetLength(BSumSqr,NoBLevels); BSumSqr := VecCreate(NoBLevels);
SetLength(CSumSqr,NoCLevels); CSumSqr := VecCreate(NoCLevels);
SetLength(AMeans,NoALevels); AMeans := VecCreate(NoALevels);
SetLength(BMeans,NoBLevels); BMeans := VecCreate(NoBLevels);
SetLength(CMeans,NoCLevels); CMeans := VecCreate(NoCLevels);
SetLength(ACount,NoALevels); ACount := IntVecCreate(NoALevels);
SetLength(BCount,NoBLevels); BCount := IntVecCreate(NoBLevels);
SetLength(CCount,NoCLevels); CCount := IntVecCreate(NoCLevels);
SetLength(ASDs,NoALevels); ASDs := VecCreate(NoALevels);
SetLength(BSDs,NoBLevels); BSDs := VecCreate(NoBLevels);
SetLength(CSDs,NoCLevels); CSDs := VecCreate(NoCLevels);
SetLength(ACSS,NoALevels,NoCLevels); ACSS := MatCreate(NoALevels, NoCLevels);
SetLength(ACSumSqr,NoALevels,NoCLevels); ACSumSqr := MatCreate(NoALevels, NoCLevels);
SetLength(ACCount,NoALevels,NoCLevels); ACCount := IntMatCreate(NoALevels, NoCLevels);
SetLength(ACMeans,NoALevels,NoCLevels); ACMeans := MatCreate(NoALevels, NoCLevels);
SetLength(ACSDs,NoALevels,NoCLevels); ACSDs := MatCreate(NoALevels, NoCLevels);
SetLength(ABSS,NoALevels,NoBLevels); ABSS := MatCreate(NoALevels, NoBLevels);
SetLength(ABSumSqr,NoALevels,NoBLevels); ABSumSqr := MatCreate(NoALevels, NoBLevels);
SetLength(ABMeans,NoALevels,NoBLevels); ABMeans := MatCreate(NoALevels, NoBLevels);
SetLength(ABCount,NoALevels,NoBLevels); ABCount := IntMatCreate(NoALevels, NoBLevels);
SetLength(ABSDs,NoALevels,NoBLevels); ABSDs := MatCreate(NoALevels,NoBLevels);
end; end;
procedure TABCNestedForm.GetSums; procedure TABCNestedForm.GetSums(const AValues, BValues, CValues, DepValues: DblDyneVec);
VAR VAR
Aindex, Bindex, Cindex, i, j, k: integer; Aindex, Bindex, Cindex, i, j, k: integer;
YValue: double; YValue, YValueSqr: double;
strvalue: string;
begin begin
// clear memory // clear memory
SSTot := 0.0; SSTot := 0.0;
SumSqrTot := 0.0; SumSqrTot := 0.0;
for i := 0 to NoBLevels-1 do TotN := 0;
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;
for i := 0 to NoALevels-1 do // Accumulate sums and sums of squared values
begin for i := 0 to High(DepValues) do
ACount[i] := 0; begin
AMeans[i] := 0.0; AIndex := round(AValues[i]) - MinA;
ASS[i] := 0.0; BIndex := round(BValues[i]) - MinB;
ASumSqr[i] := 0.0; CIndex := round(CValues[i]) - MinC;
end; YValue := DepValues[i];
for j := 0 to NoBLevels-1 do YValueSqr := YValue * YValue;
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;
for i := 0 to NoALevels-1 do SS[Bindex,Aindex,Cindex] := SS[Bindex,Aindex,Cindex] + YValueSqr;
begin SumSqr[Bindex,Aindex,Cindex] := SumSqr[Bindex,Aindex,Cindex] + YValue; // wp: why no square?
for j := 0 to NoBLevels-1 do CellCount[Bindex,Aindex,Cindex] := CellCount[Bindex,Aindex,Cindex] + 1;
begin ACount[Aindex] := ACount[Aindex] + 1;
ABSS[i,j] := 0.0; BCount[Bindex] := BCount[Bindex] + 1;
ABSumSqr[i,j] := 0.0; CCount[Cindex] := CCount[Cindex] + 1;
ABCount[i,j] := 0; ASS[Aindex] := ASS[Aindex] + YValueSqr;
ABSDs[i,j] := 0.0; BSS[Bindex] := BSS[Bindex] + YValueSqr;
end; CSS[Cindex] := CSS[Cindex] + YValueSqr;
end; ASumSqr[Aindex] := ASumSqr[Aindex] + YValue;
for i := 0 to NoALevels-1 do BSumSqr[Bindex] := BSumSqr[Bindex] + YValue;
begin CSumSqr[Cindex] := CSumSqr[Cindex] + YValue;
for k := 0 to NoCLevels-1 do ACSS[Aindex,Cindex] := ACSS[Aindex,Cindex] + YValueSqr;
begin ACSumSqr[Aindex,Cindex] := ACSumSqr[Aindex,Cindex] + YValue;
ACSS[i,k] := 0.0; ACCount[Aindex,Cindex] := ACCount[Aindex,Cindex] + 1;
ACSumSqr[i,k] := 0.0; ABSS[Aindex,Bindex] := ABSS[Aindex,Bindex] + YValueSqr;
ACCount[i,k] := 0; ABSumSqr[Aindex,Bindex] := ABSumSqr[Aindex,Bindex] + YValue;
ACSDs[i,k] := 0.0; ABCount[Aindex,Bindex] := ABCount[Aindex,Bindex] + 1;
end; SSTot := SSTot + YValueSqr;
end; SumSqrTot := SumSqrTot + YValue;
TotN := TotN + 1;
end;
// accumulate sums and sums of squared values // Get cell means and marginal means plus square of sums
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
for i := 0 to NoBLevels-1 do for i := 0 to NoBLevels-1 do
begin
for j := 0 to NoALevels-1 do
begin
for k := 0 to NoCLevels-1 do
begin begin
for j := 0 to NoALevels-1 do if CellCount[i,j,k] > 0 then
begin begin
for k := 0 to NoCLevels-1 do CellMeans[i,j,k] := SumSqr[i,j,k] / CellCount[i,j,k];
begin SumSqr[i,j,k] := SumSqr[i,j,k] * SumSqr[i,j,k];
if CellCount[i,j,k] > 0 then CellSDs[i,j,k] := SS[i,j,k] - (SumSqr[i,j,k] / CellCount[i,j,k]);
begin CellSDs[i,j,k] := CellSDs[i,j,k] / (CellCount[i,j,k] - 1);
CellMeans[i,j,k] := SumSqr[i,j,k] / CellCount[i,j,k]; CellSDs[i,j,k] := sqrt(CellSDs[i,j,k]);
SumSqr[i,j,k] := SumSqr[i,j,k] * SumSqr[i,j,k]; end;
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; end;
end;
end;
for i := 0 to NoBLevels-1 do for i := 0 to NoBLevels-1 do
begin begin
if BCount[i] > 0 then if BCount[i] > 0 then
begin begin
BMeans[i] := BSumSqr[i] / BCount[i]; BMeans[i] := BSumSqr[i] / BCount[i];
BSumSqr[i] := BSumSqr[i] * BSumSqr[i]; BSumSqr[i] := BSumSqr[i] * BSumSqr[i];
BSDs[i] := BSS[i] - (BSumSqr[i] / BCount[i]); BSDs[i] := BSS[i] - (BSumSqr[i] / BCount[i]);
BSDs[i] := BSDs[i] / (BCount[i] - 1); BSDs[i] := BSDs[i] / (BCount[i] - 1);
BSDs[i] := sqrt(BSDs[i]); BSDs[i] := sqrt(BSDs[i]);
end; end;
end; end;
for i := 0 to NoALevels-1 do for i := 0 to NoALevels-1 do
begin begin
AMeans[i] := ASumSqr[i] / ACount[i]; AMeans[i] := ASumSqr[i] / ACount[i];
ASumSqr[i] := ASumSqr[i] * ASumSqr[i]; ASumSqr[i] := ASumSqr[i] * ASumSqr[i];
ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]); ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]);
ASDs[i] := ASDs[i] / (ACount[i] - 1); ASDs[i] := ASDs[i] / (ACount[i] - 1);
ASDs[i] := Sqrt(ASDs[i]); ASDs[i] := Sqrt(ASDs[i]);
end; end;
for i := 0 to NoCLevels-1 do for i := 0 to NoCLevels-1 do
begin begin
CMeans[i] := CSumSqr[i] / CCount[i]; CMeans[i] := CSumSqr[i] / CCount[i];
CSumSqr[i] := CSumSqr[i] * CSumSqr[i]; CSumSqr[i] := CSumSqr[i] * CSumSqr[i];
CSDs[i] := CSS[i] - (CSumSqr[i] / CCount[i]); CSDs[i] := CSS[i] - (CSumSqr[i] / CCount[i]);
CSDs[i] := CSDs[i] / (CCount[i] - 1); CSDs[i] := CSDs[i] / (CCount[i] - 1);
CSDs[i] := sqrt(CSDs[i]); CSDs[i] := sqrt(CSDs[i]);
end; end;
for i := 0 to NoALevels-1 do for i := 0 to NoALevels-1 do
begin begin
for k := 0 to NoCLevels-1 do for k := 0 to NoCLevels-1 do
begin begin
ACMeans[i,k] := ACMeans[i,k] / ACCount[i,k]; ACMeans[i,k] := ACMeans[i,k] / ACCount[i,k];
ACSumSqr[i,k] := ACSumSqr[i,k] * ACSumSqr[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] := ACSS[i,k] - (ACSumSqr[i,k] / ACCount[i,k]);
ACSDs[i,k] := ACSDs[i,k] / (ACCount[i,k] - 1); ACSDs[i,k] := ACSDs[i,k] / (ACCount[i,k] - 1);
ACSDs[i,k] := sqrt(ACSDs[i,k]); ACSDs[i,k] := sqrt(ACSDs[i,k]);
end; end;
end; end;
for i := 0 to NoALevels-1 do for i := 0 to NoALevels-1 do
begin begin
for j := 0 to NoBLevels-1 do for j := 0 to NoBLevels-1 do
begin begin
if ABCount[i,j] > 0 then if ABCount[i,j] > 0 then
begin begin
ABMeans[i,j] := ABSumSqr[i,j] / ABCount[i,j]; ABMeans[i,j] := ABSumSqr[i,j] / ABCount[i,j];
ABSumSqr[i,j] := ABSumSqr[i,j] * ABSumSqr[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] := ABSS[i,j] - (ABSumSqr[i,j] / ABCount[i,j]);
ABSDs[i,j] := ABSDs[i,j] / (ABCount[i,j] - 1); ABSDs[i,j] := ABSDs[i,j] / (ABCount[i,j] - 1);
ABSDs[i,j] := sqrt(ABSDs[i,j]); ABSDs[i,j] := sqrt(ABSDs[i,j]);
end; end;
end; end;
end; end;
TotMean := SumSqrTot / TotN;
SumSqrTot := SumSqrTot * SumSqrTot; TotMean := SumSqrTot / TotN;
SumSqrTot := SumSqrTot * SumSqrTot;
end; end;
@ -829,7 +843,7 @@ end;
procedure TABCNestedForm.ReleaseMemory; procedure TABCNestedForm.ReleaseMemory;
begin begin
ColNoSelected := nil; // ColNoSelected := nil;
ABSDs := nil; ABSDs := nil;
ABCount := nil; ABCount := nil;
// ABMeans := nil; // ABMeans := nil;
@ -1259,6 +1273,43 @@ begin
end; 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); procedure TABCNestedForm.VarListDblClick(Sender: TObject);
var var
index: Integer; index: Integer;

16
applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas
View File

@ -1159,6 +1159,7 @@ function TBlksAnovaForm.GetLevels(
out DepValues, F1Values, F2Values, F3Values: DblDyneVec): Boolean; out DepValues, F1Values, F2Values, F3Values: DblDyneVec): Boolean;
var var
mx, mn: Double; mx, mn: Double;
msg: String;
begin begin
Result := false; Result := false;
@ -1176,8 +1177,11 @@ begin
MaxF1 := round(mx); MaxF1 := round(mx);
MinF1 := round(mn); MinF1 := round(mn);
NF1Cells := MaxF1 - MinF1 + 1; NF1Cells := MaxF1 - MinF1 + 1;
if not CheckFactorCodes(Factor1Edit.Text, F1Values) then if not CheckFactorCodes(Factor1Edit.Text, F1Values, msg) then
begin
ErrorMsg(msg);
exit; exit;
end;
// Extract factor 2 values when available // Extract factor 2 values when available
if NoFactors >= 2 then if NoFactors >= 2 then
@ -1187,8 +1191,11 @@ begin
MaxF2 := round(mx); MaxF2 := round(mx);
MinF2 := round(mn); MinF2 := round(mn);
NF2Cells := MaxF2 - MinF2 + 1; NF2Cells := MaxF2 - MinF2 + 1;
if not CheckFactorCodes(Factor2Edit.Text, F2Values) then if not CheckFactorCodes(Factor2Edit.Text, F2Values, msg) then
begin
ErrorMsg(msg);
exit; exit;
end;
end else end else
NF2Cells := 0; NF2Cells := 0;
@ -1200,8 +1207,11 @@ begin
MaxF3 := round(mx); MaxF3 := round(mx);
MinF3 := round(mn); MinF3 := round(mn);
NF3Cells := MaxF3 - MinF3 + 1; NF3Cells := MaxF3 - MinF3 + 1;
if not CheckFactorCodes(Factor3Edit.Text, F3Values) then if not CheckFactorCodes(Factor3Edit.Text, F3Values, msg) then
begin
ErrorMsg(msg);
exit; exit;
end;
end else end else
NF3cells := 0; NF3cells := 0;

4
applications/lazstats/source/forms/mainunit.pas
View File

@ -1864,7 +1864,7 @@ procedure TOS3MainFrm.mnuAnalysisComp_BinAClick(Sender: TObject);
begin begin
if BNestedAForm = nil then if BNestedAForm = nil then
Application.CreateForm(TBNestedAForm, BNestedAForm); Application.CreateForm(TBNestedAForm, BNestedAForm);
BNestedAForm.ShowModal; BNestedAForm.Show;
end; end;
// Menu "Analysis" > "Comparisons" > "Difference Between Correlations" // Menu "Analysis" > "Comparisons" > "Difference Between Correlations"
@ -1888,7 +1888,7 @@ procedure TOS3MainFrm.mnuAnalysisComp_NestedABCClick(Sender: TObject);
begin begin
if ABCNestedForm = nil then if ABCNestedForm = nil then
Application.CreateForm(TABCNestedForm, ABCNestedForm); Application.CreateForm(TABCNestedForm, ABCNestedForm);
ABCNestedForm.ShowModal; ABCNestedForm.Show;
end; end;
// Menu "Analysis" > "Comparisons" > "2 or 3 Way Anova with One Case Per Cell" // Menu "Analysis" > "Comparisons" > "2 or 3 Way Anova with One Case Per Cell"

42
applications/lazstats/source/units/anovatestsunit.pas
View File

@ -100,54 +100,12 @@ procedure HomogeneityTest(
NoCases : integer NoCases : integer
); );
function CheckFactorCodes(AFactorName: String; const ACodes: DblDyneVec): Boolean;
implementation implementation
uses uses
Utils, MatrixUnit, MathUnit; 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 } procedure Tukey(error_ms : double; { mean squared for residual }
error_df : double; { deg. freedom for residual } error_df : double; { deg. freedom for residual }
value : double; { size of smallest group } value : double; { size of smallest group }

155
applications/lazstats/source/units/matrixunit.pas
View File

@ -11,10 +11,15 @@ uses
Globals; Globals;
type type
TDblMatrix = DblDyneMat;
TDblVector = DblDyneVec; TDblVector = DblDyneVec;
TDblMatrix = DblDyneMat;
TDblCube = DblDyneCube;
TDblQuad = DblDyneQuad;
TIntVector = IntDyneVec;
TIntMatrix = IntDyneMat; TIntMatrix = IntDyneMat;
TIntCube = IntDyneCube;
TIntQuad = IntDyneQuad;
EMatrix = class(Exception); EMatrix = class(Exception);
@ -28,6 +33,7 @@ operator * (A, B: TDblVector): Double;
operator * (A: TDblVector; b: Double): TDblVector; operator * (A: TDblVector; b: Double): TDblVector;
operator * (a: Double; B: TDblVector): TDblVector; operator * (a: Double; B: TDblVector): TDblVector;
function VecCreate(ALength: Integer; ADefault: Double = 0.0): TDblVector;
procedure VecCheck(A, B: TDblVector; out n: Integer); procedure VecCheck(A, B: TDblVector; out n: Integer);
function VecCopy(A: TDblVector): TDblVector; function VecCopy(A: TDblVector): TDblVector;
function VecMultiply(A, B: TDblVector): TDblVector; function VecMultiply(A, B: TDblVector): TDblVector;
@ -64,6 +70,7 @@ operator - (A, B: TDblMatrix): TDblMatrix;
operator * (A, B: TDblMatrix): TDblMatrix; operator * (A, B: TDblMatrix): TDblMatrix;
operator * (A: TDblMatrix; v: TDblVector): TDblVector; operator * (A: TDblMatrix; v: TDblVector): TDblVector;
function MatCreate(n, m: Integer; ADefault: Double = 0.0): TDblMatrix;
function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix; function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix;
procedure MatCheck(A: TDblMatrix); procedure MatCheck(A: TDblMatrix);
procedure MatCheckSquare(A: TDblMatrix; out n: Integer); procedure MatCheckSquare(A: TDblMatrix; out n: Integer);
@ -113,6 +120,17 @@ type
end; 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 implementation
uses uses
@ -203,6 +221,16 @@ begin
end; 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); procedure VecCheck(A, B: TDblVector; out n: Integer);
var var
na, nb: Integer; na, nb: Integer;
@ -481,6 +509,17 @@ begin
end; 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 { Adds the elements of the vector v to the rows of the matrix A, i.e. the number
of columns increases by 1 } of columns increases by 1 }
function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix; function MatAppendColVector(A: TDblMatrix; v: TDblVector): TDblMatrix;
@ -1092,5 +1131,119 @@ begin
end; 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. end.