SEXP R_MonteCarloIndependenceTest (SEXP x, SEXP y, SEXP block, SEXP B) {
int n, p, q, pq, i, *index, *permindex, b, Bsim;
SEXP ans, blocksetup, linstat;
double *dans, *dlinstat, *dx, *dy, f = 0.1;
n = nrow(x);
p = ncol(x);
q = ncol(y);
pq = p*q;
Bsim = INTEGER(B)[0];
dx = REAL(x);
dy = REAL(y);
index = Calloc(n, int);
permindex = Calloc(n, int);
PROTECT(blocksetup = R_blocksetup(block));
PROTECT(ans = allocMatrix(REALSXP, pq, Bsim));
dans = REAL(ans);
PROTECT(linstat = allocVector(REALSXP, pq));
dlinstat = REAL(linstat);
for (i = 0; i < n; i++)
index[i] = i;
GetRNGstate();
for (b = 0; b < Bsim; b++) {
C_blockperm(blocksetup, permindex);
C_PermutedLinearStatistic(dx, p, dy, q, n, n, index, permindex, dlinstat);
for (i = 0; i < pq; i++) dans[b*pq + i] = dlinstat[i];
/* check user interrupts */
if (b > Bsim * f) {
R_CheckUserInterrupt();
f += 0.1;
}
}
PutRNGstate();
Free(index); Free(permindex);
UNPROTECT(3);
return(ans);
}
SEXP R_PermutedLinearStatistic(SEXP x, SEXP y, SEXP indx, SEXP perm) {
SEXP ans;
int n, nperm, p, q, i, *iperm, *iindx;
/*
only a basic check
*/
if (!isReal(x) || !isReal(y))
error("R_PermutedLinearStatistic: arguments are not of type REALSXP");
if (!isInteger(perm))
error("R_PermutedLinearStatistic: perm is not of type INTSXP");
if (!isInteger(indx))
error("R_PermutedLinearStatistic: indx is not of type INTSXP");
n = nrow(y);
nperm = LENGTH(perm);
iperm = INTEGER(perm);
if (LENGTH(indx) != nperm)
error("R_PermutedLinearStatistic: dimensions don't match");
iindx = INTEGER(indx);
if (nrow(x) != n)
error("R_PermutedLinearStatistic: dimensions don't match");
for (i = 0; i < nperm; i++) {
if (iperm[i] < 0 || iperm[i] > (n - 1) )
error("R_PermutedLinearStatistic: perm is not between 1 and nobs");
if (iindx[i] < 0 || iindx[i] > (n - 1) )
error("R_PermutedLinearStatistic: indx is not between 1 and nobs");
}
q = ncol(y);
p = ncol(x);
PROTECT(ans = allocVector(REALSXP, p*q));
C_PermutedLinearStatistic(REAL(x), p, REAL(y), q, n, nperm,
iindx, iperm, REAL(ans));
UNPROTECT(1);
return(ans);
}