mirror of
https://github.com/netdata/netdata.git
synced 2025-04-17 03:02:41 +00:00

* initial attempt at metric correlations * fix loop * simplify struct * change json * get points from query * comment * dont lock the host as much * add a configuration option to enable/disable metric correlations * remove KSfbar from header file * lock charts * add timeout * cast multiplication * add licencing info * better licencing * use onewayalloc * destroy owa
788 lines
19 KiB
C
788 lines
19 KiB
C
// SPDX-License-Identifier: GPL-3.0
|
|
|
|
/********************************************************************
|
|
*
|
|
* File: KolmogorovSmirnovDist.c
|
|
* Environment: ISO C99 or ANSI C89
|
|
* Author: Richard Simard
|
|
* Organization: DIRO, Université de Montréal
|
|
* Date: 1 February 2012
|
|
* Version 1.1
|
|
|
|
* Copyright 1 march 2010 by Université de Montréal,
|
|
Richard Simard and Pierre L'Ecuyer
|
|
=====================================================================
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, version 3 of the License.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
=====================================================================*/
|
|
|
|
#include "KolmogorovSmirnovDist.h"
|
|
#include <math.h>
|
|
#include <stdlib.h>
|
|
|
|
#define num_Pi 3.14159265358979323846 /* PI */
|
|
#define num_Ln2 0.69314718055994530941 /* log(2) */
|
|
|
|
/* For x close to 0 or 1, we use the exact formulae of Ruben-Gambino in all
|
|
cases. For n <= NEXACT, we use exact algorithms: the Durbin matrix and
|
|
the Pomeranz algorithms. For n > NEXACT, we use asymptotic methods
|
|
except for x close to 0 where we still use the method of Durbin
|
|
for n <= NKOLMO. For n > NKOLMO, we use asymptotic methods only and
|
|
so the precision is less for x close to 0.
|
|
We could increase the limit NKOLMO to 10^6 to get better precision
|
|
for x close to 0, but at the price of a slower speed. */
|
|
#define NEXACT 500
|
|
#define NKOLMO 100000
|
|
|
|
/* The Durbin matrix algorithm for the Kolmogorov-Smirnov distribution */
|
|
static double DurbinMatrix (int n, double d);
|
|
|
|
|
|
/*========================================================================*/
|
|
#if 0
|
|
|
|
/* For ANSI C89 only, not for ISO C99 */
|
|
#define MAXI 50
|
|
#define EPSILON 1.0e-15
|
|
|
|
double log1p (double x)
|
|
{
|
|
/* returns a value equivalent to log(1 + x) accurate also for small x. */
|
|
if (fabs (x) > 0.1) {
|
|
return log (1.0 + x);
|
|
} else {
|
|
double term = x;
|
|
double sum = x;
|
|
int s = 2;
|
|
while ((fabs (term) > EPSILON * fabs (sum)) && (s < MAXI)) {
|
|
term *= -x;
|
|
sum += term / s;
|
|
s++;
|
|
}
|
|
return sum;
|
|
}
|
|
}
|
|
|
|
#undef MAXI
|
|
#undef EPSILON
|
|
|
|
#endif
|
|
|
|
/*========================================================================*/
|
|
#define MFACT 30
|
|
|
|
/* The natural logarithm of factorial n! for 0 <= n <= MFACT */
|
|
static double LnFactorial[MFACT + 1] = {
|
|
0.,
|
|
0.,
|
|
0.6931471805599453,
|
|
1.791759469228055,
|
|
3.178053830347946,
|
|
4.787491742782046,
|
|
6.579251212010101,
|
|
8.525161361065415,
|
|
10.60460290274525,
|
|
12.80182748008147,
|
|
15.10441257307552,
|
|
17.50230784587389,
|
|
19.98721449566188,
|
|
22.55216385312342,
|
|
25.19122118273868,
|
|
27.89927138384088,
|
|
30.67186010608066,
|
|
33.50507345013688,
|
|
36.39544520803305,
|
|
39.33988418719949,
|
|
42.33561646075348,
|
|
45.3801388984769,
|
|
48.47118135183522,
|
|
51.60667556776437,
|
|
54.7847293981123,
|
|
58.00360522298051,
|
|
61.26170176100199,
|
|
64.55753862700632,
|
|
67.88974313718154,
|
|
71.257038967168,
|
|
74.65823634883016
|
|
};
|
|
|
|
/*------------------------------------------------------------------------*/
|
|
|
|
static double getLogFactorial (int n)
|
|
{
|
|
/* Returns the natural logarithm of factorial n! */
|
|
if (n <= MFACT) {
|
|
return LnFactorial[n];
|
|
|
|
} else {
|
|
double x = (double) (n + 1);
|
|
double y = 1.0 / (x * x);
|
|
double z = ((-(5.95238095238E-4 * y) + 7.936500793651E-4) * y -
|
|
2.7777777777778E-3) * y + 8.3333333333333E-2;
|
|
z = ((x - 0.5) * log (x) - x) + 9.1893853320467E-1 + z / x;
|
|
return z;
|
|
}
|
|
}
|
|
|
|
/*------------------------------------------------------------------------*/
|
|
|
|
static double rapfac (int n)
|
|
{
|
|
/* Computes n! / n^n */
|
|
int i;
|
|
double res = 1.0 / n;
|
|
for (i = 2; i <= n; i++) {
|
|
res *= (double) i / n;
|
|
}
|
|
return res;
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
static double **CreateMatrixD (int N, int M)
|
|
{
|
|
int i;
|
|
double **T2;
|
|
|
|
T2 = (double **) malloc (N * sizeof (double *));
|
|
T2[0] = (double *) malloc ((size_t) N * M * sizeof (double));
|
|
for (i = 1; i < N; i++)
|
|
T2[i] = T2[0] + i * M;
|
|
return T2;
|
|
}
|
|
|
|
|
|
static void DeleteMatrixD (double **T)
|
|
{
|
|
free (T[0]);
|
|
free (T);
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
static double KSPlusbarAsymp (int n, double x)
|
|
{
|
|
/* Compute the probability of the KS+ distribution using an asymptotic
|
|
formula */
|
|
double t = (6.0 * n * x + 1);
|
|
double z = t * t / (18.0 * n);
|
|
double v = 1.0 - (2.0 * z * z - 4.0 * z - 1.0) / (18.0 * n);
|
|
if (v <= 0.0)
|
|
return 0.0;
|
|
v = v * exp (-z);
|
|
if (v >= 1.0)
|
|
return 1.0;
|
|
return v;
|
|
}
|
|
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
static double KSPlusbarUpper (int n, double x)
|
|
{
|
|
/* Compute the probability of the KS+ distribution in the upper tail using
|
|
Smirnov's stable formula */
|
|
const double EPSILON = 1.0E-12;
|
|
double q;
|
|
double Sum = 0.0;
|
|
double term;
|
|
double t;
|
|
double LogCom;
|
|
double LOGJMAX;
|
|
int j;
|
|
int jdiv;
|
|
int jmax = (int) (n * (1.0 - x));
|
|
|
|
if (n > 200000)
|
|
return KSPlusbarAsymp (n, x);
|
|
|
|
/* Avoid log(0) for j = jmax and q ~ 1.0 */
|
|
if ((1.0 - x - (double) jmax / n) <= 0.0)
|
|
jmax--;
|
|
|
|
if (n > 3000)
|
|
jdiv = 2;
|
|
else
|
|
jdiv = 3;
|
|
|
|
j = jmax / jdiv + 1;
|
|
LogCom = getLogFactorial (n) - getLogFactorial (j) -
|
|
getLogFactorial (n - j);
|
|
LOGJMAX = LogCom;
|
|
|
|
while (j <= jmax) {
|
|
q = (double) j / n + x;
|
|
term = LogCom + (j - 1) * log (q) + (n - j) * log1p (-q);
|
|
t = exp (term);
|
|
Sum += t;
|
|
LogCom += log ((double) (n - j) / (j + 1));
|
|
if (t <= Sum * EPSILON)
|
|
break;
|
|
j++;
|
|
}
|
|
|
|
j = jmax / jdiv;
|
|
LogCom = LOGJMAX + log ((double) (j + 1) / (n - j));
|
|
|
|
while (j > 0) {
|
|
q = (double) j / n + x;
|
|
term = LogCom + (j - 1) * log (q) + (n - j) * log1p (-q);
|
|
t = exp (term);
|
|
Sum += t;
|
|
LogCom += log ((double) j / (n - j + 1));
|
|
if (t <= Sum * EPSILON)
|
|
break;
|
|
j--;
|
|
}
|
|
|
|
Sum *= x;
|
|
/* add the term j = 0 */
|
|
Sum += exp (n * log1p (-x));
|
|
return Sum;
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
static double Pelz (int n, double x)
|
|
{
|
|
/* Approximating the Lower Tail-Areas of the Kolmogorov-Smirnov One-Sample
|
|
Statistic,
|
|
Wolfgang Pelz and I. J. Good,
|
|
Journal of the Royal Statistical Society, Series B.
|
|
Vol. 38, No. 2 (1976), pp. 152-156
|
|
*/
|
|
|
|
const int JMAX = 20;
|
|
const double EPS = 1.0e-10;
|
|
const double C = 2.506628274631001; /* sqrt(2*Pi) */
|
|
const double C2 = 1.2533141373155001; /* sqrt(Pi/2) */
|
|
const double PI2 = num_Pi * num_Pi;
|
|
const double PI4 = PI2 * PI2;
|
|
const double RACN = sqrt ((double) n);
|
|
const double z = RACN * x;
|
|
const double z2 = z * z;
|
|
const double z4 = z2 * z2;
|
|
const double z6 = z4 * z2;
|
|
const double w = PI2 / (2.0 * z * z);
|
|
double ti, term, tom;
|
|
double sum;
|
|
int j;
|
|
|
|
term = 1;
|
|
j = 0;
|
|
sum = 0;
|
|
while (j <= JMAX && term > EPS * sum) {
|
|
ti = j + 0.5;
|
|
term = exp (-ti * ti * w);
|
|
sum += term;
|
|
j++;
|
|
}
|
|
sum *= C / z;
|
|
|
|
term = 1;
|
|
tom = 0;
|
|
j = 0;
|
|
while (j <= JMAX && fabs (term) > EPS * fabs (tom)) {
|
|
ti = j + 0.5;
|
|
term = (PI2 * ti * ti - z2) * exp (-ti * ti * w);
|
|
tom += term;
|
|
j++;
|
|
}
|
|
sum += tom * C2 / (RACN * 3.0 * z4);
|
|
|
|
term = 1;
|
|
tom = 0;
|
|
j = 0;
|
|
while (j <= JMAX && fabs (term) > EPS * fabs (tom)) {
|
|
ti = j + 0.5;
|
|
term = 6 * z6 + 2 * z4 + PI2 * (2 * z4 - 5 * z2) * ti * ti +
|
|
PI4 * (1 - 2 * z2) * ti * ti * ti * ti;
|
|
term *= exp (-ti * ti * w);
|
|
tom += term;
|
|
j++;
|
|
}
|
|
sum += tom * C2 / (n * 36.0 * z * z6);
|
|
|
|
term = 1;
|
|
tom = 0;
|
|
j = 1;
|
|
while (j <= JMAX && term > EPS * tom) {
|
|
ti = j;
|
|
term = PI2 * ti * ti * exp (-ti * ti * w);
|
|
tom += term;
|
|
j++;
|
|
}
|
|
sum -= tom * C2 / (n * 18.0 * z * z2);
|
|
|
|
term = 1;
|
|
tom = 0;
|
|
j = 0;
|
|
while (j <= JMAX && fabs (term) > EPS * fabs (tom)) {
|
|
ti = j + 0.5;
|
|
ti = ti * ti;
|
|
term = -30 * z6 - 90 * z6 * z2 + PI2 * (135 * z4 - 96 * z6) * ti +
|
|
PI4 * (212 * z4 - 60 * z2) * ti * ti + PI2 * PI4 * ti * ti * ti * (5 -
|
|
30 * z2);
|
|
term *= exp (-ti * w);
|
|
tom += term;
|
|
j++;
|
|
}
|
|
sum += tom * C2 / (RACN * n * 3240.0 * z4 * z6);
|
|
|
|
term = 1;
|
|
tom = 0;
|
|
j = 1;
|
|
while (j <= JMAX && fabs (term) > EPS * fabs (tom)) {
|
|
ti = j * j;
|
|
term = (3 * PI2 * ti * z2 - PI4 * ti * ti) * exp (-ti * w);
|
|
tom += term;
|
|
j++;
|
|
}
|
|
sum += tom * C2 / (RACN * n * 108.0 * z6);
|
|
|
|
return sum;
|
|
}
|
|
|
|
|
|
/*=========================================================================*/
|
|
|
|
static void CalcFloorCeil (
|
|
int n, /* sample size */
|
|
double t, /* = nx */
|
|
double *A, /* A_i */
|
|
double *Atflo, /* floor (A_i - t) */
|
|
double *Atcei /* ceiling (A_i + t) */
|
|
)
|
|
{
|
|
/* Precompute A_i, floors, and ceilings for limits of sums in the Pomeranz
|
|
algorithm */
|
|
int i;
|
|
int ell = (int) t; /* floor (t) */
|
|
double z = t - ell; /* t - floor (t) */
|
|
double w = ceil (t) - t;
|
|
|
|
if (z > 0.5) {
|
|
for (i = 2; i <= 2 * n + 2; i += 2)
|
|
Atflo[i] = i / 2 - 2 - ell;
|
|
for (i = 1; i <= 2 * n + 2; i += 2)
|
|
Atflo[i] = i / 2 - 1 - ell;
|
|
|
|
for (i = 2; i <= 2 * n + 2; i += 2)
|
|
Atcei[i] = i / 2 + ell;
|
|
for (i = 1; i <= 2 * n + 2; i += 2)
|
|
Atcei[i] = i / 2 + 1 + ell;
|
|
|
|
} else if (z > 0.0) {
|
|
for (i = 1; i <= 2 * n + 2; i++)
|
|
Atflo[i] = i / 2 - 1 - ell;
|
|
|
|
for (i = 2; i <= 2 * n + 2; i++)
|
|
Atcei[i] = i / 2 + ell;
|
|
Atcei[1] = 1 + ell;
|
|
|
|
} else { /* z == 0 */
|
|
for (i = 2; i <= 2 * n + 2; i += 2)
|
|
Atflo[i] = i / 2 - 1 - ell;
|
|
for (i = 1; i <= 2 * n + 2; i += 2)
|
|
Atflo[i] = i / 2 - ell;
|
|
|
|
for (i = 2; i <= 2 * n + 2; i += 2)
|
|
Atcei[i] = i / 2 - 1 + ell;
|
|
for (i = 1; i <= 2 * n + 2; i += 2)
|
|
Atcei[i] = i / 2 + ell;
|
|
}
|
|
|
|
if (w < z)
|
|
z = w;
|
|
A[0] = A[1] = 0;
|
|
A[2] = z;
|
|
A[3] = 1 - A[2];
|
|
for (i = 4; i <= 2 * n + 1; i++)
|
|
A[i] = A[i - 2] + 1;
|
|
A[2 * n + 2] = n;
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
static double Pomeranz (int n, double x)
|
|
{
|
|
/* The Pomeranz algorithm to compute the KS distribution */
|
|
const double EPS = 1.0e-15;
|
|
const int ENO = 350;
|
|
const double RENO = ldexp (1.0, ENO); /* for renormalization of V */
|
|
int coreno; /* counter: how many renormalizations */
|
|
const double t = n * x;
|
|
double w, sum, minsum;
|
|
int i, j, k, s;
|
|
int r1, r2; /* Indices i and i-1 for V[i][] */
|
|
int jlow, jup, klow, kup, kup0;
|
|
double *A;
|
|
double *Atflo;
|
|
double *Atcei;
|
|
double **V;
|
|
double **H; /* = pow(w, j) / Factorial(j) */
|
|
|
|
A = (double *) calloc ((size_t) (2 * n + 3), sizeof (double));
|
|
Atflo = (double *) calloc ((size_t) (2 * n + 3), sizeof (double));
|
|
Atcei = (double *) calloc ((size_t) (2 * n + 3), sizeof (double));
|
|
V = (double **) CreateMatrixD (2, n + 2);
|
|
H = (double **) CreateMatrixD (4, n + 2);
|
|
|
|
CalcFloorCeil (n, t, A, Atflo, Atcei);
|
|
|
|
for (j = 1; j <= n + 1; j++)
|
|
V[0][j] = 0;
|
|
for (j = 2; j <= n + 1; j++)
|
|
V[1][j] = 0;
|
|
V[1][1] = RENO;
|
|
coreno = 1;
|
|
|
|
/* Precompute H[][] = (A[j] - A[j-1]^k / k! for speed */
|
|
H[0][0] = 1;
|
|
w = 2.0 * A[2] / n;
|
|
for (j = 1; j <= n + 1; j++)
|
|
H[0][j] = w * H[0][j - 1] / j;
|
|
|
|
H[1][0] = 1;
|
|
w = (1.0 - 2.0 * A[2]) / n;
|
|
for (j = 1; j <= n + 1; j++)
|
|
H[1][j] = w * H[1][j - 1] / j;
|
|
|
|
H[2][0] = 1;
|
|
w = A[2] / n;
|
|
for (j = 1; j <= n + 1; j++)
|
|
H[2][j] = w * H[2][j - 1] / j;
|
|
|
|
H[3][0] = 1;
|
|
for (j = 1; j <= n + 1; j++)
|
|
H[3][j] = 0;
|
|
|
|
r1 = 0;
|
|
r2 = 1;
|
|
for (i = 2; i <= 2 * n + 2; i++) {
|
|
jlow = 2 + (int) Atflo[i];
|
|
if (jlow < 1)
|
|
jlow = 1;
|
|
jup = (int) Atcei[i];
|
|
if (jup > n + 1)
|
|
jup = n + 1;
|
|
|
|
klow = 2 + (int) Atflo[i - 1];
|
|
if (klow < 1)
|
|
klow = 1;
|
|
kup0 = (int) Atcei[i - 1];
|
|
|
|
/* Find to which case it corresponds */
|
|
w = (A[i] - A[i - 1]) / n;
|
|
s = -1;
|
|
for (j = 0; j < 4; j++) {
|
|
if (fabs (w - H[j][1]) <= EPS) {
|
|
s = j;
|
|
break;
|
|
}
|
|
}
|
|
/* assert (s >= 0, "Pomeranz: s < 0"); */
|
|
|
|
minsum = RENO;
|
|
r1 = (r1 + 1) & 1; /* i - 1 */
|
|
r2 = (r2 + 1) & 1; /* i */
|
|
|
|
for (j = jlow; j <= jup; j++) {
|
|
kup = kup0;
|
|
if (kup > j)
|
|
kup = j;
|
|
sum = 0;
|
|
for (k = kup; k >= klow; k--)
|
|
sum += V[r1][k] * H[s][j - k];
|
|
V[r2][j] = sum;
|
|
if (sum < minsum)
|
|
minsum = sum;
|
|
}
|
|
|
|
if (minsum < 1.0e-280) {
|
|
/* V is too small: renormalize to avoid underflow of probabilities */
|
|
for (j = jlow; j <= jup; j++)
|
|
V[r2][j] *= RENO;
|
|
coreno++; /* keep track of log of RENO */
|
|
}
|
|
}
|
|
|
|
sum = V[r2][n + 1];
|
|
free (A);
|
|
free (Atflo);
|
|
free (Atcei);
|
|
DeleteMatrixD (H);
|
|
DeleteMatrixD (V);
|
|
w = getLogFactorial (n) - coreno * ENO * num_Ln2 + log (sum);
|
|
if (w >= 0.)
|
|
return 1.;
|
|
return exp (w);
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
static double cdfSpecial (int n, double x)
|
|
{
|
|
/* The KS distribution is known exactly for these cases */
|
|
|
|
/* For nx^2 > 18, KSfbar(n, x) is smaller than 5e-16 */
|
|
if ((n * x * x >= 18.0) || (x >= 1.0))
|
|
return 1.0;
|
|
|
|
if (x <= 0.5 / n)
|
|
return 0.0;
|
|
|
|
if (n == 1)
|
|
return 2.0 * x - 1.0;
|
|
|
|
if (x <= 1.0 / n) {
|
|
double t = 2.0 * x * n - 1.0;
|
|
double w;
|
|
if (n <= NEXACT) {
|
|
w = rapfac (n);
|
|
return w * pow (t, (double) n);
|
|
}
|
|
w = getLogFactorial (n) + n * log (t / n);
|
|
return exp (w);
|
|
}
|
|
|
|
if (x >= 1.0 - 1.0 / n) {
|
|
return 1.0 - 2.0 * pow (1.0 - x, (double) n);
|
|
}
|
|
|
|
return -1.0;
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
double KScdf (int n, double x)
|
|
{
|
|
const double w = n * x * x;
|
|
double u = cdfSpecial (n, x);
|
|
if (u >= 0.0)
|
|
return u;
|
|
|
|
if (n <= NEXACT) {
|
|
if (w < 0.754693)
|
|
return DurbinMatrix (n, x);
|
|
if (w < 4.0)
|
|
return Pomeranz (n, x);
|
|
return 1.0 - KSfbar (n, x);
|
|
}
|
|
|
|
if ((w * x * n <= 7.0) && (n <= NKOLMO))
|
|
return DurbinMatrix (n, x);
|
|
|
|
return Pelz (n, x);
|
|
}
|
|
|
|
|
|
/*=========================================================================*/
|
|
|
|
static double fbarSpecial (int n, double x)
|
|
{
|
|
const double w = n * x * x;
|
|
|
|
if ((w >= 370.0) || (x >= 1.0))
|
|
return 0.0;
|
|
if ((w <= 0.0274) || (x <= 0.5 / n))
|
|
return 1.0;
|
|
if (n == 1)
|
|
return 2.0 - 2.0 * x;
|
|
|
|
if (x <= 1.0 / n) {
|
|
double z;
|
|
double t = 2.0 * x * n - 1.0;
|
|
if (n <= NEXACT) {
|
|
z = rapfac (n);
|
|
return 1.0 - z * pow (t, (double) n);
|
|
}
|
|
z = getLogFactorial (n) + n * log (t / n);
|
|
return 1.0 - exp (z);
|
|
}
|
|
|
|
if (x >= 1.0 - 1.0 / n) {
|
|
return 2.0 * pow (1.0 - x, (double) n);
|
|
}
|
|
return -1.0;
|
|
}
|
|
|
|
|
|
/*========================================================================*/
|
|
|
|
double KSfbar (int n, double x)
|
|
{
|
|
const double w = n * x * x;
|
|
double v = fbarSpecial (n, x);
|
|
if (v >= 0.0)
|
|
return v;
|
|
|
|
if (n <= NEXACT) {
|
|
if (w < 4.0)
|
|
return 1.0 - KScdf (n, x);
|
|
else
|
|
return 2.0 * KSPlusbarUpper (n, x);
|
|
}
|
|
|
|
if (w >= 2.65)
|
|
return 2.0 * KSPlusbarUpper (n, x);
|
|
|
|
return 1.0 - KScdf (n, x);
|
|
}
|
|
|
|
|
|
/*=========================================================================
|
|
|
|
The following implements the Durbin matrix algorithm and was programmed by
|
|
G. Marsaglia, Wai Wan Tsang and Jingbo Wong.
|
|
|
|
I have made small modifications in their program. (Richard Simard)
|
|
|
|
|
|
|
|
=========================================================================*/
|
|
|
|
/*
|
|
The C program to compute Kolmogorov's distribution
|
|
|
|
K(n,d) = Prob(D_n < d), where
|
|
|
|
D_n = max(x_1-0/n,x_2-1/n...,x_n-(n-1)/n,1/n-x_1,2/n-x_2,...,n/n-x_n)
|
|
|
|
with x_1<x_2,...<x_n a purported set of n independent uniform [0,1)
|
|
random variables sorted into increasing order.
|
|
See G. Marsaglia, Wai Wan Tsang and Jingbo Wong,
|
|
J.Stat.Software, 8, 18, pp 1--4, (2003).
|
|
*/
|
|
|
|
#define NORM 1.0e140
|
|
#define INORM 1.0e-140
|
|
#define LOGNORM 140
|
|
|
|
|
|
/* Matrix product */
|
|
static void mMultiply (double *A, double *B, double *C, int m);
|
|
|
|
/* Matrix power */
|
|
static void mPower (double *A, int eA, double *V, int *eV, int m, int n);
|
|
|
|
|
|
static double DurbinMatrix (int n, double d)
|
|
{
|
|
int k, m, i, j, g, eH, eQ;
|
|
double h, s, *H, *Q;
|
|
/* OMIT NEXT TWO LINES IF YOU REQUIRE >7 DIGIT ACCURACY IN THE RIGHT TAIL */
|
|
#if 0
|
|
s = d * d * n;
|
|
if (s > 7.24 || (s > 3.76 && n > 99))
|
|
return 1 - 2 * exp (-(2.000071 + .331 / sqrt (n) + 1.409 / n) * s);
|
|
#endif
|
|
k = (int) (n * d) + 1;
|
|
m = 2 * k - 1;
|
|
h = k - n * d;
|
|
H = (double *) malloc ((m * m) * sizeof (double));
|
|
Q = (double *) malloc ((m * m) * sizeof (double));
|
|
for (i = 0; i < m; i++)
|
|
for (j = 0; j < m; j++)
|
|
if (i - j + 1 < 0)
|
|
H[i * m + j] = 0;
|
|
else
|
|
H[i * m + j] = 1;
|
|
for (i = 0; i < m; i++) {
|
|
H[i * m] -= pow (h, (double) (i + 1));
|
|
H[(m - 1) * m + i] -= pow (h, (double) (m - i));
|
|
}
|
|
H[(m - 1) * m] += (2 * h - 1 > 0 ? pow (2 * h - 1, (double) m) : 0);
|
|
for (i = 0; i < m; i++)
|
|
for (j = 0; j < m; j++)
|
|
if (i - j + 1 > 0)
|
|
for (g = 1; g <= i - j + 1; g++)
|
|
H[i * m + j] /= g;
|
|
eH = 0;
|
|
mPower (H, eH, Q, &eQ, m, n);
|
|
s = Q[(k - 1) * m + k - 1];
|
|
|
|
for (i = 1; i <= n; i++) {
|
|
s = s * (double) i / n;
|
|
if (s < INORM) {
|
|
s *= NORM;
|
|
eQ -= LOGNORM;
|
|
}
|
|
}
|
|
s *= pow (10., (double) eQ);
|
|
free (H);
|
|
free (Q);
|
|
return s;
|
|
}
|
|
|
|
|
|
static void mMultiply (double *A, double *B, double *C, int m)
|
|
{
|
|
int i, j, k;
|
|
double s;
|
|
for (i = 0; i < m; i++)
|
|
for (j = 0; j < m; j++) {
|
|
s = 0.;
|
|
for (k = 0; k < m; k++)
|
|
s += A[i * m + k] * B[k * m + j];
|
|
C[i * m + j] = s;
|
|
}
|
|
}
|
|
|
|
|
|
static void renormalize (double *V, int m, int *p)
|
|
{
|
|
int i;
|
|
for (i = 0; i < m * m; i++)
|
|
V[i] *= INORM;
|
|
*p += LOGNORM;
|
|
}
|
|
|
|
|
|
static void mPower (double *A, int eA, double *V, int *eV, int m, int n)
|
|
{
|
|
double *B;
|
|
int eB, i;
|
|
if (n == 1) {
|
|
for (i = 0; i < m * m; i++)
|
|
V[i] = A[i];
|
|
*eV = eA;
|
|
return;
|
|
}
|
|
mPower (A, eA, V, eV, m, n / 2);
|
|
B = (double *) malloc ((m * m) * sizeof (double));
|
|
mMultiply (V, V, B, m);
|
|
eB = 2 * (*eV);
|
|
if (B[(m / 2) * m + (m / 2)] > NORM)
|
|
renormalize (B, m, &eB);
|
|
|
|
if (n % 2 == 0) {
|
|
for (i = 0; i < m * m; i++)
|
|
V[i] = B[i];
|
|
*eV = eB;
|
|
} else {
|
|
mMultiply (A, B, V, m);
|
|
*eV = eA + eB;
|
|
}
|
|
|
|
if (V[(m / 2) * m + (m / 2)] > NORM)
|
|
renormalize (V, m, eV);
|
|
free (B);
|
|
}
|