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
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 = <>

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

@ -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,147 +459,88 @@ 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
// Accumulate sums and sums of squared values
for i := 0 to High(DepValues) 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;
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;
// 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;
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] + YValue * YValue;
BSS[Bindex] := BSS[Bindex] + YValue * YValue;
CSS[Cindex] := CSS[Cindex] + YValue * YValue;
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] + YValue * 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] + YValue * YValue;
ABSS[Aindex,Bindex] := ABSS[Aindex,Bindex] + YValueSqr;
ABSumSqr[Aindex,Bindex] := ABSumSqr[Aindex,Bindex] + YValue;
ABCount[Aindex,Bindex] := ABCount[Aindex,Bindex] + 1;
SSTot := SSTot + YValue * YValue;
SSTot := SSTot + YValueSqr;
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
@ -550,6 +558,7 @@ begin
end;
end;
end;
for i := 0 to NoBLevels-1 do
begin
if BCount[i] > 0 then
@ -561,6 +570,7 @@ begin
BSDs[i] := sqrt(BSDs[i]);
end;
end;
for i := 0 to NoALevels-1 do
begin
AMeans[i] := ASumSqr[i] / ACount[i];
@ -569,6 +579,7 @@ begin
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];
@ -577,6 +588,7 @@ begin
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
@ -588,6 +600,7 @@ begin
ACSDs[i,k] := sqrt(ACSDs[i,k]);
end;
end;
for i := 0 to NoALevels-1 do
begin
for j := 0 to NoBLevels-1 do
@ -596,12 +609,13 @@ begin
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] := 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;

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;
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;

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

@ -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"

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

@ -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 }

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

@ -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.