ststat.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

function FDist(X : Single; DegreesFreedom1, DegreesFreedom2 : Integer) : Single;
  {-Returns the F probability distribution. You can use this function to
    determine whether two data sets have different degrees of diversity.
      X is the value at which to evaluate the function.
      DegreesFreedom1 is the numerator degrees of freedom.
      DegreesFreedom2 is the denominator degrees of freedom.
    Fractional error less than 3.0e-7.
  }

{FINV}
function FInv(Probability : Single;
  DegreesFreedom1, DegreesFreedom2 : Integer) : Single;
  {-Returns the inverse of the F probability distribution. If
    p = FDist(X,...), then FInv(p,...) = X.
      Probability is a probability associated with the F cumulative
        distribution.
      DegreesFreedom1 is the numerator degrees of freedom.
      DegreesFreedom2 is the denominator degrees of freedom.
    Fractional error less than 3.0e-7.
  }

{LOGNORMDIST}
function LogNormDist(X, Mean, StandardDev : Single) : Single;
  {-Returns the cumulative lognormal distribution of X, where ln(X) is
    normally distributed with parameters Mean and StandardDev.
    Use this function to analyze data that has been logarithmically
    transformed.
      X is the value at which to evaluate the function.
      Mean is the mean of ln(X).
      StandardDev is the standard deviation of ln(X).
  }

{LOGINV}
function LogInv(Probability, Mean, StandardDev : Single) : Single;
  {-Returns the inverse of the lognormal cumulative distribution function of
    X, where ln(X) is normally distributed with parameters Mean and
    StandardDev. If p = LogNormDist(X,...) then LogInv(p,...) = X.
      Probability is a probability associated with the lognormal distribution.
      Mean is the mean of ln(X).
      StandardDev is the standard deviation of ln(X).
  }

{NORMDIST}
function NormDist(X, Mean, StandardDev : Single; Cumulative : Boolean) : Single;
  {-Returns the normal cumulative distribution for the specified Mean and
    standard deviation.
      X is the value for which you want the distribution.
      Mean is the arithmetic mean of the distribution.
      StandardDev is the standard deviation of the distribution.
      Cumulative is a logical value that determines the form of the function.
        If Cumulative is TRUE, NormDist returns the cumulative distribution
        function; if FALSE, it returns the probability density function.
  }

{NORMINV}
function NormInv(Probability, Mean, StandardDev : Single) : Single;
  {-Returns the inverse of the normal cumulative distribution for the
    specified mean and standard deviation.
      Probability is a probability corresponding to the normal distribution.
      Mean is the arithmetic mean of the distribution.
      StandardDev is the standard deviation of the distribution.
  }

{NORMSDIST}
function NormSDist(Z : Single) : Single;
  {-Returns the standard normal cumulative distribution function.
    The distribution has a mean of 0 (zero) and a standard deviation of one.
      Z is the value for which you want the distribution.
  }

{NORMSINV}
function NormSInv(Probability : Single) : Single;
  {-Returns the inverse of the standard normal cumulative distribution.
    The distribution has a mean of zero and a standard deviation of one.
      Probability is a probability corresponding to the normal distribution.
  }

{POISSON}
function Poisson(X : Integer; Mean : Single; Cumulative : Boolean) : Single;
  {-Returns the Poisson distribution.
      X is the number of events.
      Mean is the expected numeric value.
      Cumulative is a logical value that determines the form of the
        probability distribution returned. If Cumulative is TRUE, Poisson
        returns the cumulative Poisson probability that the number of random
        events occurring will be between zero and X inclusive; if FALSE,
        it returns the Poisson probability mass function that the number of
        events occurring will be exactly X.
  }

{TDIST}
function TDist(X : Single; DegreesFreedom : Integer; TwoTails : Boolean) : Single;
  {-Returns the Student's t-distribution. The t-distribution is used in the
    hypothesis testing of small sample data sets. Use this function in place
    of a table of critical values for the t-distribution.
      X is the numeric value at which to evaluate the distribution.
      DegreesFreedom is an Integer indicating the number of degrees of freedom.
      TwoTails if a logical value that indicates the number of distribution
        tails to return. If FALSE, TDist returns the one-tailed distribution;
        otherwise it returns the two-tailed distribution.
  }

{TINV}
function TInv(Probability : Single; DegreesFreedom : Integer) : Single;
  {-Returns the inverse of the Student's t-distribution for the specified
    degrees of freedom.
      Probability is the probability associated with the two-tailed Student's
        t-distribution.
      DegreesFreedom is the number of degrees of freedom to characterize
        the distribution.
  }

