void gofw_IterPowRatioTests0 (double U[], long N, int k,
lebool printval, lebool graph, FILE * f)
{
int i;
long j;
double *UU;
gofw_TestArray sVal, pVal;
UU = (double *) util_Calloc (1 + (size_t) N, sizeof (double));
printf ("\n");
for (j = 1; j <= N; j++)
UU[j] = U[j];
for (i = 1; i <= k; i++) {
gofs_PowerRatios (UU, N);
printf ("-----------------------------------\n"
"EDF Tests after \"gofw_PowerRatios\", level :%2d\n", i);
tables_QuickSortD (UU, 1, N);
gofw_ActiveTests0 (UU, N, sVal, pVal);
gofw_WriteActiveTests0 (N, sVal, pVal);
strncpy (desc, "Values of Uniforms after PowerRatios, level ",
(size_t) LEN1);
sprintf (str, "%2d", i);
strncat (desc, str, (size_t) LEN2);
if (printval > 0)
tables_WriteTabD (UU, 1, N, 5, 15, 6, 6, desc);
if (graph > 0)
gofw_GraphDistUnif (f, UU, N, desc);
}
util_Free (UU);
}
void gofw_IterSpacingsTests0 (double U[], long N, int k,
lebool printval, lebool graph, FILE * f)
/* Assumes that U is sorted. */
{
int j;
long i;
double *S, *UU;
gofw_TestArray sVal, pVal;
UU = (double *) util_Calloc (1 + (size_t) N, sizeof (double));
S = (double *) util_Calloc (1 + (size_t) N, sizeof (double));
printf ("\n");
for (i = 1; i <= N; i++)
UU[i] = U[i]; /* UU is a copy of U */
for (j = 1; j <= k; j++) {
printf ("-----------------------------------\n"
"EDF Tests after \"gofw_IterateSpacings\", level :%2d\n", j);
gofs_DiffD (UU, S, 1, N, 0.0, 1.0);
gofs_IterateSpacings (UU, S, N);
tables_QuickSortD (UU, 1, N);
gofw_ActiveTests0 (UU, N, sVal, pVal);
gofw_WriteActiveTests0 (N, sVal, pVal);
strncpy (desc, "Values of Uniforms after IterateSpacings, level ",
(size_t) LEN1);
sprintf (str, "%2d", j);
strncat (desc, str, (size_t) LEN2);
if (printval > 0)
tables_WriteTabD (UU, 1, N, 5, 15, 6, 6, desc);
if (graph > 0)
gofw_GraphDistUnif (f, UU, N, desc);
}
util_Free (UU);
util_Free (S);
}
void sknuth_RunIndep (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r, lebool Up)
{
long Seq; /* Replication number */
double U;
double UPrec; /* Preceding value of U */
double X2;
long Nb;
long k;
int i;
long Longueur; /* Current length of the sequence */
long *Count;
double *NbExp;
double Prob[7];
char str[LENGTH + 1];
double V[1]; /* Number degrees of freedom for Chi2 */
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_RunIndep test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataRun (gen, TestName, N, n, r, Up);
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, 6, "sknuth_RunIndep");
NbExp = res->NbExp;
Count = res->Count;
res->jmin = 1;
res->jmax = 6;
sprintf (str, "NumExpected[6] < %.1f", gofs_MinExpected);
for (i = 1; i <= 5; i++) {
Prob[i] = 1.0 / num2_Factorial (i) - 1.0 / num2_Factorial (i + 1);
}
Prob[6] = 1.0 / num2_Factorial (6);
statcoll_SetDesc (res->sVal1,
"The N statistic values (a ChiSquare with 5 degrees of freedom):");
res->degFree = 5;
for (Seq = 1; Seq <= N; Seq++) {
for (i = 1; i <= 6; i++)
Count[i] = 0;
Longueur = 1;
UPrec = unif01_StripD (gen, r);
for (k = 1; k <= n; k++) {
U = unif01_StripD (gen, r);
if ((Up && U < UPrec) || (!Up && U > UPrec)) {
/* The end of a "Run" */
++Count[Longueur];
Longueur = 1;
U = unif01_StripD (gen, r);
} else if (Longueur < 6)
++Longueur;
UPrec = U;
}
++Count[Longueur];
Nb = 0;
for (i = 1; i <= 6; i++)
Nb += Count[i];
for (i = 1; i <= 6; i++)
NbExp[i] = Nb * Prob[i];
if (swrite_Counters) {
tables_WriteTabD (NbExp, 1, 6, 1, 20, 2, 1, "Expected numbers:");
tables_WriteTabL (Count, 1, 6, 1, 17, "Observed numbers:");
}
/* util_Warning (NbExp[6] < gofs_MinExpected, str); */
X2 = gofs_Chi2 (NbExp, Count, 1, 6);
statcoll_AddObs (res->sVal1, X2);
}
V[0] = 5;
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,
res->sVal2, res->pVal2);
res->pVal1->NObs = N;
sres_GetChi2SumStat (res);
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
swrite_AddStrChi (str, LENGTH, res->degFree);
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);
swrite_Chi2SumTest (N, res);
swrite_Final (gen, Timer);
}
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
}
void sknuth_Run (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r, lebool Up)
{
long Seq; /* Replication number */
double U;
double UPrec; /* Preceding value of U */
double nReal = n;
double A[6][6];
double B[6];
double *NbExp;
long k;
int j, i;
long Longueur; /* Current length of the sequence */
double Khi;
long *Count;
char str[LENGTH + 1];
double V[1]; /* Number degrees of freedom for Chi2 */
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_Run test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataRun (gen, TestName, N, n, r, Up);
if (n < 600)
return;
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, 6, "sknuth_Run");
NbExp = res->NbExp;
Count = res->Count;
res->jmin = 1;
res->jmax = 6;
A[0][0] = 4529.35365;
A[0][1] = 9044.90208;
A[0][2] = 13567.9452;
A[0][3] = 18091.2672;
A[0][4] = 22614.7139;
A[0][5] = 27892.1588;
A[1][1] = 18097.0254;
A[1][2] = 27139.4552;
A[1][3] = 36186.6493;
A[1][4] = 45233.8198;
A[1][5] = 55788.8311;
A[2][2] = 40721.3320;
A[2][3] = 54281.2656;
A[2][4] = 67852.0446;
A[2][5] = 83684.5705;
A[3][3] = 72413.6082;
A[3][4] = 90470.0789;
A[3][5] = 111580.110;
A[4][4] = 113261.815;
A[4][5] = 139475.555;
A[5][5] = 172860.170;
for (i = 2; i <= 6; i++) {
for (j = 1; j < i; j++)
A[i - 1][j - 1] = A[j - 1][i - 1];
}
B[0] = 1.0 / 6.0;
B[1] = 5.0 / 24.0;
B[2] = 11.0 / 120.0;
B[3] = 19.0 / 720.0;
B[4] = 29.0 / 5040.0;
B[5] = 1.0 / 840.0;
for (i = 1; i <= 6; i++) {
NbExp[i] = nReal * B[i - 1];
res->Loc[i] = i;
}
if (swrite_Classes)
/* gofs_Classes (NbExp, NULL, 1, 6, 0); */
tables_WriteTabD (NbExp, 1, 6, 1, 20, 2, 1, "Expected numbers:");
statcoll_SetDesc (res->sVal1,
"The N statistic values (a ChiSquare with 6 degrees of freedom):");
res->degFree = 6;
/* Beginning of test */
for (Seq = 1; Seq <= N; Seq++) {
for (i = 1; i <= 6; i++)
Count[i] = 0;
Longueur = 1;
UPrec = unif01_StripD (gen, r);
/* Generate n numbers */
for (k = 1; k < n; k++) {
U = unif01_StripD (gen, r);
if ((Up && U < UPrec) || (!Up && U > UPrec)) {
/* The end of a "Run" */
++Count[Longueur];
Longueur = 1;
} else if (Longueur < 6)
++Longueur;
UPrec = U;
}
++Count[Longueur];
if (swrite_Counters)
tables_WriteTabL (Count, 1, 6, 5, 10, "Observed numbers:");
/* Compute modified Chi2 for a sequence */
Khi = 0.0;
for (i = 1; i <= 6; i++) {
for (j = 1; j <= 6; j++) {
Khi += A[i-1][j-1]*(Count[i] - NbExp[i])*(Count[j] - NbExp[j]);
}
}
statcoll_AddObs (res->sVal1, Khi / (nReal - 6.0));
}
V[0] = 6;
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,
res->sVal2, res->pVal2);
res->pVal1->NObs = N;
sres_GetChi2SumStat (res);
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
swrite_AddStrChi (str, LENGTH, res->degFree);
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);
swrite_Chi2SumTest (N, res);
swrite_Final (gen, Timer);
}
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
}
void sspectral_Fourier2 (unif01_Gen *gen, sspectral_Res *res,
long N, int t, int r, int s)
{
const unsigned long SBIT = 1UL << (s - 1);
unsigned long jBit;
unsigned long Z;
long k, KALL, Seq, n, i;
double *A;
double x, sum;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sspectral_Fourier2 test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataFour (gen, TestName, N, t, r, s);
util_Assert (r + s <= 32, "sspectral_Fourier2: r + s > 32");
util_Assert (t <= 26, "sspectral_Fourier2: k > 26");
util_Assert (t >= 2, "sspectral_Fourier2: k < 2");
if (res == NULL) {
localRes = TRUE;
res = sspectral_CreateRes ();
}
n = num_TwoExp[t];
KALL = n / s + 1;
InitRes (res, N, 0, n, "sspectral_Fourier2");
statcoll_SetDesc (res->Bas->sVal1, "sVal1: a standard normal");
A = res->Coef;
for (Seq = 1; Seq <= N; Seq++) {
/* Fill array A: 1 for bit 1, -1 for bit 0 */
i = 0;
for (k = 0; k < KALL; k++) {
Z = unif01_StripB (gen, r, s);
jBit = SBIT;
while (jBit) {
if (jBit & Z)
A[i] = 1.0;
else
A[i] = -1.0;
jBit >>= 1;
i++;
}
}
/*
* Compute the Fourier transform of A and return the result in A. The
* first half of the array, (from 0 to n/2) is filled with the real
* components of the FFT. The second half of the array (from n/2+1 to
* n-1) is filled with the imaginary components of the FFT.
* The n new elements of A are thus:
* [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]
* The procedure is due to H.V. Sorensen, University of Pennsylvania
* and is found in file fftc.c.
*/
rsrfft (A, t);
/* Sum the square of the Fourier coefficients (only half of them) */
sum = 0.0;
for (i = 1; i <= n / 4; i++)
sum += A[i] * A[i] + A[n - i] * A[n - i];
/* There is an extra sqrt (n) factor between the Fourier coefficients
of Sorensen and those of Erdmann */
sum /= n;
/* Standardize the statistic */
x = 2.0*(sum - n / 4.0) / sqrt (n - 2.0);
statcoll_AddObs (res->Bas->sVal1, x);
if (swrite_Counters) {
tables_WriteTabD (res->Coef, 0, n - 1, 5, 14, 5, 5,
"Fourier coefficients");
}
}
gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N, wdist_Normal,
(double *) NULL, res->Bas->sVal2, res->Bas->pVal2);
res->Bas->pVal1->NObs = N;
sres_GetNormalSumStat (res->Bas);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2,
"Normal statistic :");
swrite_NormalSumTest (N, res->Bas);
if (swrite_Collectors)
statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);
swrite_Final (gen, Timer);
}
if (localRes)
sspectral_DeleteRes (res);
chrono_Delete (Timer);
}
void sspectral_Fourier3 (unif01_Gen *gen, sspectral_Res *res,
long N, int t, int r, int s)
{
const unsigned long SBIT = 1UL << (s - 1);
unsigned long jBit;
unsigned long Z;
long k, KALL, Seq, n, i;
double *A, *B;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sspectral_Fourier3 test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataFour (gen, TestName, N, t, r, s);
util_Assert (r + s <= 32, "sspectral_Fourier3: r + s > 32");
util_Assert (t <= 26, "sspectral_Fourier3: k > 26");
util_Assert (t >= 2, "sspectral_Fourier3: k < 2");
if (res == NULL) {
localRes = TRUE;
res = sspectral_CreateRes ();
}
n = num_TwoExp[t];
KALL = n / s + 1;
InitRes (res, n/4 + 1, 0, n, "sspectral_Fourier3");
statcoll_SetDesc (res->Bas->sVal1, "sVal1: a standard normal");
B = res->Bas->sVal1->V;
A = res->Coef;
for (i = 0; i <= n / 4; i++)
B[i] = 0.0;
for (Seq = 1; Seq <= N; Seq++) {
/* Fill array A: 1 for bit 1, -1 for bit 0 */
i = 0;
for (k = 0; k < KALL; k++) {
Z = unif01_StripB (gen, r, s);
jBit = SBIT;
while (jBit) {
if (jBit & Z)
A[i] = 1.0;
else
A[i] = -1.0;
jBit >>= 1;
i++;
}
}
/*
* Compute the Fourier transform of A and return the result in A. The
* first half of the array, (from 0 to n/2) is filled with the real
* components of the FFT. The second half of the array (from n/2+1 to
* n-1) is filled with the imaginary components of the FFT.
* The n new elements of A are thus:
* [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]
* The procedure is due to H.V. Sorensen, University of Pennsylvania
* and is found in file fftc.c.
*/
rsrfft (A, t);
/* Add the squares of the Fourier coefficients over the N replications
for each i = [1, ..., n/4], and keep them in B[i] */
for (i = 1; i <= n / 4; i++)
B[i] += A[i] * A[i] + A[n - i] * A[n - i];
if (0 && swrite_Counters)
tables_WriteTabD (B, 1, n / 4, 5, 14, 5, 5,
"Sums of square of Fourier coefficients");
}
/* There is an extra sqrt (n) factor between the Fourier coefficients
of Sorensen and those of Erdmann */
for (i = 1; i <= n / 4; i++)
B[i] /= n;
/* The N random variables have been added for each i and kept in B[i].
Their mean (1) and variance (~1) is known from Diane Erdmann. Now
consider the B[i] as n/4 normal random variables. */
for (i = 1; i <= n / 4; i++) {
B[i] = (B[i] - N) / sqrt (N * (1.0 - 2.0 / n));
statcoll_AddObs (res->Bas->sVal1, B[i]);
}
gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, n/4, wdist_Normal,
(double *) NULL, res->Bas->sVal2, res->Bas->pVal2);
res->Bas->pVal1->NObs = n/4;
if (swrite_Basic) {
gofw_WriteActiveTests2 (n/4, res->Bas->sVal2, res->Bas->pVal2,
"Normal statistic :");
if (swrite_Collectors)
statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);
swrite_Final (gen, Timer);
}
if (localRes)
sspectral_DeleteRes (res);
chrono_Delete (Timer);
}
void sspectral_Fourier1 (unif01_Gen *gen, sspectral_Res *res,
long N, int t, int r, int s)
{
const unsigned long SBIT = 1UL << (s - 1);
unsigned long jBit;
unsigned long Z;
long k, KALL, Seq, n, i;
double x, NbExp, h, per;
long co;
double *A;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sspectral_Fourier1 test";
Timer = chrono_Create ();
util_Assert (t <= 20, "sspectral_Fourier1: k > 20");
util_Assert (t > 1, "sspectral_Fourier1: k < 2");
if (swrite_Basic)
WriteDataFour (gen, TestName, N, t, r, s);
if (res == NULL) {
localRes = TRUE;
res = sspectral_CreateRes ();
}
n = num_TwoExp[t];
KALL = n / s;
if (n % s > 0)
KALL++;
per = 0.95;
NbExp = per * (n / 2 + 1);
/* h = 3.0 * n; */
h = 2.995732274 * n;
InitRes (res, N, 0, n, "sspectral_Fourier1");
statcoll_SetDesc (res->Bas->sVal1, "sVal1: a standard normal");
A = res->Coef;
for (Seq = 1; Seq <= N; Seq++) {
/* Fill array A: 1 for bit 1, -1 for bit 0 */
i = 0;
for (k = 0; k < KALL; k++) {
Z = unif01_StripB (gen, r, s);
jBit = SBIT;
while (jBit) {
if (jBit & Z)
A[i] = 1.0;
else
A[i] = -1.0;
jBit >>= 1;
i++;
}
}
/*
* Compute the Fourier transform of A and return the result in A. The
* first half of the array, (from 0 to n/2) is filled with the real
* components of the FFT. The second half of the array (from n/2+1 to
* n-1) is filled with the imaginary components of the FFT.
* The n new elements of A are thus:
* [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]
* The procedure is due to H.V. Sorensen, University of Pennsylvania
* and is found in file fftc.c.
*/
rsrfft (A, t);
/* Count the number of Fourier coefficients smaller than h */
co = 0;
for (i = 1; i < n / 2; i++) {
x = A[i] * A[i] + A[n - i] * A[n - i];
if (x < h)
co++;
}
if (A[0] * A[0] < h)
co++;
/* Compute the NIST statistic */
x = (co - NbExp) / sqrt (NbExp * (1.0 - per));
statcoll_AddObs (res->Bas->sVal1, x);
if (swrite_Counters) {
tables_WriteTabD (res->Coef, 0, n - 1, 5, 14, 5, 5,
"Fourier coefficients");
}
}
gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N, wdist_Normal,
(double *) NULL, res->Bas->sVal2, res->Bas->pVal2);
res->Bas->pVal1->NObs = N;
sres_GetNormalSumStat (res->Bas);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2,
"Normal statistic :");
swrite_NormalSumTest (N, res->Bas);
if (swrite_Collectors)
statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);
swrite_Final (gen, Timer);
}
if (localRes)
sspectral_DeleteRes (res);
chrono_Delete (Timer);
}
