static void PrintLog2 (double d)
/*
* Prints the logarithm (rounded) of d in base 2, when d is outside the
* interval [SuspectLog2pval, 1 - SuspectLog2pval]; otherwise prints
* nothing.
*/
{
int s;
if (d <= gofw_Epsilonp) {
printf (" inf ");
} else if (d <= SuspectLog2pval) {
s = 0.5 - num_Log2 (d);
printf (" %2d ", s);
} else if (d >= 1.0 - gofw_Epsilonp1) {
printf (" -inf ");
} else if (d >= 1.0 - SuspectLog2pval) {
s = 0.5 - num_Log2 (1.0 - d);
if (s > 9)
printf (" ");
else
printf (" ");
printf ("-%1d ", s);
} else
printf (" ");
}
static double FoncMNEntropie (double junk, double n, long j)
/*
* One term of entropy when there are j balls in an urn
*/
{
double x;
if (j == 0)
return 0.0;
x = j / n;
return -x * num_Log2 (x);
}
static double CalcSigma (int L, long K, double KV[])
/*
* Compute the standard deviation for the svaria_AppearanceSpacings test.
*/
{
double dCor[AS_DIM + 1]; /* Coron-Naccache factor d */
double eCor[AS_DIM + 1]; /* Coron-Naccache factor e */
double temp;
/* double c; */
#if 0 /* No correction */
return sqrt (KV[L] / K);
#elif 0 /* Maurer's correction c(L, K) */
temp = 3.0 / L * num_Log2 ((double) K);
if (temp >= DBL_MAX_EXP - 1)
temp = 0.0;
else
temp = pow (2.0, -temp);
c = 0.7 - 0.8/L + (4.0 + 32.0/L) * temp / 15.0;
if (L < 3 || L > 16)
c = 1.0;
return c * sqrt (KV[L] / K);
#else /* based on Coron and Naccache exact calculation */
dCor [3] = 0.2732725; eCor [3] = 0.4890883;
dCor [4] = 0.3045101; eCor [4] = 0.4435381;
dCor [5] = 0.3296587; eCor [5] = 0.4137196;
dCor [6] = 0.3489769; eCor [6] = 0.3941338;
dCor [7] = 0.3631815; eCor [7] = 0.3813210;
dCor [8] = 0.3732189; eCor [8] = 0.3730195;
dCor [9] = 0.3800637; eCor [9] = 0.3677118;
dCor [10] = 0.3845867; eCor [10] = 0.3643695;
dCor [11] = 0.3874942; eCor [11] = 0.3622979;
dCor [12] = 0.3893189; eCor [12] = 0.3610336;
dCor [13] = 0.3904405; eCor [13] = 0.3602731;
dCor [14] = 0.3911178; eCor [14] = 0.3598216;
dCor [15] = 0.3915202; eCor [15] = 0.3595571;
dCor [16] = 0.3917561; eCor [16] = 0.3594040;
/* L = infinite */
dCor [0] = 0.3920729; eCor [0] = 0.3592016;
if (L < 3)
return sqrt (KV[L] / K);
if (L > 16)
temp = dCor[0] + eCor [0] * num_TwoExp[L] / K;
else
temp = dCor[L] + eCor [L] * num_TwoExp[L] / K;
return sqrt (temp * KV[L] / K);
#endif
}
static void PrintLog2Tex (double d)
/*
* Similar to PrintLog2, but prints in Latex style.
*/
{
int s;
if (d <= gofw_Epsilonp) {
printf (" & $\\infty$ ");
} else if (d <= SuspectLog2pval) {
s = 0.5 - num_Log2 (d);
printf (" & %3d ", s);
} else if (d >= 1.0 - gofw_Epsilonp1) {
printf (" & $-\\infty$ ");
} else if (d >= 1.0 - SuspectLog2pval) {
s = 0.5 - num_Log2 (1.0 - d);
if (s > 9)
printf (" & $-");
else
printf (" & $-");
printf ("%1d $ ", s);
} else
printf (" & ");
}
static void CalcLgx (double xLgx[], long n)
{
long i, nLim;
double nLR = n;
double temp;
if (n < NLIM)
nLim = n;
else
nLim = NLIM;
for (i = 1; i <= nLim; i++) {
temp = i / nLR;
xLgx[i] = -temp * num_Log2 (temp);
}
xLgx[0] = 0.0;
}
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);
}