{--------------------------------------------------------------------------}
{undocumented functions you can call if you need}

function Erfc(X : Single) : Single;
  {-Returns the complementary error function with fractional error
    everywhere less than 1.2e-7. X is any finite value.
  }

function GammaLn(X : Single) : Single;
  {-Returns ln(Gamma(X)) where X > 0.0.}

{--------------------------------------------------------------------------}

{.$DEFINE Debug}
{$IFDEF Debug}
{like Largest and Smallest but using slower simpler algorithm}
function LargestSort(const Data: array of Double; K : Integer) : Double;
function SmallestSort(const Data: array of double; K : Integer) : Double;
{$ENDIF}

implementation

procedure RaiseStatError(Code : LongInt);
  {-Generate a statistics exception}
var
  E : EStStatError;
begin
  E := EStStatError.CreateResTP(Code, 0);
  E.ErrorCode := Code;
  raise E;
end;

procedure DoubleArraySort(var Data; NData : Integer);
  {-Heapsort an array of Doubles into Ascending order}
type
  TDoubleArray1 = array[1..StMaxBlockSize div SizeOf(Double)] of Double;
var
  i : Integer;
  T : Double;
  DA : TDoubleArray1 absolute Data;

  procedure Adjust(i, N : Integer);
  var
    j : Integer;
    S : Double;
  begin
    {j is left child of i}
    j := 2*i;
    {save i'th element temporarily}
    S := DA[i];
    while (j <= N) do begin
      {compare left and right child}
      if (j < N) and (DA[j] < DA[j+1]) then
        {j indexes larger child}
        inc(j);
      if (S >= DA[j]) then
        {a position for item is found}
        break;
      {move the larger child up a level}
      DA[j shr 1] := DA[j];
      {look at left child of j}
      j := j shl 1;
    end;
    {store saved item}
    DA[j shr 1] := S;
  end;

begin
  {transform the elements into a heap}
  for i := (NData shr 1) downto 1 do
    Adjust(i, NData);

  {repeatedly exchange the maximum at top of heap with the last element}
  for i := NData downto 2 do begin
    T := DA[1];
    DA[1] := DA[i];
    DA[i] := T;
    {update the heap for the remaining elements}
    Adjust(1, i-1);
  end;
end;

function CopyAndSort(const Data; NData : Integer;
  var SD : PDoubleArray) : Cardinal;
  {-Allocates heap space for an array copy, moves data, sorts, and returns size}
var
  Size : LongInt;
begin
  Size := LongInt(NData)*sizeof(Double);
  {if (Size > MaxBlockSize) then}
  {  RaiseStatError(stscStatBadCount);}
  Result := Size;
  getmem(SD, Size); {raises exception if insufficient memory}
  try
    move(Data, SD^, Size);
    DoubleArraySort(SD^, NData);
  except
    freemem(SD, Size);
    raise;
  end;
end;

function AveDev(const Data: array of Double) : Double;
begin
  Result := AveDev16(Data, High(Data)+1);
end;

function Mean(const Data; NData : Integer) : Extended;
  {-Computes the mean of an array of Doubles}
var
  i : Integer;
  s : Extended;
begin
  s := 0.0;
  for I := 0 to NData-1 do
    s := s+TDoubleArray(Data)[I];
  Result := s/NData;
end;

function AveDev16(const Data; NData : Integer) : Double;
var
  i : Integer;
  m, s : Extended;
begin
  if (NData <= 0) then
    RaiseStatError(stscStatBadCount);

  {compute sum of absolute deviations}
  m := Mean(Data, NData);
  s := 0.0;
  for i := 0 to NData-1 do
    s := s+abs(TDoubleArray(Data)[i]-m);

  Result := s/NData;
end;

function Confidence(Alpha, StandardDev : Double; Size : LongInt) : Double;
begin
  if (StandardDev <= 0) or (Size < 1) then
    RaiseStatError(stscStatBadParam);
  Result := NormSInv(1.0-Alpha/2.0)*StandardDev/sqrt(Size);
end;

function Correlation(const Data1, Data2 : array of Double) : Double;
begin
  if (High(Data1) <> High(Data2)) then
    RaiseStatError(stscStatBadCount);
  Result := Correlation16(Data1, Data2, High(Data1)+1);
end;

function Correlation16(const Data1, Data2; NData : Integer) : Double;
var
  sx, sy, xmean, ymean, sxx, sxy, syy, x, y : Extended;
  i : Integer;
begin
  if (NData <= 1) then
    RaiseStatError(stscStatBadCount);

  {compute basic sums}
  sx := 0.0;
  sy := 0.0;
  sxx := 0.0;
  sxy := 0.0;
  syy := 0.0;
  for i := 0 to NData-1 do begin
    x := TDoubleArray(Data1)[i];
    y := TDoubleArray(Data2)[i];
    sx := sx+x;
    sy := sy+y;
    sxx := sxx+x*x;
    syy := syy+y*y;
    sxy := sxy+x*y;
  end;
  xmean := sx/NData;
  ymean := sy/NData;
  sxx := sxx-NData*xmean*xmean;
  syy := syy-NData*ymean*ymean;
  sxy := sxy-NData*xmean*ymean;

  Result := sxy/sqrt(sxx*syy);
end;

function Covariance(const Data1, Data2 : array of Double) : Double;
begin
  if (High(Data1) <> High(Data2)) then
    RaiseStatError(stscStatBadCount);
  Result := Covariance16(Data1, Data2, High(Data1)+1);
end;

function Covariance16(const Data1, Data2; NData : Integer) : Double;
var
  sx, sy, xmean, ymean, sxy, x, y : Extended;
  i : Integer;
begin
  if (NData <= 1) then
    RaiseStatError(stscStatBadCount);

  {compute basic sums}
  sx := 0.0;
  sy := 0.0;
  sxy := 0.0;
  for i := 0 to NData-1 do begin
    x := TDoubleArray(Data1)[i];
    y := TDoubleArray(Data2)[i];
    sx := sx+x;
    sy := sy+y;
    sxy := sxy+x*y;
  end;
  xmean := sx/NData;
  ymean := sy/NData;
  sxy := sxy-NData*xmean*ymean;

  Result := sxy/NData;
end;

function DevSq(const Data: array of Double) : Double;
begin
  Result := DevSq16(Data, High(Data)+1);
end;

function DevSq16(const Data; NData : Integer) : Double;
var
  i : Integer;
  sx, sxx, x : Extended;
begin
  if (NData <= 0) then
    RaiseStatError(stscStatBadCount);

  sx := 0.0;
  sxx := 0.0;
  for i := 0 to NData-1 do begin
    x := TDoubleArray(Data)[i];
    sx := sx+x;
    sxx := sxx+x*x;
  end;
  Result := sxx-sqr(sx)/NData;
end;

procedure Frequency(const Data: array of Double; const Bins: array of Double;
  var Counts: array of LongInt);
begin
  if (High(Counts) <= High(Bins)) then
    RaiseStatError(stscStatBadCount);
  Frequency16(Data, High(Data)+1, Bins, High(Bins)+1, Counts);
end;

procedure Frequency16(const Data; NData : Integer; const Bins; NBins : Integer;
  var Counts);
var
  b, i : Integer;
  Size : Cardinal;
  SD : PDoubleArray;
begin
  if (NData <= 0) or (NBins <= 0) then
    RaiseStatError(stscStatBadCount);

  {copy and sort array}
  Size := CopyAndSort(Data, NData, SD);
  try
    {initialize all counts to zero}
    fillchar(Counts, (NBins+1)*sizeof(Integer), 0);

    {scan all data elements, putting into correct bin}
    b := 0;
    i := 0;
    while (i < NData) do begin
      if (SD^[i] <= TDoubleArray(Bins)[b]) then begin
        {current data element falls into this bin}
        inc(TIntArray(Counts)[b]);
        inc(i);
      end else begin
        {move to next bin that collects data}
        repeat
          inc(b);
        until (b = NBins) or (TDoubleArray(Bins)[b] > SD^[i]);
        if (b = NBins) then begin
          {add remaining elements to the catchall bin}
          inc(TIntArray(Counts)[b], NData-i);
          i := NData;
        end;
      end;
    end;

  finally
    freemem(SD, Size);
  end;
end;

function GeometricMean(const Data: array of Double) : Double;
begin
  Result := GeometricMean16(Data, High(Data)+1);
end;

function GeometricMean16(const Data; NData : Integer) : Double;
var
  i : Integer;
  s, t : Extended;
begin
  if (NData <= 0) then
    RaiseStatError(stscStatBadCount);

  s := 1.0;
  for i := 0 to NData-1 do begin
    t := TDoubleArray(Data)[i];
    if (t <= 0.0) then
      RaiseStatError(stscStatBadData);
    s := s*t;
  end;

  Result := Power(s, 1.0/NData);
end;

function HarmonicMean(const Data: array of Double) : Double;
begin
  Result := HarmonicMean16(Data, High(Data)+1);
end;

function HarmonicMean16(const Data; NData : Integer) : Double;
var
  i : Integer;
  s, t : Extended;