LazStats: Refactor ABCNestedUnit

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7865 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.