int main(void)
{
Type **ppObj;
int rows, cols, gotFailure = 0;
for (
rows = ROW_COUNT_START, cols = COL_COUNT_START;
rows < DIM_MAX && cols > 0;
rows += DIM_STEP, cols -= DIM_STEP
)
{
int failed;
/* Create a 2D array of "Objects" dynamically. */
ppObj = Create2D((size_t)rows, (size_t)cols);
/* Test it and print the results. */
failed = Test2D(ppObj, rows, cols);
/* Free the array. */
Free2D((void *)ppObj);
if (failed)
{
gotFailure = 1;
fprintf(stderr, "Create2D(%d, %d) failed\n", rows, cols);
}
else
printf("Create2D(%d, %d) succeeded\n", rows, cols);
}
if (gotFailure)
return EXIT_FAILURE;
return EXIT_SUCCESS;
}
/* conditional mutual information, to be used in C code. */
double c_cchisqtest(int *xx, int llx, int *yy, int lly, int *zz, int llz,
int num, double *df, test_e test) {
int ***n = NULL, **ni = NULL, **nj = NULL, *nk = NULL, adj = IS_ADF(test);
double res = 0;
if (adj) {
/* if there are less than 5 observations per cell on average, asuume the
* test does not have enough power and return independence. */
if (num < 5 * llx * lly * llz) {
if (df) *df = 1;
return 0;
}/*THEN*/
}/*THEN*/
/* initialize the contingency table and the marginal frequencies. */
fill_3d_table(xx, yy, zz, &n, &ni, &nj, &nk, llx, lly, llz, num);
/* compute the conditional mutual information or Pearson's X^2. */
if ((test == MI) || (test == MI_ADF))
res = cmi_kernel(n, ni, nj, nk, llx, lly, llz) / num;
else if ((test == X2) || (test == X2_ADF))
res = cx2_kernel(n, ni, nj, nk, llx, lly, llz);
/* compute the degrees of freedom. */
if (df)
*df = adj ? cdf_adjust(ni, llx, nj, lly, llz) : (llx - 1) * (lly - 1) * llz;
Free3D(n, llz, llx);
Free2D(ni, llz);
Free2D(nj, llz);
Free1D(nk);
return res;
}/*C_CCHISQTEST*/
void Trajectory::nextframe()
{
if(fail) return;
if(!frameheader(×tep, &n, boxlo.data(), boxhi.data())) {
fail = true;
return;
}
if(timestep < 0) {
fail = true;
return;
}
for (int i = 0; i < 3; ++i) {
prd[i] = boxhi[i] - boxlo[i];
}
if (n > 0) {
if (last_n_allocated != n) {
if (x != nullptr) Free2D(x);
if (v != nullptr) Free2D(v);
if (f != nullptr) Free2D(f);
}
x = Array2D(n, 3);
v = Array2D(n, 3);
f = Array2D(n, 3);
last_n_allocated = n;
if(!framebody(&n, x[0], v[0], f[0])) {
fail = true;
return;
}
} else {
fail = true;
return;
}
}
/* shrinked mutual information, to be used in C code. */
double c_shmi(int *xx, int llx, int *yy, int lly, int num) {
int i = 0, j = 0, k = 0;
double **n = NULL, *ni = NULL, *nj = NULL;
double lambda = 0, target = 1/(double)(llx * lly);
double res = 0;
/* initialize the contingency table and the marginal frequencies. */
n = (double **) Calloc2D(llx, lly, sizeof(double));
ni = Calloc1D(llx, sizeof(double));
nj = Calloc1D(lly, sizeof(double));
/* compute the joint frequency of x and y. */
for (k = 0; k < num; k++)
n[xx[k] - 1][yy[k] - 1]++;
/* estimate the optimal lambda for the data. */
mi_lambda((double *)n, &lambda, target, num, llx, lly, 0);
/* switch to the probability scale and shrink the estimates. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
n[i][j] = lambda * target + (1 - lambda) * n[i][j] / num;
/* compute the marginals. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++) {
ni[i] += n[i][j];
nj[j] += n[i][j];
}/*FOR*/
/* compute the mutual information from the joint and marginal frequencies. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
if (n[i][j] != 0)
res += n[i][j] * log(n[i][j] / (ni[i] * nj[j]));
Free1D(ni);
Free1D(nj);
Free2D(n, llx);
return res;
}/*C_SHMI*/
double cdlik(SEXP x, SEXP y, double *nparams) {
int i = 0, j = 0, k = 0;
int **n = NULL, *nj = NULL;
int llx = NLEVELS(x), lly = NLEVELS(y), num = length(x);
int *xx = INTEGER(x), *yy = INTEGER(y);
double res = 0;
/* initialize the contingency table and the marginal frequencies. */
n = (int **) Calloc2D(llx, lly, sizeof(int));
nj = Calloc1D(lly, sizeof(int));
/* compute the joint frequency of x and y. */
for (k = 0; k < num; k++)
n[xx[k] - 1][yy[k] - 1]++;
/* compute the marginals. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
nj[j] += n[i][j];
/* compute the conditional entropy from the joint and marginal
frequencies. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
if (n[i][j] != 0)
res += (double)n[i][j] * log((double)n[i][j] / (double)nj[j]);
/* we may want to store the number of parameters. */
if (nparams)
*nparams = (llx - 1) * lly;
Free1D(nj);
Free2D(n, llx);
return res;
}/*CDLIK*/
/* shrinked conditional mutual information, to be used in C code. */
double c_shcmi(int *xx, int llx, int *yy, int lly, int *zz, int llz,
int num, double *df) {
int i = 0, j = 0, k = 0;
double ***n = NULL, **ni = NULL, **nj = NULL, *nk = NULL;
double lambda = 0, target = 1/(double)(llx * lly * llz);
double res = 0;
/* compute the degrees of freedom. */
*df = (double)(llx - 1) * (double)(lly - 1) * (double)(llz);
/* initialize the contingency table and the marginal frequencies. */
n = (double ***) Calloc3D(llx, lly, llz, sizeof(double));
ni = (double **) Calloc2D(llx, llz, sizeof(double));
nj = (double **) Calloc2D(lly, llz, sizeof(double));
nk = Calloc1D(llz, sizeof(double));
/* compute the joint frequency of x, y, and z. */
for (k = 0; k < num; k++)
n[xx[k] - 1][yy[k] - 1][zz[k] - 1]++;
/* estimate the optimal lambda for the data. */
mi_lambda((double *)n, &lambda, target, num, llx, lly, llz);
/* switch to the probability scale and shrink the estimates. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
for (k = 0; k < llz; k++)
n[i][j][k] = lambda * target + (1 - lambda) * n[i][j][k] / num;
/* compute the marginals. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
for (k = 0; k < llz; k++) {
ni[i][k] += n[i][j][k];
nj[j][k] += n[i][j][k];
nk[k] += n[i][j][k];
}/*FOR*/
for (k = 0; k < llz; k++) {
/* check each level of the conditioning variable to avoid (again)
* "divide by zero" errors. */
if (nk[k] == 0)
continue;
for (j = 0; j < lly; j++) {
for (i = 0; i < llx; i++) {
if (n[i][j][k] > 0)
res += n[i][j][k] * log( (n[i][j][k] * nk[k]) / (ni[i][k] * nj[j][k]) );
}/*FOR*/
}/*FOR*/
}/*FOR*/
Free1D(nk);
Free2D(ni, llx);
Free2D(nj, lly);
Free3D(n, llx, lly);
return res;
}/*C_SHCMI*/
Trajectory::~Trajectory()
{
if (x != nullptr) Free2D(x);
if (v != nullptr) Free2D(v);
if (f != nullptr) Free2D(f);
}
/* conditional posterior Dirichlet probability (covers BDe and K2 scores). */
double cdpost(SEXP x, SEXP y, SEXP iss, SEXP exp) {
int i = 0, j = 0, k = 0, imaginary = 0, num = length(x);
int llx = NLEVELS(x), lly = NLEVELS(y), p = llx * lly;
int *xx = INTEGER(x), *yy = INTEGER(y), **n = NULL, *nj = NULL;
double alpha = 0, res = 0;
if (isNull(iss)) {
/* this is for K2, which does not define an imaginary sample size;
* all hyperparameters are set to 1 in the prior distribution. */
imaginary = p;
alpha = 1;
}/*THEN*/
else {
/* this is for the BDe score. */
imaginary = INT(iss);
alpha = ((double) imaginary) / ((double) p);
}/*ELSE*/
/* initialize the contingency table. */
n = (int **) Calloc2D(llx, lly, sizeof(int));
nj = Calloc1D(lly, sizeof(int));
/* compute the joint frequency of x and y. */
if (exp == R_NilValue) {
for (i = 0; i < num; i++) {
n[xx[i] - 1][yy[i] - 1]++;
nj[yy[i] - 1]++;
}/*FOR*/
}/*THEN*/
else {
int *e = INTEGER(exp);
for (i = 0, k = 0; i < num; i++) {
if (i != e[k] - 1) {
n[xx[i] - 1][yy[i] - 1]++;
nj[yy[i] - 1]++;
}/*THEN*/
else {
k++;
}/*ELSE*/
}/*FOR*/
/* adjust the sample size to match the number of observational data. */
num -= length(exp);
}/*ELSE*/
/* compute the conditional posterior probability. */
for (i = 0; i < llx; i++)
for (j = 0; j < lly; j++)
res += lgammafn(n[i][j] + alpha) - lgammafn(alpha);
for (j = 0; j < lly; j++)
res += lgammafn((double)imaginary / lly) -
lgammafn(nj[j] + (double)imaginary / lly);
Free1D(nj);
Free2D(n, llx);
return res;
}/*CDPOST*/
