static void WriteResultsDisc (long N, gofw_TestArray sVal2, gofw_TestArray pVal2,
sres_Basic *res)
{
if (N > 1) {
gofw_WriteActiveTests0 (N, sVal2, pVal2);
swrite_NormalSumTest (N, res);
printf ("Standardized empirical correlation :");
gofw_Writep2 (sVal2[gofw_Cor], pVal2[gofw_Cor]);
} else {
printf ("Standardized statistic value :");
gofw_Writep2 (sVal2[gofw_Mean], pVal2[gofw_Mean]);
}
}
void svaria_SampleCorr (unif01_Gen * gen, sres_Basic * res,
long N, long n, int r, int k)
{
long i;
long Seq;
double U;
double Sum;
double *Pre; /* Previous k generated numbers */
int pos; /* Circular index to element at lag k */
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_SampleCorr test";
Timer = chrono_Create ();
if (swrite_Basic) {
swrite_Head (gen, TestName, N, n, r);
printf (", k = %d\n\n", k);
}
util_Assert (n > 2, "svaria_SampleCorr: n <= 2");
if (res == NULL) {
localRes = TRUE;
res = sres_CreateBasic ();
}
sres_InitBasic (res, N, "svaria_SampleCorr");
statcoll_SetDesc (res->sVal1,
"SampleCorr sVal1: asymptotic standard normal");
Pre = util_Calloc ((size_t) (k + 1), sizeof (double));
for (Seq = 1; Seq <= N; Seq++) {
/* Generate first k numbers U and keep them in Pre */
for (i = 0; i < k; i++)
Pre[i] = unif01_StripD (gen, r);
Sum = 0.0;
pos = 0;
/* Element Pre[pos] is at lag k from U */
for (i = k; i < n; i++) {
U = unif01_StripD (gen, r);
Sum += Pre[pos] * U - 0.25;
Pre[pos] = U;
pos++;
pos %= k;
}
/* Save standardized correlation */
statcoll_AddObs (res->sVal1, Sum * sqrt (12.0 / (n - k)));
}
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,
(double *) NULL, res->sVal2, res->pVal2);
res->pVal1->NObs = N;
sres_GetNormalSumStat (res);
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,
"Normal statistic :");
swrite_NormalSumTest (N, res);
swrite_Final (gen, Timer);
}
util_Free (Pre);
if (localRes)
sres_DeleteBasic (res);
chrono_Delete (Timer);
}
void svaria_AppearanceSpacings (unif01_Gen * gen, sres_Basic * res,
long N, long Q, long K, int r, int s, int L)
{
double E[AS_DIM + 1]; /* Theoretical mean of the log (Base2) of
the most recent occurrence of a block */
double KV[AS_DIM + 1]; /* K times the theoretical variance of the
same */
long Seq;
long block;
long Nblocks; /* 2^L = total number of distinct blocks */
long K2;
long Q2;
long i;
long sBits; /* Numerical value of the s given bits */
long d; /* 2^s */
const int SdivL = s / L;
const int LdivS = L / s;
const int LmodS = L % s;
long sd; /* 2^LmodS */
long rang;
double n; /* Total number of bits in a sequence */
double sigma; /* Standard deviation = sqrt (Variance) */
double somme;
double ARang; /* Most recent occurrence of block */
long *Count; /* Index of most recent occurrence of
block */
double FactMoy;
lebool localRes = FALSE;
chrono_Chrono *Timer;
Timer = chrono_Create ();
n = ((double) K + (double) Q) * L;
if (swrite_Basic)
WriteDataAppear (gen, N, r, s, L, Q, K, n);
util_Assert (s < 32, "svaria_AppearanceSpacings: s >= 32");
InitAppear (r, s, L, Q, E, KV);
sigma = CalcSigma (L, K, KV);
d = num_TwoExp[s];
Nblocks = num_TwoExp[L];
FactMoy = 1.0 / (num_Ln2 * K);
if (res == NULL) {
localRes = TRUE;
res = sres_CreateBasic ();
}
sres_InitBasic (res, N, "svaria_AppearanceSpacings");
Count = util_Calloc ((size_t) Nblocks + 2, sizeof (long));
statcoll_SetDesc (res->sVal1,
"AppearanceSpacings sVal1: standard normal");
if (LdivS > 0) {
sd = num_TwoExp[LmodS];
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i < Nblocks; i++)
Count[i] = 0;
/* Initialization with Q blocks */
for (rang = 0; rang < Q; rang++) {
block = 0;
for (i = 1; i <= LdivS; i++) {
sBits = unif01_StripB (gen, r, s);
block = block * d + sBits;
}
if (LmodS > 0) {
sBits = unif01_StripB (gen, r, LmodS);
block = block * sd + sBits;
}
Count[block] = rang;
}
/* Test proper with K blocks */
somme = 0.0;
for (rang = Q; rang < Q + K; rang++) {
block = 0;
for (i = 1; i <= LdivS; i++) {
sBits = unif01_StripB (gen, r, s);
block = block * d + sBits;
}
if (LmodS > 0) {
sBits = unif01_StripB (gen, r, LmodS);
block = block * sd + sBits;
}
ARang = rang - Count[block];
somme += log (ARang);
Count[block] = rang;
}
statcoll_AddObs (res->sVal1, (somme * FactMoy - E[L]) / sigma);
}
} else { /* s > L */
Q2 = Q / SdivL;
K2 = K / SdivL;
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i < Nblocks; i++)
Count[i] = 0;
/* Initialization: Q blocks */
for (rang = 0; rang < Q2; rang++) {
sBits = unif01_StripB (gen, r, s);
for (i = 0; i < SdivL; i++) {
block = sBits % Nblocks;
Count[block] = SdivL * rang + i;
sBits /= Nblocks;
}
}
/* Test proper with K blocks */
somme = 0.0;
for (rang = Q2; rang < Q2 + K2; rang++) {
sBits = unif01_StripB (gen, r, s);
for (i = 0; i < SdivL; i++) {
block = sBits % Nblocks;
ARang = SdivL * rang + i - Count[block];
somme += log (ARang);
Count[block] = SdivL * rang + i;
sBits /= Nblocks;
}
}
statcoll_AddObs (res->sVal1, (somme * FactMoy - E[L]) / sigma);
}
}
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,
(double *) NULL, res->sVal2, res->pVal2);
res->pVal1->NObs = N;
sres_GetNormalSumStat (res);
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 12, 4, 3);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,
"Normal statistic :");
swrite_NormalSumTest (N, res);
swrite_Final (gen, Timer);
}
util_Free (Count);
if (localRes)
sres_DeleteBasic (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_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);
}
void sentrop_EntropyDMCirc (unif01_Gen * gen, sres_Basic * res,
long N, long n, int r, long m)
{
long i; /* Index */
double I0, x;
long Seq; /* Replication number */
double Entropy; /* Value of the statistic H(m, n) */
double LnEntropy;
double SumR; /* 1 + 1/2 + ... + 1/(2m-1) */
double nLR = n;
double Twom; /* 2m */
double *AU;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sentrop_EntropyDMCirc test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataDM (gen, TestName, N, n, r, m);
Twom = 2 * m;
I0 = Twom - 1.0;
SumR = 0.0;
for (i = 2 * m - 1; i >= 1; i--) {
SumR += 1.0 / I0;
I0 -= 1.0;
}
if (res == NULL) {
localRes = TRUE;
res = sres_CreateBasic ();
}
sres_InitBasic (res, N, "sentrop_EntropyDMCirc");
AU = util_Calloc ((size_t) (n + 1), sizeof (double));
statcoll_SetDesc (res->sVal1,
"The N statistic values (a standard normal)");
for (Seq = 1; Seq <= N; Seq++) {
/* Generate the sample and sort */
for (i = 1; i <= n; i++)
AU[i] = unif01_StripD (gen, r);
tables_QuickSortD (AU, 1, n);
/* Compute empirical entropy */
Entropy = 1.0;
LnEntropy = 0.0;
for (i = 1; i <= n; i++) {
if (i - m < 1) {
Entropy *= (AU[i + m] - AU[n + i - m] + 1.0);
} else if (i + m > n) {
Entropy *= (AU[i + m - n] - AU[i - m] + 1.0);
} else
Entropy *= (AU[i + m] - AU[i - m]);
if (Entropy < Epsilon) {
LnEntropy += log (Entropy);
Entropy = 1.0;
}
}
Entropy = (LnEntropy + log (Entropy)) / nLR + log (nLR / Twom);
/* Compute standardized statistic */
x = sqrt (3.0 * Twom * nLR) * ((Entropy + log (Twom) + Euler) - SumR);
statcoll_AddObs (res->sVal1, x);
}
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,
(double *) NULL, res->sVal2, res->pVal2);
res->pVal1->NObs = N;
sres_GetNormalSumStat (res);
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,
"Normal statistic :");
swrite_NormalSumTest (N, res);
swrite_Final (gen, Timer);
}
util_Free (AU);
if (localRes)
sres_DeleteBasic (res);
chrono_Delete (Timer);
}
