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

LazStats: Add check whether coded values are integers and without gaps.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7852 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-09 18:18:38 +00:00
parent 5a4cba00bd
commit 6ce0fc13bd
2 changed files with 64 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -112,7 +112,7 @@ type
OKterms: array[1..14] of integer;
procedure Init;
procedure GetLevels(out DepValues, F1Values, F2Values, F3Values: DblDyneVec);
function GetLevels(out DepValues, F1Values, F2Values, F3Values: DblDyneVec): Boolean;
procedure Init1Way;
function Calc1Way(const DepValues, F1Values: DblDyneVec): Boolean;
@ -161,7 +161,7 @@ implementation
uses
Math,
TASeries,
TAChartUtils, TASeries,
Utils, MathUnit, MatrixUnit, ChartFrameUnit, GridProcs;
{ TBlksAnovaForm }
@ -309,18 +309,20 @@ begin
allAlpha := StrToFloat(OverallAlphaEdit.Text);
PostHocAlpha := StrToFloat(PostAlphaEdit.Text);
// get min and max of each factor code
GetLevels(DepValues, F1Values, F2Values, F3Values);
// Get min and max of each factor code
// The function fails when codes are not integers or not consecutive.
if not GetLevels(DepValues, F1Values, F2Values, F3Values) then
exit;
lReport := TStringList.Create;
try
// allocate space
// Allocate space
SetLength(cellcnts, totcells); // array of cell counts
SetLength(cellvars, totcells); // arrray of cell sums of squares then variances
SetLength(cellsums, totcells); // array of cell sums then means
// initialize array values
// Initialize array values
for i := 0 to totcells-1 do
begin
cellsums[i] := 0.0;
@ -527,10 +529,13 @@ begin
end;
procedure TBlksAnovaForm.GetLevels(out DepValues, F1Values, F2Values, F3Values: DblDyneVec);
function TBlksAnovaForm.GetLevels(
out DepValues, F1Values, F2Values, F3Values: DblDyneVec): Boolean;
var
mx, mn: Double;
begin
Result := false;
DepValues := nil;
F1Values := nil;
F2Values := nil;
@ -544,7 +549,9 @@ begin
VecMaxMin(F1Values, mx, mn);
MaxF1 := round(mx);
MinF1 := round(mn);
NF1Cells := MaxF1 - MinF1 + 1; // wp: This is wrong when codes have gaps --> needs to be checked!!!
NF1Cells := MaxF1 - MinF1 + 1;
if not CheckFactorCodes(Factor1Edit.Text, F1Values) then
exit;
// Extract factor 2 values when available
if NoFactors >= 2 then
@ -554,6 +561,8 @@ begin
MaxF2 := round(mx);
MinF2 := round(mn);
NF2Cells := MaxF2 - MinF2 + 1;
if not CheckFactorCodes(Factor2Edit.Text, F2Values) then
exit;
end else
NF2Cells := 0;
@ -565,50 +574,13 @@ begin
MaxF3 := round(mx);
MinF3 := round(mn);
NF3Cells := MaxF3 - MinF3 + 1;
if not CheckFactorCodes(Factor3Edit.Text, F3Values) then
exit;
end else
NF3cells := 0;
{
minf1 := MaxInt;
maxf1 := -MaxInt;
for i := 1 to NoCases do
begin
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[1], i])));
if intvalue > maxf1 then maxf1 := intvalue;
if intvalue < minf1 then minf1 := intvalue;
end;
Nf1cells := maxf1 - minf1 + 1;
if nofactors > 1 then
begin
minf2 := MaxInt;
maxf2 := -MaxInt;
for i := 1 to NoCases do
begin
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[2], i])));
if intvalue > maxf2 then maxf2 := intvalue;
if intvalue < minf2 then minf2 := intvalue;
end;
Nf2cells := maxf2 - minf2 + 1;
end;
if nofactors = 3 then
begin
minf3 := MaxInt;
maxf3 := -MaxInt;
for i := 1 to NoCases do
begin
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[2], i])));
if intvalue > maxf3 then maxf3 := intvalue;
if intvalue < minf3 then minf3 := intvalue;
end;
Nf3cells := maxf3 - minf3 + 1;
end;
}
totcells := Nf1cells + Nf2cells + Nf3cells;
Result := true;
end;
@ -843,6 +815,8 @@ begin
FChartCombobox.Parent.Hide;
FChartFrame.Chart.Legend.Visible := false;
FChartFrame.Chart.BottomAxis.Marks.Source := FSeries.Source;
FChartFrame.Chart.BottomAxis.Marks.Style := smsXValue;
end;
(*

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

@ -100,12 +100,54 @@ 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 }