jclstatistics.pas

East make Tray Icon in delphi

function MinFloatArray(const B: TDynFloatArray): Float;
var
  I, N: Integer;
begin
  N := GetDynLengthNotNull(B);
  Result := B[0];
  for I := 1 to N - 1 do
    if B[I] < Result then
      Result := B[I];
end;

function MinFloatArrayIndex(const B: TDynFloatArray): Integer;
var
  I, N: Integer;
  Min: Float;
begin
  Result := 0;
  N := GetDynLengthNotNull(B);
  Min := B[0];
  for I := 1 to N - 1 do
    if B[I] < Min then
    begin
      Min := B[I];
      Result := I;
    end;
end;

function Permutation(N, R: Cardinal): Float;
var
  I : Integer;
begin
  if (N = 0) or (R > N) or (N > MaxFactorial) then
  begin
    Result := 0.0;
    Exit;
  end;
  Result := 1.0;
  if R <> 0 then
    try
      for I := N downto N - R + 1 do
        Result := Result * I;
      Result := Int(Result + 0.5);
    except
      Result := -1.0;
    end;
end;

{ TODO -cDoc : Donator: Fred Hovey }
function Combinations(N, R: Cardinal): Float;
begin
  Result := Factorial(R);
  if IsFloatZero(Result) then
   Result := -1.0
  else
   Result := Permutation(N, R) / Result;
end;

{ TODO -cDoc : donator: Fred Hovey, contributor: Robert Rossmair }
function SumOfSquares(const X: TDynFloatArray): Float;
var
  I, N: Integer;
  Sum: Float;
begin
  N := GetSampleSize(X);
  Result := Sqr(X[0]);
  Sum := X[0];
  for I := 1 to N - 1 do
  begin
    Result := Result + Sqr(X[I]);
    Sum := Sum + X[I];
  end;
  Result := Result - Sum * Sum / N;
end;

{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair }
function PopulationVariance(const X: TDynFloatArray): Float;
begin
  // Length(X) = 0 would cause SumOfSquares() to raise an exception before the division is executed.
  Result := SumOfSquares(X) / Length(X);
end;

procedure PopulationVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float);
var
  I, N: Integer;
  Sum, SumSq: Float;
begin
  N := GetSampleSize(X);
  SumSq := Sqr(X[0]);
  Sum := X[0];
  for I := 1 to N - 1 do
  begin
    SumSq := SumSq + Sqr(X[I]);
    Sum := Sum + X[I];
  end;
  Mean := Sum / N;
  Variance := (SumSq / N) - Sqr(Mean);
end;

{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair }
function SampleVariance(const X: TDynFloatArray): Float;
var
  N: Integer;
begin
  N := GetSampleSize(X, 2);
  Result := SumOfSquares(X) / (N - 1)
end;

{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair }
procedure SampleVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float);
var
  I, N: Integer;
  Sum, SumSq: Float;
begin
  N := GetSampleSize(X);
  SumSq := Sqr(X[0]);
  Sum := X[0];
  for I := 1 to N - 1 do
  begin
    SumSq := SumSq + Sqr(X[I]);
    Sum := Sum + X[I];
  end;
  Mean := Sum / N;
  if N < 2 then
    InvalidSampleSize(N);
  //Variance := (SumSq / (N - 1)) - Sqr(Sum / (N - 1)) => WRONG!!!!
  Variance := (SumSq - Sum * Sum / N) / (N - 1)
end;

{ TODO -cDoc : Donator: Fred Hovey, contributor: Robert Rossmair }
function StdError(const X: TDynFloatArray): Float;
begin
  // Length(X) = 0 would cause SampleVariance() to raise an exception before the division is
  // executed.
  Result := Sqrt(SampleVariance(X) / Length(X));
end;

{ TODO -cDoc : Donator: Fred Hovey, contributor: Robert Rossmair }
function StdError(const Variance: Float; const SampleSize: Integer): Float;
begin
  if SampleSize = 0 then
    InvalidSampleSize(SampleSize);
  Result := Sqrt(Variance / SampleSize);
end;

function SumFloatArray(const B: TDynFloatArray): Float;
var
  I, N: Integer;
begin
  Result := 0.0;
  N := GetDynLength(B);
  if N <> 0 then
  begin
    Result := B[0];
    for I := 1 to N - 1 do
      Result := Result + B[I];
  end;
end;

function SumSquareDiffFloatArray(const B: TDynFloatArray; Diff: Float): Float;
var
  I, N: Integer;
begin
  Result := 0.0;
  N := GetDynLength(B);
  if N <> 0 then
  begin
    Result := Sqr(B[0] - Diff);
    for I := 1 to N - 1 do
      Result := Result + Sqr(B[I] - Diff);
  end;
end;

function SumSquareFloatArray(const B: TDynFloatArray): Float;
var
  I, N: Integer;
begin
  Result := 0.0;
  N := GetDynLength(B);
  if N <> 0 then
  begin
    Result := Sqr(B[0]);
    for I := 1 to N - 1 do
      Result := Result + Sqr(B[I]);
  end;
end;

function SumPairProductFloatArray(const X, Y: TDynFloatArray): Float;
var
  I, N: Integer;
begin
  Result := 0.0;
  N := Min(Length(X), Length(Y));
  if N <> 0 then
  begin
    Result := X[0] * Y[0];
    for I := 1 to N - 1 do
      Result := Result + X[I] * Y[I];
  end;
end;

function ChiSquare(const X: TDynFloatArray): Float;  { TODO -cDoc : ChiSquare }
var
  I, N: Integer;
  Sum: Float;
begin
  N := GetDynLengthNotNull(X);
  Result := Sqr(X[0]);
  Sum := X[0];
  for I := 1 to N - 1 do
  begin
    Result := Result + Sqr(X[I]);
    Sum := Sum + X[I];
  end;
end;

// History:

// $Log: JclStatistics.pas,v $
// Revision 1.15  2005/03/08 08:33:17  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.14  2005/02/24 16:34:40  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.13  2004/12/17 05:33:02  marquardt
// updates for DCL
//
// Revision 1.12  2004/10/17 20:25:21  mthoma
// style cleaning, adjusting contributors
//
// Revision 1.11  2004/09/16 19:47:32  rrossmair
// check-in in preparation for release 1.92
//
// Revision 1.10  2004/08/18 19:06:15  rrossmair
// - got rid of warning
// - renamed local variables "L" to "N" (as commonly used to denote sample size)
//
// Revision 1.9  2004/08/18 17:08:59  rrossmair
// - mantis #2019 & #2021 handled, improved error reports
//
// Revision 1.8  2004/07/29 15:16:51  marquardt
// simple style cleaning
//
// Revision 1.7  2004/05/05 07:18:31  rrossmair
// MedianUnsorted: type cast for FPC compatibility
//
// Revision 1.6  2004/05/05 00:09:59  mthoma
// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary,
//
// Revision 1.5  2004/04/08 17:14:46  mthoma
// no message
//
// Revision 1.4  2004/04/08 16:57:21  mthoma
// Fixed #1268. Introduced new function MedianUnsorted
//
// Revision 1.3  2004/04/06 04:53:18
// adapt compiler conditions, add log entry
//

end.