void svaria_SampleProd (unif01_Gen * gen, sres_Basic * res,
long N, long n, int r, int t)
{
long i;
int j;
long Seq;
double *P;
double temp;
double Par[1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_SampleProd test";
Timer = chrono_Create ();
if (swrite_Basic) {
swrite_Head (gen, TestName, N, n, r);
printf (", t = %d\n\n", t);
}
if (res == NULL) {
localRes = TRUE;
res = sres_CreateBasic ();
}
sres_InitBasic (res, N, "svaria_SampleProd");
P = util_Calloc ((size_t) n + 1, sizeof (double));
statcoll_SetDesc (res->sVal1, "SampleProd sVal1: Uniform [0, 1]");
Par[0] = t;
for (Seq = 1; Seq <= N; Seq++) {
for (i = 1; i <= n; i++) {
temp = unif01_StripD (gen, r);
for (j = 2; j <= t; j++)
temp *= unif01_StripD (gen, r);
P[i] = temp;
}
gofw_ActiveTests1 (P, n, FDistProd, Par, res->sVal2, res->pVal2);
statcoll_AddObs (res->sVal1, res->pVal2[gofw_AD]);
}
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Unif,
(double *) NULL, res->sVal2, res->pVal2);
res->pVal1->NObs = N;
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,
"Anderson-Darling statistic :");
swrite_Final (gen, Timer);
}
util_Free (P);
if (localRes)
sres_DeleteBasic (res);
chrono_Delete (Timer);
}
void svaria_SumCollector (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r, double g)
{
const double gmax = 10.0; /* Maximal value of g */
const int jmax = 50; /* Maximal number of classes */
int j; /* Class index */
long Seq;
long i;
double X;
double Y;
double Sum;
long NbClasses;
long *Loc;
double V[1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_SumCollector test";
char chaine[LEN1 + 1] = "";
char str[LEN2 + 1];
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataSumColl (gen, TestName, N, n, r, g);
if (g < 1.0 || g > gmax) {
util_Error ("svaria_SumCollector: g < 1.0 or g > 10.0");
}
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, jmax, "svaria_SumCollector");
Loc = res->Loc;
res->jmin = g;
res->jmax = jmax;
Sum = 0.0;
for (j = res->jmin; j < jmax; j++) {
res->NbExp[j] = n * ProbabiliteG (res->jmin, j, g);
Sum += res->NbExp[j];
}
res->NbExp[jmax] = util_Max (0.0, n - Sum);
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);
gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);
strncpy (chaine, "SumCollector sVal1: chi2 with ", (size_t) LEN1);
sprintf (str, "%ld", NbClasses - 1);
strncat (chaine, str, (size_t) LEN2);
strncat (chaine, " degrees of freedom", (size_t) LEN1);
statcoll_SetDesc (res->sVal1, chaine);
res->degFree = NbClasses - 1;
if (res->degFree < 1) {
if (localRes)
sres_DeleteChi2 (res);
return;
}
for (Seq = 1; Seq <= N; Seq++) {
for (j = 1; j <= jmax; j++)
res->Count[j] = 0;
for (i = 1; i <= n; i++) {
X = 0.0;
j = 0;
do {
X += unif01_StripD (gen, r);
++j;
}
while (X <= g);
if (j > res->jmax)
++res->Count[res->jmax];
else
++res->Count[Loc[j - 1]];
}
if (swrite_Counters)
tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,
"Observed numbers:");
Y = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);
statcoll_AddObs (res->sVal1, Y);
}
V[0] = NbClasses - 1;
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, LEN2, 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);
}
static int svaria_CollisionArgMax_00 (unif01_Gen *gen, sres_Chi2 *res,
long N, long n, int r, long k, long m)
/*
* Return 0 if no error, otherwise return != 0.
*/
{
double X;
double U;
double Max;
long NbColl;
long Indice = -1;
long j;
long i;
long Rep;
long Seq;
long NbClasses;
long *Loc;
int *Urne;
double V[1];
fmass_INFO Q;
lebool localRes = FALSE;
chrono_Chrono *chro, *Timer;
char *TestName = "svaria_CollisionArgMax test";
char chaine[LEN1 + 1] = "";
char str[LEN2 + 1];
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataArgMax (gen, TestName, N, n, r, k, m);
util_Assert (n <= 4 * k, "svaria_CollisionArgMax: n > 4k");
/* util_Assert (m > 2.0 * gofs_MinExpected,
"svaria_CollisionArgMax: m <= 2*gofs_MinExpected"); */
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, n, "svaria_CollisionArgMax");
Loc = res->Loc;
Urne = util_Calloc ((size_t) k + 1, sizeof (int));
if (svaria_Timer) {
printf ("-----------------------------------------------");
printf ("\nCPU time to initialize the collision distribution: ");
chro = chrono_Create ();
}
Q = smultin_CreateCollisions (n, (smultin_CellType) k);
if (svaria_Timer) {
chrono_Write (chro, chrono_hms);
printf ("\n\n");
}
/* Compute the expected numbers of collisions: m*P(j) */
for (j = 0; j <= n; j++)
res->NbExp[j] = m * smultin_CollisionsTerm (Q, j);
smultin_DeleteCollisions (Q);
res->jmin = 0;
res->jmax = n;
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);
gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);
strncpy (chaine, "CollisionArgMax sVal1: chi2 with ", (size_t) LEN1);
sprintf (str, "%ld", NbClasses - 1);
strncat (chaine, str, (size_t) LEN2);
strncat (chaine, " degrees of freedom", (size_t) LEN1);
statcoll_SetDesc (res->sVal1, chaine);
res->degFree = NbClasses - 1;
if (res->degFree < 1) {
if (localRes)
sres_DeleteChi2 (res);
return 1;
}
if (svaria_Timer)
chrono_Init (chro);
for (Seq = 1; Seq <= N; Seq++) {
for (j = 0; j <= n; j++)
res->Count[j] = 0;
for (Rep = 1; Rep <= m; Rep++) {
for (j = 0; j <= k; j++)
Urne[j] = -1;
NbColl = 0;
for (j = 1; j <= n; j++) {
Max = -1.0;
for (i = 1; i <= k; i++) {
U = unif01_StripD (gen, r);
if (U > Max) {
Max = U;
Indice = i;
}
}
if (Urne[Indice] < 0)
Urne[Indice] = 1;
else
++NbColl;
}
if (NbColl > res->jmax)
++res->Count[res->jmax];
else
++res->Count[Loc[NbColl]];
}
if (swrite_Counters)
tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,
"Observed numbers:");
X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);
statcoll_AddObs (res->sVal1, X);
}
if (svaria_Timer) {
printf ("\n----------------------------------------------\n"
"CPU time for the test : ");
chrono_Write (chro, chrono_hms);
printf ("\n\n");
chrono_Delete (chro);
}
V[0] = NbClasses - 1;
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, LEN2, res->degFree);
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);
swrite_Chi2SumTest (N, res);
swrite_Final (gen, Timer);
}
util_Free (Urne);
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
return 0;
}
void svaria_WeightDistrib (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r, long k, double Alpha, double Beta)
{
long W;
long j;
long i;
long Seq;
double X;
double U;
double p;
double nLR = n;
double V[1];
long NbClasses;
long *Loc;
fmass_INFO Q;
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_WeightDistrib test";
char chaine[LEN1 + 1] = "";
char str[LEN2 + 1];
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataWeight (gen, TestName, N, n, r, k, Alpha, Beta);
/* util_Assert (n >= 3.0 * gofs_MinExpected,
"svaria_WeightDistrib: n is too small"); */
util_Assert (Alpha <= 1.0 && Alpha >= 0.0,
"svaria_WeightDistrib: Alpha must be in [0, 1]");
util_Assert (Beta <= 1.0 && Beta >= 0.0,
"svaria_WeightDistrib: Beta must be in [0, 1]");
p = Beta - Alpha;
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, k, "svaria_WeightDistrib");
Loc = res->Loc;
/* Compute binomial probabilities and multiply by n */
Q = fmass_CreateBinomial (k, p, 1.0 - p);
for (i = 0; i <= k; i++)
res->NbExp[i] = nLR * fmass_BinomialTerm2 (Q, i);
fmass_DeleteBinomial (Q);
res->jmin = 0;
res->jmax = k;
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);
/* Merge classes for the chi-square */
gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);
strncpy (chaine, "WeightDistrib sVal1: chi2 with ", (size_t) LEN1);
sprintf (str, "%ld", NbClasses - 1);
strncat (chaine, str, (size_t) LEN2);
strncat (chaine, " degrees of freedom", (size_t) LEN1);
statcoll_SetDesc (res->sVal1, chaine);
res->degFree = NbClasses - 1;
if (res->degFree < 1) {
if (localRes)
sres_DeleteChi2 (res);
return;
}
for (Seq = 1; Seq <= N; Seq++) {
for (i = 0; i <= k; i++)
res->Count[i] = 0;
for (i = 1; i <= n; i++) {
W = 0;
for (j = 1; j <= k; j++) {
U = unif01_StripD (gen, r);
if (U >= Alpha && U < Beta)
++W;
}
if (W > res->jmax)
++res->Count[res->jmax];
else
++res->Count[Loc[W]];
}
if (swrite_Counters)
tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,
"Observed numbers:");
X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);
statcoll_AddObs (res->sVal1, X);
}
V[0] = NbClasses - 1;
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, LEN2, 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 svaria_SumLogs (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r)
{
const double Eps = DBL_EPSILON / 2.0; /* To avoid log(0) */
const double Epsilon = 1.E-100; /* To avoid underflow */
long i;
long Seq;
double u;
double Prod;
double Sum;
double V[1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_SumLogs test";
char chaine[LEN1 + 1] = "";
char str[LEN2 + 1];
Timer = chrono_Create ();
if (swrite_Basic) {
swrite_Head (gen, TestName, N, n, r);
printf ("\n\n");
}
util_Assert (n < LONG_MAX/2, "2n > LONG_MAX");
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, -1, "svaria_SumLogs");
strncpy (chaine, "SumLogs sVal1: chi2 with ", (size_t) LEN1);
sprintf (str, "%ld", 2 * n);
strncat (chaine, str, (size_t) LEN2);
strncat (chaine, " degrees of freedom", (size_t) LEN1);
statcoll_SetDesc (res->sVal1, chaine);
res->degFree = 2 * n;
if (res->degFree < 1) {
util_Warning (TRUE, "Chi-square with 0 degree of freedom.");
if (localRes)
sres_DeleteChi2 (res);
return;
}
for (Seq = 1; Seq <= N; Seq++) {
Prod = 1.0;
Sum = 0.0;
for (i = 1; i <= n; i++) {
u = unif01_StripD (gen, r);
if (u < Eps)
u = Eps;
Prod *= u;
if (Prod < Epsilon) {
Sum += log (Prod);
Prod = 1.0;
}
}
statcoll_AddObs (res->sVal1, -2.0 * (Sum + log (Prod)));
}
V[0] = 2 * n;
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, LEN2, 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 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 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_CouponCollector (unif01_Gen * gen, sres_Chi2 * res,
long N, long n, int r, int d)
{
long Seq; /* Replication number */
long Segm;
const int t = MAXT;
long tt = t;
int dInt = d;
long dd = d;
int s, k;
long NbGroups;
double Moydes;
double Mult;
double dReal = d;
double **M;
double *NbExp;
long *Loca;
long *Nb;
lebool Occurs[1 + MAXT];
double X2;
double V[1]; /* Number degrees of freedom for Chi2 */
char str[LENGTH + 1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_CouponCollector test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataCoupCol (gen, TestName, N, n, r, d);
util_Assert (d < MAXT, "sknuth_CouponCollector: d >= 62");
util_Assert (d > 1, "sknuth_CouponCollector: d < 2");
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, MAXT, "sknuth_CouponCollector");
NbExp = res->NbExp;
Nb = res->Count;
Loca = res->Loc;
/* Compute the expected number of segments of each length */
/* NbExp [s] = n * d! * Stirling (d-1, s-1) / d^s for d <= s <= t - 1 */
/* NbExp [t] = n * (1 - d! * Stirling (d, t-1) / d^{t-1}) */
dInt = d;
num2_CalcMatStirling (&M, d, t - 1);
Mult = n;
for (s = 1; s <= d; s++) {
Mult *= s / dReal;
}
NbExp[d] = Mult;
Moydes = d * Mult;
for (s = d + 1; s < t; s++) {
Mult /= dReal;
NbExp[s] = Mult * M[d - 1][s - 1];
Moydes += s * NbExp[s];
}
NbExp[t] = n - Mult * M[d][t - 1];
Moydes += t * NbExp[t];
Moydes /= n;
/*
if (swrite_Basic) {
printf (" Expected value of s = ");
num_WriteD (Moydes, 10, 2, 2);
printf ("\n\n");
}
*/
if (swrite_Classes)
gofs_WriteClasses (NbExp, Loca, d, t, 0);
gofs_MergeClasses (NbExp, Loca, &dd, &tt, &NbGroups);
if (swrite_Classes)
gofs_WriteClasses (NbExp, Loca, dd, tt, NbGroups);
res->jmin = dd;
res->jmax = tt;
res->degFree = NbGroups - 1;
if (res->degFree < 1) {
if (localRes)
sres_DeleteChi2 (res);
return;
}
sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"
" of freedom):", NbGroups - 1);
statcoll_SetDesc (res->sVal1, str);
/* Beginning of test */
for (Seq = 1; Seq <= N; Seq++) {
for (s = dInt; s <= MAXT; s++)
Nb[s] = 0;
for (Segm = 1; Segm <= n; Segm++) {
/* One collection of values. */
for (k = 0; k < dInt; k++)
Occurs[k] = FALSE;
++Nb[Loca[NRepet (gen, dInt, r, Occurs)]];
}
if (swrite_Counters)
tables_WriteTabL (Nb, dd, tt, 5, 10, "Observed numbers:");
X2 = gofs_Chi2 (NbExp, Nb, dd, tt);
statcoll_AddObs (res->sVal1, X2);
}
V[0] = NbGroups - 1;
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);
}
num2_FreeMatStirling (&M, d);
if (localRes)
sres_DeleteChi2 (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_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);
}
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);
}
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 sknuth_Gap (unif01_Gen *gen, sres_Chi2 *res,
long N, long n, int r, double Alpha, double Beta)
{
int len;
int t;
long m; /* Number of observed Gaps */
long Seq; /* Current replication number */
double p; /* Probability of U01 in (Alpha, Beta) */
double X2;
double U;
double Mult;
double V[1]; /* Number of degrees of freedom for Chi2 */
char str[LENGTH + 1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_Gap test";
Timer = chrono_Create ();
p = Beta - Alpha;
t = (int)(log (gofs_MinExpected / n) / num2_log1p (-p));
len = (int)(1 + log (gofs_MinExpected / (n*p)) / num2_log1p (-p));
t = util_Min(t, len);
t = util_Max(t, 0);
Mult = p * n;
if (swrite_Basic)
WriteDataGap (gen, TestName, N, n, r, Alpha, Beta);
util_Assert (Alpha >= 0.0 && Alpha <= 1.0,
"sknuth_Gap: Alpha outside interval [0..1]");
util_Assert (Beta <= 1.0 && Beta > Alpha,
"sknuth_Gap: Beta outside interval (Alpha..1]");
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, t, "sknuth_Gap");
sprintf (str, "The N statistic values (a ChiSquare with %1d degrees"
" of freedom):", t);
statcoll_SetDesc (res->sVal1, str);
res->degFree = t;
if (res->degFree < 1) {
util_Warning (TRUE, "Chi-square with 0 degree of freedom.");
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
return;
}
/* Compute the probabilities for each gap length */
res->NbExp[0] = Mult;
res->Loc[0] = 0;
for (len = 1; len < t; len++) {
Mult *= 1.0 - p;
res->NbExp[len] = Mult;
res->Loc[len] = len;
}
res->NbExp[t] = Mult * (1.0 - p) / p;
res->Loc[t] = t;
if (swrite_Classes)
gofs_WriteClasses (res->NbExp, res->Count, 0, t, 0);
/* Beginning of test */
for (Seq = 1; Seq <= N; Seq++) {
for (len = 0; len <= t; len++)
res->Count[len] = 0;
for (m = 1; m <= n; m++) {
/* Process one gap */
len = 0;
U = unif01_StripD (gen, r);
while ((U < Alpha || U >= Beta) && len < n) {
++len;
U = unif01_StripD (gen, r);
}
if (len >= n) {
util_Warning (TRUE,
"sknuth_Gap: one gap of length > n\n********* Interrupting the test\n");
printf ("\n\n");
res->pVal2[gofw_Mean] = res->pVal2[gofw_AD]
= res->pVal2[gofw_KSM] = res->pVal2[gofw_KSP] = 0.0;
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
return;
}
if (len >= t)
++res->Count[t];
else
++res->Count[len];
}
if (swrite_Counters)
tables_WriteTabL (res->Count, 0, t, 5, 10, "Observed numbers:");
X2 = gofs_Chi2 (res->NbExp, res->Count, 0, t);
statcoll_AddObs (res->sVal1, X2);
}
V[0] = t;
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,
res->sVal2, res->pVal2);
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_SimpPoker (unif01_Gen *gen, sres_Chi2 *res,
long N, long n, int r, int d, int k)
{
long Seq; /* Replication number */
long NbGroups; /* Number of classes */
long jhigh;
long jlow;
long Groupe;
long L;
int Minkd;
int s, j;
double X2;
double Mult;
double *NbExp;
long *Loca;
long *Nb;
lebool Occurs[1 + Maxkd];
double **M;
double V[1]; /* Number degrees of freedom for Chi2 */
char str[LENGTH + 1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_SimpPoker test";
Timer = chrono_Create ();
if (swrite_Basic)
WriteDataPoker (gen, TestName, N, n, r, d, k);
util_Assert (d <= Maxkd, "sknuth_SimpPoker: d > 127");
util_Assert (k <= Maxkd, "sknuth_SimpPoker: k > 127");
util_Assert (d > 1, "sknuth_SimpPoker: d < 2");
util_Assert (k > 1, "sknuth_SimpPoker: k < 2");
if (k < d)
Minkd = k;
else
Minkd = d;
num2_CalcMatStirling (&M, Minkd, k);
if (res == NULL) {
localRes = TRUE;
res = sres_CreateChi2 ();
}
sres_InitChi2 (res, N, Minkd, "sknuth_SimpPoker");
NbExp = res->NbExp;
Nb = res->Count;
Loca = res->Loc;
/* NbExp[s] = n * d * (d-1) * ... * (d-s+1) * M [s,k] / d^k. */
Mult = n * pow ((double) d, -(double) k);
for (s = 1; s <= Minkd; s++) {
Mult *= d - s + 1;
NbExp[s] = Mult * M[s][k];
}
jlow = 1;
jhigh = Minkd;
if (swrite_Classes)
gofs_WriteClasses (NbExp, Loca, jlow, jhigh, 0);
gofs_MergeClasses (NbExp, Loca, &jlow, &jhigh, &NbGroups);
if (swrite_Classes)
gofs_WriteClasses (NbExp, Loca, jlow, jhigh, NbGroups);
res->jmin = jlow;
res->jmax = jhigh;
res->degFree = NbGroups - 1;
if (res->degFree < 1) {
if (localRes)
sres_DeleteChi2 (res);
return;
}
sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"
" of freedom):", NbGroups - 1);
statcoll_SetDesc (res->sVal1, str);
for (Seq = 1; Seq <= N; Seq++) {
for (s = 1; s <= Minkd; s++)
Nb[s] = 0;
for (Groupe = 1; Groupe <= n; Groupe++) {
/* Draw one poker hand */
for (j = 0; j < d; j++)
Occurs[j] = FALSE;
s = 0; /* s = number of different values */
for (j = 1; j <= k; j++) {
L = unif01_StripL (gen, r, d);
if (!Occurs[L]) {
Occurs[L] = TRUE;
++s;
}
}
++Nb[Loca[s]];
}
if (swrite_Counters)
tables_WriteTabL (Nb, jlow, jhigh, 5, 10, "Observed numbers:");
X2 = gofs_Chi2 (NbExp, Nb, jlow, jhigh);
statcoll_AddObs (res->sVal1, X2);
}
V[0] = NbGroups - 1;
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);
}
num2_FreeMatStirling (&M, Minkd);
if (localRes)
sres_DeleteChi2 (res);
chrono_Delete (Timer);
}
void svaria_SampleMean (unif01_Gen * gen, sres_Basic * res,
long N, long n, int r)
{
long i;
long Seq;
double Sum;
double Coef[SAM_LIM + 1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "svaria_SampleMean test";
Timer = chrono_Create ();
if (swrite_Basic) {
swrite_Head (gen, TestName, N, n, r);
printf ("\n\n");
}
util_Assert (n > 1, "svaria_SampleMean: n < 2");
if (res == NULL) {
localRes = TRUE;
res = sres_CreateBasic ();
}
sres_InitBasic (res, N, "svaria_SampleMean");
if (n < SAM_LIM)
InitFDistMeans (n, Coef);
if (n < SAM_LIM)
statcoll_SetDesc (res->sVal1, "SampleMean sVal1: n*<U>");
else
statcoll_SetDesc (res->sVal1, "SampleMean sVal1: standard normal");
for (Seq = 1; Seq <= N; Seq++) {
Sum = 0.0;
for (i = 1; i <= n; i++)
Sum += unif01_StripD (gen, r);
if (n < SAM_LIM)
statcoll_AddObs (res->sVal1, Sum);
else
statcoll_AddObs (res->sVal1, sqrt (12.0 / n) * (Sum - 0.5 * n));
}
if (n < SAM_LIM) {
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, FDistMeans, Coef,
res->sVal2, res->pVal2);
} else {
/* Normal approximation */
gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,
(double *) NULL, res->sVal2, res->pVal2);
}
res->pVal1->NObs = N;
if (swrite_Collectors)
statcoll_Write (res->sVal1, 5, 14, 4, 3);
if (swrite_Basic) {
gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,
"Statistic value :");
swrite_Final (gen, Timer);
}
if (localRes)
sres_DeleteBasic (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 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 sknuth_MaxOft (unif01_Gen * gen, sknuth_Res1 * res,
long N, long n, int r, int d, int t)
{
long Seq; /* Replication number */
double tReal = t;
double dReal = d;
double NbExp; /* Expected number in each class */
double MaxU;
double U;
long Groupe;
int j, Indice;
double *P;
double Par[1];
double X2;
double V[1]; /* Number degrees of freedom for Chi2 */
char str[LENGTH + 1];
lebool localRes = FALSE;
chrono_Chrono *Timer;
char *TestName = "sknuth_MaxOft test";
sres_Basic *Bas;
sres_Chi2 *Chi;
Timer = chrono_Create ();
Par[0] = t;
NbExp = n / dReal;
if (swrite_Basic)
WriteDataMaxOft (gen, TestName, N, n, r, d, t, NbExp);
util_Assert (NbExp >= gofs_MinExpected,
"MaxOft: NbExp < gofs_MinExpected");
if (res == NULL) {
localRes = TRUE;
res = sknuth_CreateRes1 ();
}
InitRes1 (res, N, d);
Bas = res->Bas;
Chi = res->Chi;
Chi->jmin = 0;
Chi->jmax = d - 1;
for (j = 0; j < d; j++) {
Chi->Loc[j] = j;
Chi->NbExp[j] = NbExp;
}
sprintf (str, "The N statistic values (a ChiSquare with %1d degrees"
" of freedom):", d - 1);
statcoll_SetDesc (Chi->sVal1, str);
Chi->degFree = d - 1;
statcoll_SetDesc (Bas->sVal1,
"The N statistic values (the Anderson-Darling p-values):");
P = util_Calloc ((size_t) n + 1, sizeof (double));
for (Seq = 1; Seq <= N; Seq++) {
for (Indice = 0; Indice < d; Indice++)
Chi->Count[Indice] = 0;
for (Groupe = 1; Groupe <= n; Groupe++) {
/* Generate a vector and find the max value */
MaxU = unif01_StripD (gen, r);
for (j = 1; j < t; j++) {
U = unif01_StripD (gen, r);
if (U > MaxU)
MaxU = U;
}
/* For the chi2 */
Indice = pow (MaxU, tReal) * dReal;
++Chi->Count[Indice];
/* For the Anderson-Darling */
P[Groupe] = MaxU;
}
if (swrite_Counters)
tables_WriteTabL (Chi->Count, 0, d - 1, 5, 10, "Observed numbers:");
/* Value of the chi2 statistic */
X2 = gofs_Chi2Equal (NbExp, Chi->Count, 0, d - 1);
statcoll_AddObs (Chi->sVal1, X2);
/* Value of the Anderson-Darling statistic */
gofw_ActiveTests1 (P, n, FDistMax, Par, Bas->sVal2, Bas->pVal2);
statcoll_AddObs (Bas->sVal1, Bas->pVal2[gofw_AD]);
}
util_Free (P);
V[0] = d - 1;
gofw_ActiveTests2 (Chi->sVal1->V, Chi->pVal1->V, N, wdist_ChiSquare, V,
Chi->sVal2, Chi->pVal2);
Chi->pVal1->NObs = N;
sres_GetChi2SumStat (Chi);
gofw_ActiveTests2 (Bas->sVal1->V, Bas->pVal1->V, N, wdist_Unif,
(double *) NULL, Bas->sVal2, Bas->pVal2);
Bas->pVal1->NObs = N;
if (swrite_Collectors) {
statcoll_Write (Chi->sVal1, 5, 14, 4, 3);
statcoll_Write (Bas->sVal1, 5, 14, 4, 3);
}
if (swrite_Basic) {
if (N == 1) {
swrite_AddStrChi (str, LENGTH, Chi->degFree);
gofw_WriteActiveTests2 (N, Chi->sVal2, Chi->pVal2, str);
} else {
printf ("\n-----------------------------------------------\n");
printf ("Test results for chi2 with %2ld degrees of freedom:\n",
Chi->degFree);
gofw_WriteActiveTests0 (N, Chi->sVal2, Chi->pVal2);
swrite_Chi2SumTest (N, Chi);
}
if (N == 1) {
gofw_WriteActiveTests2 (N, Bas->sVal2, Bas->pVal2,
"Anderson-Darling statistic :");
} else {
printf ("\n-----------------------------------------------\n");
printf ("Test results for Anderson-Darling:\n");
gofw_WriteActiveTests0 (N, Bas->sVal2, Bas->pVal2);
}
printf ("\n");
swrite_Final (gen, Timer);
}
if (localRes)
sknuth_DeleteRes1 (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);
}