jobject util_CreatePropertiesObject(JNIEnv *env, jobject initContextObj)
{
jobject result = nsnull;
#ifdef BAL_INTERFACE
if (nsnull != externalCreatePropertiesObject) {
result = externalCreatePropertiesObject(env, initContextObj);
}
#else
util_Assert(initContextObj);
ShareInitContext *initContext = (ShareInitContext *) initContextObj;
jclass propertiesClass = nsnull;
if (nsnull == (propertiesClass =
::util_FindClass(env, "java/util/Properties"))) {
return result;
}
if (nsnull == gPropertiesInitMethodID) {
util_Assert(propertiesClass);
if (nsnull == (gPropertiesInitMethodID =
env->GetMethodID(propertiesClass,
"<init>", "()V"))) {
return result;
}
}
util_Assert(gPropertiesInitMethodID);
result = ::util_NewGlobalRef(env,
env->NewObject(propertiesClass,
gPropertiesInitMethodID));
#endif
return result;
}
void util_ClearPropertiesObject(JNIEnv *env, jobject propertiesObject,
jobject initContextObj)
{
#ifdef BAL_INTERFACE
if (nsnull != externalClearPropertiesObject) {
externalClearPropertiesObject(env, propertiesObject, initContextObj);
}
#else
util_Assert(initContextObj);
ShareInitContext *initContext = (ShareInitContext *) initContextObj;
jclass propertiesClass = nsnull;
if (nsnull == (propertiesClass =
::util_FindClass(env, "java/util/Properties"))) {
return;
}
if (nsnull == gPropertiesClearMethodID) {
if (nsnull == (gPropertiesClearMethodID =
env->GetMethodID(propertiesClass, "clear", "()V"))) {
return;
}
}
util_Assert(gPropertiesClearMethodID);
env->CallVoidMethod(propertiesObject, gPropertiesClearMethodID);
return;
#endif
}
unif01_Gen *uweyl_CreateSNWeyl (long M, double Alpha, long n0)
{
unif01_Gen *gen;
SNWeyl_param *param;
Weyl_state *state;
size_t leng;
char name[LEN + 1];
util_Assert ((Alpha > 0.0), "uweyl_CreateSNWeyl: Alpha <= 0");
util_Assert ((Alpha < 1.0), "uweyl_CreateSNWeyl: Alpha >= 1");
gen = util_Malloc (sizeof (unif01_Gen));
param = util_Malloc (sizeof (SNWeyl_param));
state = util_Malloc (sizeof (Weyl_state));
param->Alpha = Alpha;
param->M = M;
if (n0 < 0)
n0 = -n0;
state->n = n0;
strncpy (name, "uweyl_CreateSNWeyl (shuffled nested):", (size_t) LEN);
addstr_Long (name, " M = ", M);
addstr_Double (name, ", Alpha = ", Alpha);
addstr_Long (name, ", n0 = ", n0);
leng = strlen (name);
gen->name = util_Calloc (leng + 1, sizeof (char));
strncpy (gen->name, name, leng);
gen->GetBits = &SNWeyl_Bits;
gen->GetU01 = &SNWeyl_U01;
gen->Write = &WrWeyl;
gen->param = param;
gen->state = state;
return gen;
}
jobject util_GetFromPropertiesObject(JNIEnv *env, jobject propertiesObject,
jobject name, jobject initContextObj)
{
jobject result = nsnull;
#ifdef BAL_INTERFACE
if (nsnull != externalGetFromPropertiesObject) {
result = externalGetFromPropertiesObject(env, propertiesObject, name,
initContextObj);
}
#else
util_Assert(initContextObj);
ShareInitContext *initContext = (ShareInitContext *) initContextObj;
jclass propertiesClass = nsnull;
if (nsnull == (propertiesClass =
::util_FindClass(env, "java/util/Properties"))) {
return result;
}
if (nsnull == gPropertiesGetPropertyMethodID) {
if (nsnull == (gPropertiesGetPropertyMethodID =
env->GetMethodID(propertiesClass,
"getProperty",
"(Ljava/lang/String;)Ljava/lang/String;"))) {
return result;
}
}
util_Assert(gPropertiesGetPropertyMethodID);
result = env->CallObjectMethod(propertiesObject,
gPropertiesGetPropertyMethodID, name);
#endif
return result;
}
static unif01_Gen *CreateDenga (unsigned long m, unsigned long b, int k,
unsigned long S[], int id)
{
unif01_Gen *gen;
DX02_state *state;
DX02_param *param;
size_t leng;
char name[LEN + 1];
int j;
gen = util_Malloc (sizeof (unif01_Gen));
state = util_Malloc (sizeof (DX02_state));
param = util_Malloc (sizeof (DX02_param));
if (0 == id) {
util_Assert (k < 129, "udeng_CreateDL00a: k > 128");
} else {
util_Assert (k < 129, "udeng_CreateDX02a: k > 128");
}
state->X = util_Calloc (MASK1 + 1, sizeof (double));
for (j = 0; j < k; j++)
state->X[k - j - 1] = S[j] % m;
state->s = k - 1;
state->K = k;
param->b = b;
param->m = m;
if (0 == id)
strcpy (name, "udeng_CreateDL00a:");
else
#ifdef LAC
strcpy (name, "udeng_CreateDX02a, Lac = {0, 101, 102}:");
#else
strcpy (name, "udeng_CreateDX02a:");
#endif
addstr_Ulong (name, " m = ", m);
addstr_Ulong (name, ", b = ", b);
addstr_Uint (name, ", k = ", (unsigned) k);
addstr_ArrayUlong (name, ", S = ", k, S);
leng = strlen (name);
gen->name = util_Calloc (leng + 1, sizeof (char));
strncpy (gen->name, name, leng);
gen->param = param;
gen->state = state;
if (0 == id) {
gen->GetBits = &DL00a_Bits;
gen->GetU01 = &DL00a_U01;
} else {
gen->GetBits = &DX02a_Bits;
gen->GetU01 = &DX02a_U01;
}
gen->Write = &WrDX02a;
return gen;
}
unif01_Gen * utaus_CreateLongTaus (unsigned int k, unsigned int q,
unsigned int s, ulonglong Y)
{
unif01_Gen *gen;
LongTaus_param *param;
LongTaus_state *state;
size_t len;
char name[LEN0 + 1];
ulonglong B;
util_Assert ((k <= 64) && (k > 2 * q) && (s <= k - q) && (s >= 1) &&
(q >= 1), "utaus_CreateLongTaus: Invalid Parameter");
gen = util_Malloc (sizeof (unif01_Gen));
param = util_Malloc (sizeof (LongTaus_param));
state = util_Malloc (sizeof (LongTaus_state));
strncpy (name, "utaus_CreateLongTaus", (size_t) LEN0);
addstr_Uint (name, ": k = ", k);
addstr_Uint (name, ", q = ", q);
addstr_Uint (name, ", s = ", s);
addstr_ULONG (name, ", Y = ", Y);
len = strlen (name);
gen->name = util_Calloc (len + 1, sizeof (char));
strncpy (gen->name, name, len);
param->Q1 = q;
param->K1mS1 = k - s;
param->S1 = s;
B = num_TwoExp[64 - k] - 1.0; /* k most signif. bits at 1 */
param->M1 = ~B;
util_Assert (Y > 0, "utaus_CreateLongTaus: Y = 0");
state->ST1 = Y & param->M1;
/* make sure that the initial state is not 0 */
while (state->ST1 == 0) {
Y *= 2;
state->ST1 = Y & param->M1;
}
B = ((state->ST1 << param->Q1) ^ state->ST1) >> k;
state->ST1 ^= B;
gen->GetBits = &LongTaus_Bits;
gen->GetU01 = &LongTaus_U01;
gen->Write = &WrLongTaus;
gen->param = param;
gen->state = state;
return gen;
}
unif01_Gen *uweyl_CreateNWeyl (double Alpha, long n0)
{
unif01_Gen *gen;
char name[LEN + 1];
util_Assert ((Alpha > 0.0), "uweyl_CreateNWeyl: Alpha <= 0");
util_Assert ((Alpha < 1.0), "uweyl_CreateNWeyl: Alpha >= 1");
strncpy (name, "uweyl_CreateNWeyl (nested): ", (size_t) LEN);
gen = CreateWeyl_0 (Alpha, n0, name);
gen->GetU01 = &NWeyl_U01;
gen->GetBits = &NWeyl_Bits;
return gen;
}
long tables_HashPrime (long n, double load)
{
int i;
double nD;
util_Assert (n > 0, "tables_HashPrime : n <= 0");
nD = (double) n;
i = 1;
while (i < MaxInd && HacheTab[i] < n)
++i;
while (i < MaxInd && load * (double) (HacheTab[i]) < nD)
++i;
util_Assert (HacheTab[i] > 0, "tables_HashPrime failed");
return HacheTab[i];
}
unif01_Gen * unumrec_CreateRan0 (long s)
{
unif01_Gen *gen;
Ran0_param *param;
Ran0_state *state;
size_t leng;
char name[LEN + 1];
util_Assert (s > 0, "unumrec_CreateRan0: s <= 0");
gen = util_Malloc (sizeof (unif01_Gen));
param = util_Malloc (sizeof (Ran0_param));
state = util_Malloc (sizeof (Ran0_state));
strncpy (name, "unumrec_CreateRan0:", LEN);
addstr_Long (name, " s = ", s);
leng = strlen (name);
gen->name = util_Calloc (leng + 1, sizeof (char));
strncpy (gen->name, name, leng);
state->S1 = s;
param->Norm = 1.0 / M1;
gen->GetBits = &Ran0_Bits;
gen->GetU01 = &Ran0_U01;
gen->Write = &WrRan0;
gen->param = param;
gen->state = state;
return gen;
}
double num2_VolumeSphere (double pLR, int k)
/* Returns volume of unit sphere in dimension k, norm p */
{
const double eps = 2.0 * DBL_EPSILON;
int p = (int)pLR;
double kLR = (double) k;
double Vol;
int s;
util_Assert (pLR >= 0.0, "num2_VolumeSphere: p < 0");
if (fabs (pLR - p) <= eps) {
switch (p) {
case 0:
return num_TwoExp[k];
break;
case 1:
return num_TwoExp[k] / num2_Factorial (k);
break;
case 2:
if ((k % 2) == 0) {
return pow (num_Pi, kLR / 2.0) / num2_Factorial (k / 2);
} else {
s = (k + 1) / 2;
return pow (num_Pi, (double) (s) - 1.0) * num2_Factorial (s) *
num_TwoExp[2 * s] / num2_Factorial (2 * s);
}
break;
default:
break;
}
}
Vol = kLR * (num_Ln2 + num2_LnGamma (1.0 + 1.0 / pLR)) -
num2_LnGamma (1.0 + kLR / pLR);
return exp (Vol);
}
double num2_Factorial (int n)
{
util_Assert (n >= 0, "num2_Factorial: n < 0");
if (n <= 170)
return Factorials[n];
util_Warning (1, "num2_Factorial: n > 170: return inf");
return 1.0 / 0.0;
}
void util_InitializeShareInitContext(JNIEnv *env,
void *yourInitContext)
{
ShareInitContext *initContext = (ShareInitContext *) yourInitContext;
initContext->propertiesClass = nsnull;
initContext->propertiesClass =
::util_FindClass(env, "java/util/Properties");
util_Assert(initContext->propertiesClass);
}
void gofw_ActiveTests2 (double V[], double U[], long N, wdist_CFUNC F,
double par[], gofw_TestArray sVal, gofw_TestArray pVal)
{
util_Assert (N > 0, "gofw_ActiveTests1: N <= 0");
tables_QuickSortD (V, 1, N);
gofs_ContUnifTransform (V, N, F, par, U);
gofw_ActiveTests0 (U, N, sVal, pVal);
if (N == 1)
sVal[gofw_Mean] = V[1];
}
static int ChooseParamRW (int prec, void *cho,
long *pn, int *pr, int *ps, long *pL, long LMin, int i, int j)
/*
* Set the values of the parameters for the test. If a parameter is < 0,
* will call a choose function to set it. Otherwise, will accept it as is.
* Returns 0 if parameters are ok for the test, returns -1 if the test
* should not be done for these parameters.
*/
{
fcho_Cho2 *cho2 = cho;
fcho_Cho *chon;
fcho_Cho *choL;
util_Assert (cho, "fwalk: cho is NULL");
chon = cho2->Chon;
choL = cho2->Chop2;
util_Assert (*pn < 0 || *pL < 0, "fwalk: Either n or L must be < 0");
if (*pn < 0) {
util_Assert (chon, "fwalk: n < 0 and chon is NULL");
*pn = fcho_ChooseParamL (chon, (long) (3.0 * gofs_MinExpected),
fwalk_Maxn, i, j);
if (*pn <= 0)
return -1;
}
*ps = fcho_Chooses (*pr, *ps, prec);
if (*ps <= 0)
return -1;
if (*pL < 0) {
util_Assert (choL, "fwalk: L < 0 and choL is NULL");
*pL = fcho_ChooseParamL (choL, LMin, fwalk_MaxL, i, j);
if (*pL < 0)
return -1;
/* L must be even */
if (*pL & 1)
++(*pL);
}
return 0;
}
void gofw_Tests0 (double U[], long N, gofw_TestArray sVal)
{
long i;
double A2 = 0.0, W2, DM = 0.0, DP = 0.0, W;
double U1, Ui, D2, D1;
double SumZ;
double UnSurN;
util_Assert (N > 0, "gofw_Tests0: N <= 0");
/* We assume that U is already sorted. */
if (N == 1) {
sVal[gofw_KSP] = 1.0 - U[1];
sVal[gofw_Mean] = U[1];
return;
}
UnSurN = 1.0 / N;
W2 = UnSurN / 12.0;
SumZ = 0.0;
for (i = 1; i <= N; i++) {
/* Statistics KS */
D1 = U[i] - (i - 1) * UnSurN;
D2 = i * UnSurN - U[i];
if (D1 > DM)
DM = D1;
if (D2 > DP)
DP = D2;
/* Watson U and G */
SumZ += U[i];
W = U[i] - (i - 0.5) * UnSurN;
W2 += W * W;
/* Anderson-Darling */
Ui = U[i];
U1 = 1.0 - Ui;
if (Ui < gofs_EpsilonAD)
Ui = gofs_EpsilonAD;
else if (U1 < gofs_EpsilonAD)
U1 = gofs_EpsilonAD;
A2 += (2 * i - 1) * log (Ui) + (1 + 2 * (N - i)) * log (U1);
}
if (DM > DP)
sVal[gofw_KS] = DM;
else
sVal[gofw_KS] = DP;
sVal[gofw_KSM] = DM;
sVal[gofw_KSP] = DP;
SumZ = SumZ * UnSurN - 0.5;
sVal[gofw_CM] = W2;
sVal[gofw_WG] = sqrt ((double) N) * (DP + SumZ);
sVal[gofw_WU] = W2 - SumZ * SumZ * N;
sVal[gofw_AD] = -N - A2 * UnSurN;
/* sVal[gofw_Mean] = SumZ + 0.5; */ /* Nouveau ... */
}
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 gofw_ActiveTests1 (double V[], long N, wdist_CFUNC F, double par[],
gofw_TestArray sVal, gofw_TestArray pVal)
{
double *U;
util_Assert (N > 0, "gofw_ActiveTests1: N <= 0");
U = (double *) util_Calloc ((size_t) N + 1, sizeof (double));
gofs_ContUnifTransform (V, N, F, par, U);
tables_QuickSortD (U, 1, N);
gofw_ActiveTests0 (U, N, sVal, pVal);
if (N == 1)
sVal[gofw_Mean] = V[1];
util_Free (U);
}
static void InitAppear (int r, int s, int L, long Q, double E[], double KV[])
{
util_Assert (r >= 0, "svaria_AppearanceSpacings: r < 0");
util_Assert (s > 0, "svaria_AppearanceSpacings: s <= 0");
/* if (L >= s && L % s) {
util_Error ("svaria_AppearanceSpacings: L mod s != 0");
}*/
if (L < s && s % L) {
util_Error ("svaria_AppearanceSpacings: s mod L != 0");
}
util_Warning (Q < 10.0 * num_TwoExp[L],
"svaria_AppearanceSpacings: Q < 10 * 2^L");
/* Theoretical mean E and variance KV for different L given by Maurer */
if (L > 16) {
/* For L > 16 and near 16, the 6-th decimal of E[L] could be
erroneous. For KV [L], the 4-th decimal. */
E[L] = L - 8.32746E-1;
KV[L] = 3.423715;
} else {
E [1] = 0.73264948; KV[1] = 0.68977;
E [2] = 1.53743829; KV[2] = 1.33774;
E [3] = 2.40160681; KV[3] = 1.90133;
E [4] = 3.31122472; KV[4] = 2.35774;
E [5] = 4.25342659; KV[5] = 2.70455;
E [6] = 5.21770525; KV[6] = 2.95403;
E [7] = 6.19625065; KV[7] = 3.12539;
E [8] = 7.18366555; KV[8] = 3.23866;
E [9] = 8.17642476; KV[9] = 3.31120;
E [10] = 9.17232431; KV[10] = 3.35646;
E [11] = 10.1700323; KV[11] = 3.38409;
E [12] = 11.1687649; KV[12] = 3.40065;
E [13] = 12.1680703; KV[13] = 3.41043;
E [14] = 13.1676926; KV[14] = 3.41614;
E [15] = 14.1674884; KV[15] = 3.41943;
E [16] = 15.1673788; KV[16] = 3.42130;
}
}
static int ChooseParamVarGeo (void *cho, long *pn, double *pMu, int i, int j)
/*
* Set the values of the parameters for the test. If a parameter is < 0,
* will call a choose function to set it. Otherwise, will accept it as is.
* Returns 0 if parameters are ok for the test, returns -1 if the test
* should not be done for these parameters.
*/
{
fcho_Cho2 *cho2 = cho;
fcho_Cho *chon;
fcho_Cho *choMu;
util_Assert (cho, "fwalk: cho is NULL");
chon = cho2->Chon;
choMu = cho2->Chop2;
util_Assert (*pn < 0 || *pMu < 0, "fwalk: Either n or Mu must be < 0");
if (*pn < 0) {
util_Assert (chon, "fwalk: n < 0 and chon is NULL");
*pn = fcho_ChooseParamL (chon, (long) (3.0 * gofs_MinExpected),
fwalk_Maxn, i, j);
if (*pn < 0)
return -1;
}
if (*pMu < 0) {
util_Assert (choMu, "fwalk: Mu < 0 and choMu is NULL");
*pMu = choMu->Choose (choMu->param, i, j);
if (*pMu < fwalk_MinMu) {
printf ("Mu < %.2g\n\n", fwalk_MinMu);
return -1;
}
}
return 0;
}
void util_StoreIntoPropertiesObject(JNIEnv *env, jobject propertiesObject,
jobject name, jobject value,
jobject initContextObj)
{
#ifdef BAL_INTERFACE
if (nsnull != externalStoreIntoPropertiesObject) {
externalStoreIntoPropertiesObject(env, propertiesObject, name, value,
initContextObj);
}
#else
util_Assert(initContextObj);
ShareInitContext *initContext = (ShareInitContext *) initContextObj;
jclass propertiesClass = nsnull;
if (nsnull == (propertiesClass =
::util_FindClass(env, "java/util/Properties"))) {
return;
}
if (nsnull == gPropertiesSetPropertyMethodID) {
if (nsnull == (gPropertiesSetPropertyMethodID =
env->GetMethodID(propertiesClass,
"setProperty",
"(Ljava/lang/String;Ljava/lang/String;)Ljava/lang/Object;"))) {
return;
}
}
util_Assert(gPropertiesSetPropertyMethodID);
env->CallObjectMethod(propertiesObject, gPropertiesSetPropertyMethodID,
name, value);
#endif
}
void ftab_SetDesc (ftab_Table *T, char *Desc)
{
size_t len;
util_Assert (T != NULL, "ftab_SetDesc: ftab_Table is a NULL pointer");
len = strlen (Desc);
if (len > MAXLEN) {
len = MAXLEN;
util_Warning (1, "ftab_Table->Desc truncated");
}
if (T->Desc != NULL)
T->Desc = util_Free (T->Desc);
T->Desc = util_Calloc (len + 1, sizeof (char));
strncpy (T->Desc, Desc, (size_t) len);
T->Desc[len] = '\0';
}
double num2_LnFactorial (int n)
{
util_Assert (n >= 0, "num2_LnFactorial: n < 0");
if (n <= MLIM) {
return LnFactorials[n];
} else {
double x = (double) (n + 1);
double y = 1.0 / (x * x);
double z = ((-(5.95238095238E-4 * y) + 7.936500793651E-4) * y -
2.7777777777778E-3) * y + 8.3333333333333E-2;
z = ((x - 0.5) * log (x) - x) + 9.1893853320467E-1 + z / x;
return z;
}
}
void scatter_PlotUnif1 (unif01_Gen * gen, long N, int Dim, lebool Over,
int Proj[2], double Lower[], double Upper[], scatter_OutputType Output,
int Prec, lebool Lac, long LacI[], char *Name)
{
int j;
unif01_Gen *genL;
chro = chrono_Create ();
scatter_N = N;
scatter_t = Dim;
scatter_Over = Over;
scatter_x = Proj[0];
scatter_y = Proj[1];
for (j = 1; j <= scatter_t; j++) {
scatter_L[j] = Lower[j - 1];
scatter_H[j] = Upper[j - 1];
util_Assert (scatter_L[j] >= 0.0, "scatter_PlotUnif1: Lower[r] < 0");
util_Assert (scatter_H[j] <= 1.0, "scatter_PlotUnif1: Upper[r] > 1");
util_Assert (scatter_L[j] < scatter_H[j],
"scatter_PlotUnif1: Upper[r] <= Lower[r]");
}
if (scatter_Width <= 0.0)
scatter_Width = 13.0; /* cm */
if (scatter_Height <= 0.0)
scatter_Height = 13.0; /* cm */
scatter_Output = Output;
scatter_Lacunary = Lac;
if (scatter_Lacunary) {
for (j = 0; j < scatter_t; j++)
scatter_LacI[j] = LacI[j];
genL = unif01_CreateLacGen (gen, scatter_t, scatter_LacI);
} else
genL = gen;
strncpy (Nin, Name, (size_t) NUM_CHAR - 5);
Plot (genL, Nin, Prec);
chrono_Delete (chro);
}
long fcho_ChooseParamL (fcho_Cho *cho, long min, long max, long i, long j)
{
double n;
util_Assert (cho, "fcho_ChooseParamL: cho is NULL");
n = cho->Choose (cho->param, i, j);
if (n < min) {
if (cho->name)
printf ("%s < %ld\n\n", cho->name, min);
return -1;
}
if (n > max) {
if (cho->name)
printf ("%s > %ld\n\n", cho->name, max);
return -1;
}
return (long) n;
}
unif01_Gen * unumrec_CreateRan2 (long s)
{
unif01_Gen *gen;
Ran0_param *param;
Ran2_state *state;
size_t leng;
char name[LEN + 1];
int i;
long k;
util_Assert (s > 0, "unumrec_CreateRan2: s <= 0");
gen = util_Malloc (sizeof (unif01_Gen));
param = util_Malloc (sizeof (Ran0_param));
state = util_Malloc (sizeof (Ran2_state));
strncpy (name, "unumrec_CreateRan2:", LEN);
addstr_Long (name, " s = ", s);
leng = strlen (name);
gen->name = util_Calloc (leng + 1, sizeof (char));
strncpy (gen->name, name, leng);
param->Norm = 1.0 / M1;
state->S1 = s;
state->S2 = s;
for (i = N_TAB8; i >= 1; i--) {
k = state->S1 / q1;
state->S1 = A1 * (state->S1 - k * q1) - k * r1;
if (state->S1 < 0)
state->S1 += M1;
if (i <= N_TAB)
state->Tab[i] = state->S1;
}
state->z = state->Tab[1];
gen->GetBits = &Ran2_Bits;
gen->GetU01 = &Ran2_U01;
gen->Write = &WrRan2;
gen->param = param;
gen->state = state;
return gen;
}
void bitset_WriteSet (char *desc, bitset_BitSet S, int n)
{
int i;
bitset_BitSet mask;
util_Assert (n > 0, "bitset_WriteSet: s <= 0");
if ((unsigned) n > CHAR_BIT * sizeof (bitset_BitSet)) {
n = CHAR_BIT * sizeof (bitset_BitSet);
printf ("********** bitset_WriteSet: only %d bits in a BitSet\n\n", n);
}
if (desc != NULL && strlen (desc) > 0)
printf ("%s", desc);
mask = (bitset_BitSet) 1 << (n - 1);
for (i = 0; i < n; i++) {
if (S & mask)
printf ("1");
else
printf ("0");
mask >>= 1;
}
}
unif01_Gen * uautomata_CreateCA90mp (int m, int S[])
{
unif01_Gen *gen;
CA90mp_state *state;
size_t leng;
char name[LEN + 1];
int i;
gen = util_Malloc (sizeof (unif01_Gen));
state = util_Malloc (sizeof (CA90mp_state));
strncpy (name, "uautomata_CreateCA90mp:", (size_t) LEN);
addstr_Long (name, " m = ", (long) m);
addstr_ArrayInt (name, ", S = ", m, S);
leng = strlen (name);
gen->name = util_Calloc (leng + 1, sizeof (char));
strncpy (gen->name, name, (size_t) leng);
state->Cell = util_Calloc ((size_t) m + 2, sizeof (int));
state->OldCell = util_Calloc ((size_t) m + 2, sizeof (int));
state->m = m;
for (i = 1; i <= m; i++) {
util_Assert (S[i] == 0 || S[i] == 1,
"uautomata_CreateCA90mp: all S[i] must be in { 0, 1 }.");
state->Cell[i] = S[i];
}
/* Null boundary condition */
state->Cell[0] = 0;
state->OldCell[0] = 0;
gen->GetBits = &CA90mp_Bits;
gen->GetU01 = &CA90mp_U01;
gen->Write = &WrCA90mp;
gen->state = state;
gen->param = NULL;
return gen;
}
void gofw_ActiveTests0 (double U[], long N,
gofw_TestArray sVal, gofw_TestArray pVal)
{
util_Assert (N > 0, "gofw_ActiveTests0: N <= 0");
if (N == 1) {
sVal[gofw_Mean] = U[1];
pVal[gofw_Mean] = 1.0 - U[1];
sVal[gofw_KSP] = 1.0 - U[1];
pVal[gofw_KSP] = 1.0 - U[1];
pVal[gofw_AD] = -1.0; /* My bug detector */
return;
}
/* We assume that U is already sorted. */
gofw_Tests0 (U, N, sVal);
if (bitset_TestBit (gofw_ActiveTests, gofw_KSP))
pVal[gofw_KSP] = fbar_KSPlus (N, sVal[gofw_KSP]);
if (bitset_TestBit (gofw_ActiveTests, gofw_KSM))
pVal[gofw_KSM] = fbar_KSPlus (N, sVal[gofw_KSM]);
if (bitset_TestBit (gofw_ActiveTests, gofw_KS))
pVal[gofw_KS] = fbar_KS1 (N, sVal[gofw_KS]);
if (bitset_TestBit (gofw_ActiveTests, gofw_AD))
pVal[gofw_AD] = fbar_AndersonDarling (N, sVal[gofw_AD]);
if (bitset_TestBit (gofw_ActiveTests, gofw_CM))
pVal[gofw_CM] = fbar_CramerMises (N, sVal[gofw_CM]);
if (bitset_TestBit (gofw_ActiveTests, gofw_WG))
pVal[gofw_WG] = fbar_WatsonG (N, sVal[gofw_WG]);
if (bitset_TestBit (gofw_ActiveTests, gofw_WU))
pVal[gofw_WU] = fbar_WatsonU (N, sVal[gofw_WU]);
}
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);
}
double num2_LnGamma (double x)
{
const double xlimbig = 1.0 / DBL_EPSILON;
const double xlim1 = 18.0;
const double dk2 = 0.91893853320467274178; /* Ln (sqrt (2 Pi)) */
const double dk1 = 0.9574186990510627;
const int N = 15; /* Degree of Chebyshev polynomial */
double y = 0, z = 0;
int i, k;
/* Chebyshev coefficients for lnGamma (x + 3), 0 <= x <= 1 In Yudell Luke:
The special functions and their approximations, Vol. II, Academic Press,
p. 301, 1969. There is an error in the additive constant in the formula:
(Ln (2)). */
static const double A[] = {
0.52854303698223459887,
0.54987644612141411418,
0.02073980061613665136,
-0.00056916770421543842,
0.00002324587210400169,
-0.00000113060758570393,
0.00000006065653098948,
-0.00000000346284357770,
0.00000000020624998806,
-0.00000000001266351116,
0.00000000000079531007,
-0.00000000000005082077,
0.00000000000000329187,
-0.00000000000000021556,
0.00000000000000001424,
-0.00000000000000000095
};
util_Assert (x > 0.0, "num2_LnGamma: accepts only x > 0");
if (x > xlim1) {
if (x > xlimbig)
y = 0.0;
else
y = 1.0 / (x * x);
z = ((-(5.95238095238E-4 * y) + 7.936500793651E-4) * y -
2.7777777777778E-3) * y + 8.3333333333333E-2;
z = ((x - 0.5) * log (x) - x) + dk2 + z / x;
return z;
} else if (x > 4.0) {
k = (int) x;
z = x - k;
y = 1.0;
for (i = 3; i < k; i++)
y *= z + i;
y = log (y);
} else if (x <= 0.0) {
return DBL_MAX;
} else if (x < 3.0) {
k = (int) x;
z = x - k;
y = 1.0;
for (i = 2; i >= k; i--)
y *= z + i;
y = -log (y);
} else { /* 3 <= x <= 4 */
z = x - 3.0;
y = 0.0;
}
z = num2_EvalCheby (A, N, 2.0 * z - 1.0);
return z + dk1 + y;
}
