bool MyCanvas::SetAsOutput(){
if (onVideo) glBindFramebufferEXT( GL_FRAMEBUFFER_EXT, 0);
else {
if (frameID[ currentRes ] == INVALID_ID ) {
if ( !InitRes() ) return false;
}
glBindFramebufferEXT( GL_FRAMEBUFFER_EXT, frameID[ currentRes ] );
}
return true;
}
void sentrop_EntropyDisc (unif01_Gen * gen, sentrop_Res * res,
long N, long n, int r, int s, int L)
/*
* Use smultin_Multinomial to replace sentrop_EntropyDisc
*/
{
int i;
int t;
long d;
double x;
smultin_Param *par;
double ValDelta[] = { 0.0 };
if (s > L) {
EntropyDisc00 (gen, res, N, n, r, s, L);
return; /* <--- Case "s > L" end up here. */
}
if (swrite_Basic)
WriteDataEnt (N, n, r, s, L);
util_Assert (L % s == 0, "sentrop_EntropyDisc: L % s != 0");
d = num_TwoExp[s];
t = L / s;
x = d;
for (i = 2; i <= t; i++)
x *= d;
par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 3);
if (NULL == res) {
if (n / x <= 8.0)
smultin_Multinomial (gen, par, NULL, N, n, r, d, t, TRUE);
else
smultin_Multinomial (gen, par, NULL, N, n, r, d, t, FALSE);
} else {
smultin_Res *resm;
resm = smultin_CreateRes (par);
if (n / x <= 8.0)
smultin_Multinomial (gen, par, resm, N, n, r, d, t, TRUE);
else
smultin_Multinomial (gen, par, resm, N, n, r, d, t, FALSE);
InitRes (res, N, 0, "sentrop_EntropyDisc");
statcoll_SetDesc (res->Bas->sVal1, "EntropyDisc sVal1");
res->Bas->sVal1->NObs = resm->Collector[0]->NObs;
tables_CopyTabD (resm->Collector[0]->V, res->Bas->sVal1->V, 1, N);
tables_CopyTabD (resm->sVal2[0], res->Bas->sVal2, 0, gofw_NTestTypes - 1);
tables_CopyTabD (resm->pVal2[0], res->Bas->pVal2, 0, gofw_NTestTypes - 1);
smultin_DeleteRes (resm);
}
smultin_DeleteParam (par);
}
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);
}
static void EntropyDisc00 (unif01_Gen * gen, sentrop_Res * res,
long N, long n, int r, int s, int L)
/*
* Test based on the discrete entropy, proposed by Compagner and L'Ecuyer
*/
{
long Seq;
long j;
long i;
double EntropyNorm; /* Normalized entropy */
double Entropy; /* Value of entropy S */
double EntropyPrev; /* Previous value of entropy */
double SumSq; /* To compute the covariance */
double Sigma, Mu; /* Parameters of the normal law */
double tem;
double nLR = n;
long d; /* 2^s */
long C; /* 2^L */
long LSurs; /* L / s */
long sSurL; /* s / L */
long nLSurs; /* nL / s */
double xLgx[NLIM + 1]; /* = -i/n * Lg (i/n) */
unsigned long Block;
unsigned long Number;
unsigned int LL = L;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sentrop_EntropyDisc test";
Timer = chrono_Create ();
if (s <= L && L % s) {
util_Error ("EntropyDisc00: s <= L and L % s != 0");
}
if (s > L && s % L) {
util_Error ("EntropyDisc00: s > L and s % L != 0");
}
d = num_TwoExp[s];
C = num_TwoExp[L];
if (s <= L)
LSurs = L / s;
else {
sSurL = s / L;
nLSurs = n / sSurL;
if (n % sSurL)
++nLSurs;
}
util_Assert (n / num_TwoExp[L] < NLIM,
"sentrop_EntropyDisc: n/2^L is too large");
smultin_MultinomMuSigma (n, num_TwoExp[L], 0.0, (double) n,
FoncMNEntropie, &Mu, &Sigma);
if (swrite_Basic)
WriteDataDisc (gen, TestName, N, n, r, s, L, Mu, Sigma);
if (res == NULL) {
localRes = TRUE;
res = sentrop_CreateRes ();
}
InitRes (res, N, C - 1, "sentrop_EntropyDisc");
CalcLgx (xLgx, n);
statcoll_SetDesc (res->Bas->sVal1, "EntropyDisc sVal1");
statcoll_SetDesc (res->Bas->pVal1, "EntropyDisc pVal1");
SumSq = EntropyPrev = 0.0;
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i < C; i++)
res->Count[i] = 0;
if (s <= L) {
for (i = 1; i <= n; i++) {
Block = unif01_StripB (gen, r, s);
for (j = 2; j <= LSurs; j++)
Block = Block * d + unif01_StripB (gen, r, s);
++res->Count[Block];
}
} else { /* s > L */
for (i = 1; i <= nLSurs; i++) {
Number = unif01_StripB (gen, r, s);
for (j = 1; j <= sSurL; j++) {
Block = Number % C;
++res->Count[Block];
Number >>= LL;
}
}
}
/* Compute entropy */
Entropy = 0.0;
for (i = 0; i < C; i++) {
if (res->Count[i] > NLIM) {
tem = res->Count[i] / nLR;
tem *= -num_Log2 (tem);
Entropy += tem;
} else if (res->Count[i] > 0) {
Entropy += xLgx[res->Count[i]];
}
}
EntropyNorm = (Entropy - Mu) / Sigma;
statcoll_AddObs (res->Bas->sVal1, EntropyNorm);
SumSq += EntropyNorm * EntropyPrev;
EntropyPrev = EntropyNorm;
if (swrite_Counters)
tables_WriteTabL (res->Count, 0, C - 1, 5, 10, "Counters:");
if (swrite_Collectors) {
printf ("Entropy = ");
num_WriteD (Entropy, 15, 6, 1);
printf ("\n");
}
}
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);
/* We now test the correlation between successive values of the entropy.
The next SumSq should have mean 0 and variance 1. */
if (N > 1) {
res->Bas->sVal2[gofw_Cor] = SumSq / sqrt ((double) N);
res->Bas->pVal2[gofw_Cor] = fbar_Normal1 (res->Bas->sVal2[gofw_Cor]);
}
if (swrite_Collectors) {
statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);
}
if (swrite_Basic) {
WriteResultsDisc (N, res->Bas->sVal2, res->Bas->pVal2, res->Bas);
swrite_Final (gen, Timer);
}
if (localRes)
sentrop_DeleteRes (res);
chrono_Delete (Timer);
}
void sentrop_EntropyDiscOver2 (unif01_Gen * gen, sentrop_Res * res,
long N, long n, int r, int s, int L)
{
long i, j; /* Indices */
unsigned long B2, B1, B0; /* Blocks of bits */
long Seq; /* Replication number */
double Entropy; /* Value of the entropy S */
double tempPrev; /* Previous value of the entropy */
double SumSq; /* To compute the covariance */
double Corr; /* Empirical correlation */
double Var; /* Empirical variance */
double Mean; /* Empirical mean */
double Sigma, Mu; /* Parameters of the normal law */
double Sum2, Sum; /* Temporary variables */
unsigned long d; /* 2^s */
long C; /* 2^L */
unsigned long CLC; /* 2^L */
long m0; /* m0 = ceil (L/s) */
long m; /* m = n/s */
double xLgx[NLIM + 1]; /* = -i/n * Lg (i/n) */
double NLR = N;
double temp, E1;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sentrop_EntropyDiscOver2 test";
Timer = chrono_Create ();
InitExactOver (n, L, &Mu, &Sigma);
if (swrite_Basic)
WriteDataDisc (gen, TestName, N, n, r, s, L, Mu, Sigma);
util_Assert (L <= n, "sentrop_EntropyDiscOver2: L > n");
util_Assert (L <= 15, "sentrop_EntropyDiscOver2: L > 15");
util_Assert (r <= 31, "sentrop_EntropyDiscOver2: r > 31");
util_Assert (s <= 31, "sentrop_EntropyDiscOver2: s > 31");
util_Assert (L + s <= 31, "sentrop_EntropyDiscOver2: L+s > 31");
util_Assert (n % s == 0, "sentrop_EntropyDiscOver2: n % s != 0");
d = num_TwoExp[s];
m = n / s;
m0 = L / s;
if (m0 * s < L)
++m0;
/* B0 must not be larger than LONG_MAX (31 bits) */
util_Assert (m0 * s <= 31, "sentrop_EntropyDiscOver2: m0 * s > 31");
C = num_TwoExp[L];
CLC = num_TwoExp[L];
if (res == NULL) {
localRes = TRUE;
res = sentrop_CreateRes ();
}
InitRes (res, N, C - 1, "sentrop_EntropyDiscOver2");
tempPrev = SumSq = Sum2 = Sum = 0.0;
CalcLgx (xLgx, n);
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i < C; i++)
res->Count[i] = 0;
B0 = unif01_StripB (gen, r, s);
for (j = 2; j <= m0; j++)
B0 = B0 * d + unif01_StripB (gen, r, s);
/* B0 now contains the bits 0,...,0,b_1,...,b_{m0*s} */
B2 = B0;
/* Count the blocks of L bits in b_1,...,b_{m0*s} */
for (i = 0; i <= m0 * s - L; i++) {
++res->Count[B2 % CLC];
B2 >>= 1;
}
B1 = B0 % CLC;
B0 = B2 % CLC;
/* B1 contains 0,...,0,b_{m0*s-L+1},...,b_{m0*s} */
/* B0 contains 0,...,0,b_1,...,b_{L-1} */
for (j = 1; j <= m - m0; j++) {
B1 = B1 * d + unif01_StripB (gen, r, s);
B2 = B1;
B1 %= CLC;
/* B1 and B2 contain L bits and L+s bits, resp. */
for (i = 1; i <= s; i++) {
++res->Count[B2 % CLC];
B2 >>= 1;
}
}
/* B1 contains 0,...,0,b_{m*s-L+1},...,b_{m*s}. */
/* Her we must have 2 * L <= 31. */
B2 = B0 + B1 * (CLC / 2);
/* B2 contains 0,..,0,b_{m*s-L+1},..,b_{m*s},b_1,...,b_{L-1}. */
/* Now count blocks with overlap. */
for (i = 1; i < L; i++) {
++res->Count[B2 % CLC];
B2 >>= 1;
}
/* Compute entropy */
Entropy = 0.0;
for (i = 0; i < C; i++) {
util_Assert (res->Count[i] <= NLIM,
"sentrop_EntropyDiscOver2: NLIM is too small");
Entropy += xLgx[res->Count[i]];
}
#ifdef STABLE
/* Ideally, we should use the moving average for numerical stability.
But we shall use the first observed value of instead; it should be
typical and will prevent loss of precision (unless it is 0). */
if (1 == Seq)
E1 = Entropy;
temp = Entropy - E1;
Sum += temp;
Sum2 += temp * temp;
SumSq += temp * tempPrev;
tempPrev = temp;
#else
/* The naive unstable method */
Sum += Entropy;
Sum2 += Entropy * Entropy;
SumSq += Entropy * tempPrev;
tempPrev = Entropy;
#endif
if (swrite_Counters)
tables_WriteTabL (res->Count, 0, C - 1, 5, 10, "Counters:");
if (swrite_Collectors) {
printf ("Entropy = ");
num_WriteD (Entropy, 15, 6, 1);
printf ("\n");
}
}
/* We now test the correlation between successive values of the */
/* entropy. Corr should have mean 0 and variance 1. */
#ifdef STABLE
Mean = Sum / NLR + E1;
Var = Sum2 / NLR - (E1 - Mean) * (E1 - Mean);
Var *= NLR / (NLR - 1.0);
temp = (Entropy + E1 * NLR - 2.0 * NLR * Mean) * E1 / (NLR - 1.0);
Corr = SumSq / (NLR - 1.0) - temp - Mean * Mean;
if (Var <= 0.0) {
Corr = 1.0e100;
util_Warning (TRUE,
"Empirical variance <= 0. Correlation set to 1e100.");
} else
Corr /= Var;
#else
/* Naive calculations. Here, there could be huge losses of precision
because Mean*Mean, Sum2/NLR, and SumSq/(NLR - 1.0) may be very close. */
Mean = Sum / NLR;
Var = (Sum2 / NLR - Mean * Mean) * NLR / (NLR - 1.0);
Corr = (SumSq / (NLR - 1.0) - Mean * Mean) / Var;
#endif
if (Sigma > 0.0) {
/* We know the true values of Mu and Sigma */
res->Bas->sVal2[gofw_Mean] = (Mean - Mu) * sqrt (NLR) / Sigma;
res->Bas->pVal2[gofw_Mean] = fbar_Normal1 (res->Bas->sVal2[gofw_Mean]);
} else
res->Bas->sVal2[gofw_Mean] = -1.0;
res->Bas->sVal2[gofw_Cor] = Corr * sqrt (NLR);
res->Bas->pVal2[gofw_Cor] = fbar_Normal1 (res->Bas->sVal2[gofw_Cor]);
if (swrite_Basic) {
WriteResultsDiscOver (res, NLR, Sum2, SumSq, Mu, Sigma, Mean, Var,
Corr);
swrite_Final (gen, Timer);
}
if (localRes)
sentrop_DeleteRes (res);
chrono_Delete (Timer);
}
void sentrop_EntropyDiscOver (unif01_Gen * gen, sentrop_Res * res,
long N, long n, int r, int s, int L)
{
long i; /* Index */
unsigned long Block1, Block0; /* Blocks of bits */
long Seq; /* Replication number */
double Entropy; /* Value of the entropy S */
double tempPrev; /* Previous value of entropy */
double SumSq; /* To compute the covariance */
double Corr; /* Empirical correlation */
double Var; /* Empirical variance */
double Mean; /* Empirical mean */
double Sigma, Mu; /* Parameters of the normal law */
double Sum2, Sum; /* Temporary variables */
long d; /* 2^s */
long C; /* 2^L */
long nSurs; /* n / s */
double xLgx[NLIM + 1]; /* = -i/n * Lg (i/n) */
double NLR = N;
double temp, E1;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sentrop_EntropyDiscOver test";
Timer = chrono_Create ();
InitExactOver (n, L, &Mu, &Sigma);
if (swrite_Basic)
WriteDataDisc (gen, TestName, N, n, r, s, L, Mu, Sigma);
util_Assert (L <= n - L, "sentrop_EntropyDiscOver: L > n-L");
util_Assert (n <= 31, "sentrop_EntropyDiscOver: n > 31");
util_Assert (r <= 31, "sentrop_EntropyDiscOver: r > 31");
util_Assert (s <= 31, "sentrop_EntropyDiscOver: s > 31");
util_Assert (n % s == 0, "sentrop_EntropyDiscOver: n % s != 0");
util_Assert (N > 1, "sentrop_EntropyDiscOver: N <= 1");
d = num_TwoExp[s];
C = num_TwoExp[L];
nSurs = n / s;
if (res == NULL) {
localRes = TRUE;
res = sentrop_CreateRes ();
}
InitRes (res, N, C - 1, "sentrop_EntropyDiscOver");
CalcLgx (xLgx, n);
tempPrev = SumSq = Sum2 = Sum = 0.0;
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i < C; i++)
res->Count[i] = 0;
Block0 = unif01_StripB (gen, r, s);
for (i = 2; i <= nSurs; i++)
Block0 = Block0 * d + unif01_StripB (gen, r, s);
/* Compute entropy of the block of n bits = Block0. */
/* This block has less than 31 bits. */
Block1 = Block0;
for (i = 0; i <= n - L - 1; i++) {
++res->Count[Block1 % C];
Block1 >>= 1;
}
Block1 = (Block1 % C) + C * (Block0 % C);
for (i = n - L; i < n; i++) {
++res->Count[Block1 % C];
Block1 >>= 1;
}
Entropy = 0.0;
for (i = 0; i < C; i++) {
util_Assert (res->Count[i] <= NLIM,
"sentrop_EntropyDiscOver: NLIM is too small");
Entropy += xLgx[res->Count[i]];
}
#ifdef STABLE
/* Ideally, we should use the moving average for numerical stability.
But we shall use the first observed value instead; it should be
typical and will prevent loss of precision (unless it is 0). */
if (1 == Seq)
E1 = Entropy;
temp = Entropy - E1;
Sum += temp;
Sum2 += temp * temp;
SumSq += temp * tempPrev;
tempPrev = temp;
#else
/* The naive method: it is simple but numerically unstable. It can be
used for debugging and testing the more stable calculation in the
case of small samples. */
Sum += Entropy;
Sum2 += Entropy * Entropy;
SumSq += Entropy * tempPrev;
tempPrev = Entropy;
#endif
if (swrite_Counters)
tables_WriteTabL (res->Count, 0, C - 1, 5, 10, "Counters:");
if (swrite_Collectors) {
printf ("Entropy = ");
num_WriteD (Entropy, 15, 6, 1);
printf ("\n");
}
}
/* We now test the correlation between successive values of the entropy.
Corr should have mean 0 and variance 1. We use a numerically stable
calculation. */
#ifdef STABLE
Mean = Sum / NLR + E1;
Var = Sum2 / NLR - (E1 - Mean) * (E1 - Mean);
Var *= NLR / (NLR - 1.0);
temp = (Entropy + E1 * NLR - 2.0 * NLR * Mean) * E1 / (NLR - 1.0);
Corr = SumSq / (NLR - 1.0) - temp - Mean * Mean;
if (Var <= 0.0) {
Corr = 1.0e100;
util_Warning (TRUE,
"Empirical variance <= 0. Correlation set to 1e100.");
} else
Corr /= Var;
#else
/* Naive calculations. Here, there could be huge losses of precision
because Mean*Mean, Sum2/NLR, and SumSq/(NLR - 1.0) may be very close. */
Mean = Sum / NLR;
Var = (Sum2 / NLR - Mean * Mean) * NLR / (NLR - 1.0);
Corr = (SumSq / (NLR - 1.0) - Mean * Mean) / Var;
#endif
if (Sigma > 0.0) {
/* We know the true values of Mu and Sigma */
res->Bas->sVal2[gofw_Mean] = (Mean - Mu) * sqrt (NLR) / Sigma;
res->Bas->pVal2[gofw_Mean] = fbar_Normal1 (res->Bas->sVal2[gofw_Mean]);
} else
res->Bas->pVal2[gofw_Mean] = -1.0;
res->Bas->sVal2[gofw_Cor] = Corr * sqrt (NLR);
res->Bas->pVal2[gofw_Cor] = fbar_Normal1 (res->Bas->sVal2[gofw_Cor]);
if (swrite_Basic) {
WriteResultsDiscOver (res, NLR, Sum2, SumSq, Mu, Sigma, Mean, Var,
Corr);
swrite_Final (gen, Timer);
}
if (localRes)
sentrop_DeleteRes (res);
chrono_Delete (Timer);
}
