
/* C Header */

/*
    Copyright (C) 2017-2023 Torsten Hothorn

    This file is part of the 'libcoin' R add-on package.

    'libcoin' is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, version 2.

    'libcoin' is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with 'libcoin'.  If not, see <http://www.gnu.org/licenses/>.


    DO NOT EDIT THIS FILE

    Edit 'libcoin.w' and run 'nuweb -r libcoin.w'
*/

#include "libcoin_internal.h"
#include <R_ext/stats_stubs.h>  /* for S_rcont2 */
#include <mvtnormAPI.h>         /* for calling mvtnorm */
/* Function Definitions */

/* MoreUtils */

/* NROW */

R_xlen_t NROW
(
    SEXP x
) {
    SEXP a;
    R_xlen_t ret;

    PROTECT(a = getAttrib(x, R_DimSymbol)); // rchk warning
    if (a == R_NilValue) {
        UNPROTECT(1);
        return(XLENGTH(x));
    }
    if (TYPEOF(a) == REALSXP) {
        ret = (R_xlen_t) REAL(a)[0];
        UNPROTECT(1);
        return(ret);
    }
    ret = (R_xlen_t) INTEGER(a)[0];
    UNPROTECT(1);
    return(ret);
}

/* NCOL */

int NCOL
(
    SEXP x
) {
    SEXP a;
    int ret;

    PROTECT(a = getAttrib(x, R_DimSymbol));  // rchk warning
    if (a == R_NilValue) {
        UNPROTECT(1);
        return(1);
    }
    if (TYPEOF(a) == REALSXP) {
        ret = (int) REAL(a)[1];
        UNPROTECT(1);
        return(ret);
    }
    ret = INTEGER(a)[1];
    UNPROTECT(1);
    return(ret);
}

/* NLEVELS */

int NLEVELS
(
    SEXP x
) {
    SEXP a;
    int maxlev = 0;

    PROTECT(a = getAttrib(x, R_LevelsSymbol));
    if (a == R_NilValue) {
        if (TYPEOF(x) != INTSXP)
            error("cannot determine number of levels");
        for (R_xlen_t i = 0; i < XLENGTH(x); i++) {
            if (INTEGER(x)[i] > maxlev)
                maxlev = INTEGER(x)[i];
        }
        UNPROTECT(1);
        return(maxlev);
    }
    maxlev = NROW(a);
    UNPROTECT(1);
    return(maxlev);
}

/* C_kronecker */

void C_kronecker
(
    const double *A,
    const int m,
    const int n,
    const double *B,
    const int r,
    const int s,
    const int overwrite,
    double *ans
) {
    int mr, js, ir;
    double y;

    if (overwrite) {
        for (int i = 0; i < m * r * n * s; i++) ans[i] = 0.0;
    }

    mr = m * r;
    for (int i = 0; i < m; i++) {
        ir = i * r;
        for (int j = 0; j < n; j++) {
            js = j * s;
            y = A[j*m + i];
            for (int k = 0; k < r; k++) {
                for (int l = 0; l < s; l++)
                    ans[(js + l) * mr + ir + k] += y * B[l * r + k];
            }
        }
    }
}

/* R_kronecker */

/* R_kronecker Prototype */

SEXP R_kronecker
(
    SEXP A,
    SEXP B
)

{
    int m, n, r, s;
    SEXP ans;

    if (!isReal(A) || !isReal(B))
        error("R_kronecker: A and / or B are not of type REALSXP");

    m = NROW(A);
    n = NCOL(A);
    r = NROW(B);
    s = NCOL(B);

    PROTECT(ans = allocMatrix(REALSXP, m * n, r * s));
    C_kronecker(REAL(A), m, n, REAL(B), r, s, 1, REAL(ans));
    UNPROTECT(1);
    return(ans);
}

/* C_kronecker_sym */

void C_kronecker_sym
(
    const double *A,
    const int m,
    const double *B,
    const int r,
    const int overwrite,
    double *ans
) {
    int mr, js, ir, s;
    double y;

    mr = m * r;
    s = r;

    if (overwrite) {
        for (int i = 0; i < mr * (mr + 1) / 2; i++) ans[i] = 0.0;
    }

    for (int i = 0; i < m; i++) {
        ir = i * r;
        for (int j = 0; j <= i; j++) {
            js = j * s;
            y = A[S(i, j, m)];
            for (int k = 0; k < r; k++) {
                for (int l = 0; l < (j < i ? s : k + 1); l++) {
                    ans[S(ir + k, js + l, mr)] += y * B[S(k, l, r)];
                }
            }
        }
    }
}

/* C_KronSums_sym */

/* sum_i (t(x[i,]) %*% x[i,]) */
void C_KronSums_sym_
(
    /* C real x Input */
    
    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    double *PP_sym_ans
) {
    int pN, qN, SpqP;

    for (int q = 0; q < P; q++) {
        qN = q * N;
        for (int p = 0; p <= q; p++) {
            PP_sym_ans[S(p, q, P)] = 0.0;
            pN = p * N;
            SpqP = S(p, q, P);
            for (int i = 0; i < N; i++)
                 PP_sym_ans[SpqP] += x[qN + i] * x[pN + i];
        }
    }
}

/* C_MPinv_sym */

void C_MPinv_sym
(
    const double *x,
    const int n,
    const double tol,
    double *dMP,
    int *rank
) {
    double *val, *vec, dtol, *rx, *work, valinv;
    int valzero = 0, info = 0, kn;

    if (n == 1) {
        if (x[0] > tol) {
            dMP[0] = 1 / x[0];
            rank[0] = 1;
        } else {
            dMP[0] = 0;
            rank[0] = 0;
        }
    } else {
        rx = R_Calloc(n * (n + 1) / 2, double);
        Memcpy(rx, x, n * (n + 1) / 2);
        work = R_Calloc(3 * n, double);
        val = R_Calloc(n, double);
        vec = R_Calloc(n * n, double);

        F77_CALL(dspev)("V", "L", &n, rx, val, vec, &n, work,
                        &info FCONE FCONE);

        dtol = val[n - 1] * tol;

        for (int k = 0; k < n; k++)
            valzero += (val[k] < dtol);
        rank[0] = n - valzero;

        for (int k = 0; k < n * (n + 1) / 2; k++) dMP[k] = 0.0;

        for (int k = valzero; k < n; k++) {
            valinv = 1 / val[k];
            kn = k * n;
            for (int i = 0; i < n; i++) {
                for (int j = 0; j <= i; j++) {
                    /* MP is symmetric */
                    dMP[S(i, j, n)] += valinv * vec[kn + i] * vec[kn + j];
                }
            }
        }
        R_Free(rx); R_Free(work); R_Free(val); R_Free(vec);
    }
}

/* R_MPinv_sym */

/* R_MPinv_sym Prototype */

SEXP R_MPinv_sym
(
    SEXP x,
    SEXP n,
    SEXP tol
)

{
    int m;
    SEXP ans, names, MPinv, rank;

    m = INTEGER(n)[0];
    if (m == 0)
        m = (int) (sqrt(0.25 + 2 * LENGTH(x)) - 0.5);

    PROTECT(ans = allocVector(VECSXP, 2));
    PROTECT(names = allocVector(STRSXP, 2));
    SET_VECTOR_ELT(ans, 0, MPinv = allocVector(REALSXP, LENGTH(x)));
    SET_STRING_ELT(names, 0, mkChar("MPinv"));
    SET_VECTOR_ELT(ans, 1, rank = allocVector(INTSXP, 1));
    SET_STRING_ELT(names, 1, mkChar("rank"));
    namesgets(ans, names);

    C_MPinv_sym(REAL(x), m, REAL(tol)[0], REAL(MPinv), INTEGER(rank));

    UNPROTECT(2);
    return(ans);
}

/* R_unpack_sym */

/* R_unpack_sym Prototype */

SEXP R_unpack_sym
(
    SEXP x,
    SEXP names,
    SEXP diagonly
)

{
    R_xlen_t n, k = 0;
    SEXP ans, dimnames;
    double *dx, *dans;

    /* m = n * (n + 1)/2 <=> n^2 + n - 2 * m = 0 */
    n = sqrt(0.25 + 2 * XLENGTH(x)) - 0.5;

    dx = REAL(x);
    if (INTEGER(diagonly)[0]) {
        PROTECT(ans = allocVector(REALSXP, n));
        if (names != R_NilValue) {
            namesgets(ans, names);
        }
        dans = REAL(ans);
        for (R_xlen_t i = 0; i < n; i++) {
            dans[i] = dx[k];
            k += n - i;
        }
    } else {
        PROTECT(ans = allocMatrix(REALSXP, n, n));
        if (names != R_NilValue) {
            PROTECT(dimnames = allocVector(VECSXP, 2));
            SET_VECTOR_ELT(dimnames, 0, names);
            SET_VECTOR_ELT(dimnames, 1, names);
            dimnamesgets(ans, dimnames);
            UNPROTECT(1);
        }
        dans = REAL(ans);
        for (R_xlen_t i = 0; i < n; i++) {
            dans[i * n + i] = dx[k];     /* diagonal */
            k++;
            for (R_xlen_t j = i + 1; j < n; j++) {
                dans[i * n + j] = dx[k]; /* lower triangular */
                dans[j * n + i] = dx[k]; /* upper triangular */
                k++;
            }
        }
    }

    UNPROTECT(1);
    return ans;
}

/* R_pack_sym */

/* R_pack_sym Prototype */

SEXP R_pack_sym
(
    SEXP x
)

{
    R_xlen_t n, k = 0;
    SEXP ans;
    double *dx, *dans;

    n = NROW(x);
    dx = REAL(x);
    PROTECT(ans = allocVector(REALSXP, n * (n + 1) / 2));
    dans = REAL(ans);

    for (R_xlen_t i = 0; i < n; i++) {
        for (R_xlen_t j = i; j < n; j++) {
          dans[k] = dx[i * n + j];
          k++;
        }
    }

    UNPROTECT(1);
    return ans;
}


/* Memory */

/* C_get_P */

int C_get_P
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(INTEGER(VECTOR_ELT(LECV, dim_SLOT))[0]);
}

/* C_get_Q */

int C_get_Q
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(INTEGER(VECTOR_ELT(LECV, dim_SLOT))[1]);
}

/* PP12 */

int PP12
(
    int P
) {
    double dP = (double) P;
    double ans;

    ans = dP * (dP + 1) / 2;

    if (ans > INT_MAX)
        error("cannot allocate memory: number of levels too large");

    return((int) ans);
}

/* mPQB */

int mPQB
(
    int P,
    int Q,
    int B
) {
    double ans = P * Q * B;

    if (ans > INT_MAX)
        error("cannot allocate memory: number of levels too large");

    return((int) ans);
}

/* C_get_varonly */

int C_get_varonly
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(INTEGER(VECTOR_ELT(LECV, varonly_SLOT))[0]);
}

/* C_get_Xfactor */

int C_get_Xfactor
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(INTEGER(VECTOR_ELT(LECV, Xfactor_SLOT))[0]);
}

/* C_get_LinearStatistic */

double* C_get_LinearStatistic
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, LinearStatistic_SLOT)));
}

/* C_get_Expectation */

double* C_get_Expectation
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, Expectation_SLOT)));
}

/* C_get_Variance */

double* C_get_Variance
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    int PQ = C_get_P(LECV) * C_get_Q(LECV);
    double *var, *covar;

    if (isNull(VECTOR_ELT(LECV, Variance_SLOT))) {
        SET_VECTOR_ELT(LECV, Variance_SLOT,
                       allocVector(REALSXP, PQ));
        if (!isNull(VECTOR_ELT(LECV, Covariance_SLOT))) {
            covar = REAL(VECTOR_ELT(LECV, Covariance_SLOT));
            var = REAL(VECTOR_ELT(LECV, Variance_SLOT));
            for (int p = 0; p < PQ; p++)
                var[p] = covar[S(p, p, PQ)];
        }
    }
    return(REAL(VECTOR_ELT(LECV, Variance_SLOT)));
}

/* C_get_Covariance */

double* C_get_Covariance
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    int PQ = C_get_P(LECV) * C_get_Q(LECV);
    if (C_get_varonly(LECV) && PQ > 1)
        error("Cannot extract covariance from variance only object");
    if (C_get_varonly(LECV) && PQ == 1)
        return(C_get_Variance(LECV));
    return(REAL(VECTOR_ELT(LECV, Covariance_SLOT)));
}

/* C_get_ExpectationX */

double* C_get_ExpectationX
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, ExpectationX_SLOT)));
}

/* C_get_ExpectationInfluence */

double* C_get_ExpectationInfluence
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, ExpectationInfluence_SLOT)));
}

/* C_get_CovarianceInfluence */

double* C_get_CovarianceInfluence
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, CovarianceInfluence_SLOT)));
}

/* C_get_VarianceInfluence */

double* C_get_VarianceInfluence
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, VarianceInfluence_SLOT)));
}

/* C_get_TableBlock */

double* C_get_TableBlock
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    if (VECTOR_ELT(LECV, TableBlock_SLOT) == R_NilValue)
        error("object does not contain table block slot");
    return(REAL(VECTOR_ELT(LECV, TableBlock_SLOT)));
}

/* C_get_Sumweights */

double* C_get_Sumweights
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    if (VECTOR_ELT(LECV, Sumweights_SLOT) == R_NilValue)
        error("object does not contain sumweights slot");
    return(REAL(VECTOR_ELT(LECV, Sumweights_SLOT)));
}

/* C_get_Table */

double* C_get_Table
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    if (LENGTH(LECV) <= Table_SLOT)
        error("Cannot extract table from object");
    return(REAL(VECTOR_ELT(LECV, Table_SLOT)));
}

/* C_get_dimTable */

int* C_get_dimTable
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    if (LENGTH(LECV) <= Table_SLOT)
        error("Cannot extract table from object");
    return(INTEGER(getAttrib(VECTOR_ELT(LECV, Table_SLOT),
                             R_DimSymbol)));
}

/* C_get_B */

int C_get_B
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    if (VECTOR_ELT(LECV, TableBlock_SLOT) != R_NilValue)
        return(LENGTH(VECTOR_ELT(LECV, Sumweights_SLOT)));
    return(C_get_dimTable(LECV)[2]);
}

/* C_get_nresample */

R_xlen_t C_get_nresample
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    int PQ = C_get_P(LECV) * C_get_Q(LECV);
    return(XLENGTH(VECTOR_ELT(LECV, PermutedLinearStatistic_SLOT)) / PQ);
}

/* C_get_PermutedLinearStatistic */

double* C_get_PermutedLinearStatistic
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, PermutedLinearStatistic_SLOT)));
}

/* C_get_tol */

double C_get_tol
(
    /* R LECV Input */
    
    SEXP LECV
    
) {
    return(REAL(VECTOR_ELT(LECV, tol_SLOT))[0]);
}

/* RC_init_LECV_1d */

SEXP RC_init_LECV_1d
(
    /* C integer P Input */
    
    int P
    ,
    /* C integer Q Input */
    
    int Q
    ,
    int varonly,
    /* C integer B Input */
    
    int B
    ,
    int Xfactor,
    double tol
) {
    SEXP ans;

    /* R_init_LECV */
    
    SEXP vo, d, names, tolerance, tmp;
    int PQ;

    /* Memory Input Checks */

    if (P <= 0)
        error("P is not positive");

    if (Q <= 0)
        error("Q is not positive");

    if (B <= 0)
        error("B is not positive");

    if (varonly < 0 || varonly > 1)
        error("varonly is not 0 or 1");

    if (Xfactor < 0 || Xfactor > 1)
        error("Xfactor is not 0 or 1");

    if (tol <= DBL_MIN)
        error("tol is not positive");
    
    PQ = mPQB(P, Q, 1);
    /* Memory Names */

    PROTECT(names = allocVector(STRSXP, Table_SLOT + 1));
    SET_STRING_ELT(names, LinearStatistic_SLOT, mkChar("LinearStatistic"));
    SET_STRING_ELT(names, Expectation_SLOT, mkChar("Expectation"));
    SET_STRING_ELT(names, varonly_SLOT, mkChar("varonly"));
    SET_STRING_ELT(names, Variance_SLOT, mkChar("Variance"));
    SET_STRING_ELT(names, Covariance_SLOT, mkChar("Covariance"));
    SET_STRING_ELT(names, ExpectationX_SLOT, mkChar("ExpectationX"));
    SET_STRING_ELT(names, dim_SLOT, mkChar("dimension"));
    SET_STRING_ELT(names, ExpectationInfluence_SLOT,
                   mkChar("ExpectationInfluence"));
    SET_STRING_ELT(names, Xfactor_SLOT, mkChar("Xfactor"));
    SET_STRING_ELT(names, CovarianceInfluence_SLOT,
                   mkChar("CovarianceInfluence"));
    SET_STRING_ELT(names, VarianceInfluence_SLOT,
                   mkChar("VarianceInfluence"));
    SET_STRING_ELT(names, TableBlock_SLOT, mkChar("TableBlock"));
    SET_STRING_ELT(names, Sumweights_SLOT, mkChar("Sumweights"));
    SET_STRING_ELT(names, PermutedLinearStatistic_SLOT,
                   mkChar("PermutedLinearStatistic"));
    SET_STRING_ELT(names, StandardisedPermutedLinearStatistic_SLOT,
                   mkChar("StandardisedPermutedLinearStatistic"));
    SET_STRING_ELT(names, tol_SLOT, mkChar("tol"));
    SET_STRING_ELT(names, Table_SLOT, mkChar("Table"));
    

    /* Table_SLOT is always last and only used in 2d case, ie omitted here */
    PROTECT(ans = allocVector(VECSXP, Table_SLOT + 1));
    SET_VECTOR_ELT(ans, LinearStatistic_SLOT, allocVector(REALSXP, PQ));
    SET_VECTOR_ELT(ans, Expectation_SLOT, allocVector(REALSXP, PQ));
    SET_VECTOR_ELT(ans, varonly_SLOT, vo = allocVector(INTSXP, 1));
    INTEGER(vo)[0] = varonly;
    if (varonly) {
        SET_VECTOR_ELT(ans, Variance_SLOT, tmp = allocVector(REALSXP, PQ));
    } else {
        /* always return variance */
        SET_VECTOR_ELT(ans, Variance_SLOT, tmp = allocVector(REALSXP, PQ));
        SET_VECTOR_ELT(ans, Covariance_SLOT,
                       tmp = allocVector(REALSXP, PP12(PQ)));
    }
    SET_VECTOR_ELT(ans, ExpectationX_SLOT, allocVector(REALSXP, P));
    SET_VECTOR_ELT(ans, dim_SLOT, d = allocVector(INTSXP, 2));
    INTEGER(d)[0] = P;
    INTEGER(d)[1] = Q;
    SET_VECTOR_ELT(ans, ExpectationInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q));
    for (int q = 0; q < B * Q; q++) REAL(tmp)[q] = 0.0;

    /* should always _both_ be there */
    SET_VECTOR_ELT(ans, VarianceInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q));
    for (int q = 0; q < B * Q; q++) REAL(tmp)[q] = 0.0;

    SET_VECTOR_ELT(ans, CovarianceInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q * (Q + 1) / 2));
    for (int q = 0; q < B * Q * (Q + 1) / 2; q++) REAL(tmp)[q] = 0.0;

    SET_VECTOR_ELT(ans, Xfactor_SLOT, allocVector(INTSXP, 1));
    INTEGER(VECTOR_ELT(ans, Xfactor_SLOT))[0] = Xfactor;
    SET_VECTOR_ELT(ans, TableBlock_SLOT, tmp = allocVector(REALSXP, B + 1));
    for (int q = 0; q < B + 1; q++) REAL(tmp)[q] = 0.0;
    SET_VECTOR_ELT(ans, Sumweights_SLOT, allocVector(REALSXP, B));
    SET_VECTOR_ELT(ans, PermutedLinearStatistic_SLOT,
                   allocMatrix(REALSXP, 0, 0));
    SET_VECTOR_ELT(ans, StandardisedPermutedLinearStatistic_SLOT,
                   allocMatrix(REALSXP, 0, 0));
    SET_VECTOR_ELT(ans, tol_SLOT, tolerance = allocVector(REALSXP, 1));
    REAL(tolerance)[0] = tol;
    namesgets(ans, names);

    /* Initialise Zero */

    /* set inital zeros */
    for (int p = 0; p < PQ; p++) {
        C_get_LinearStatistic(ans)[p] = 0.0;
        C_get_Expectation(ans)[p] = 0.0;
        if (varonly)
            C_get_Variance(ans)[p] = 0.0;
    }
    if (!varonly) {
        for (int p = 0; p < PP12(PQ); p++)
            C_get_Covariance(ans)[p] = 0.0;
    }
    for (int q = 0; q < Q; q++) {
        C_get_ExpectationInfluence(ans)[q] = 0.0;
        C_get_VarianceInfluence(ans)[q] = 0.0;
    }
    for (int q = 0; q < Q * (Q + 1) / 2; q++)
        C_get_CovarianceInfluence(ans)[q] = 0.0;
    
    

    SET_VECTOR_ELT(ans, TableBlock_SLOT,
                   allocVector(REALSXP, B + 1));

    SET_VECTOR_ELT(ans, Sumweights_SLOT,
                   allocVector(REALSXP, B));

    UNPROTECT(2);
    return(ans);
}

/* RC_init_LECV_2d */

SEXP RC_init_LECV_2d
(
    /* C integer P Input */
    
    int P
    ,
    /* C integer Q Input */
    
    int Q
    ,
    int varonly,
    int Lx,
    int Ly,
    /* C integer B Input */
    
    int B
    ,
    int Xfactor,
    double tol
) {
    SEXP ans, tabdim, tab;

    if (Lx <= 0)
        error("Lx is not positive");

    if (Ly <= 0)
        error("Ly is not positive");

    /* R_init_LECV */
    
    SEXP vo, d, names, tolerance, tmp;
    int PQ;

    /* Memory Input Checks */

    if (P <= 0)
        error("P is not positive");

    if (Q <= 0)
        error("Q is not positive");

    if (B <= 0)
        error("B is not positive");

    if (varonly < 0 || varonly > 1)
        error("varonly is not 0 or 1");

    if (Xfactor < 0 || Xfactor > 1)
        error("Xfactor is not 0 or 1");

    if (tol <= DBL_MIN)
        error("tol is not positive");
    
    PQ = mPQB(P, Q, 1);
    /* Memory Names */

    PROTECT(names = allocVector(STRSXP, Table_SLOT + 1));
    SET_STRING_ELT(names, LinearStatistic_SLOT, mkChar("LinearStatistic"));
    SET_STRING_ELT(names, Expectation_SLOT, mkChar("Expectation"));
    SET_STRING_ELT(names, varonly_SLOT, mkChar("varonly"));
    SET_STRING_ELT(names, Variance_SLOT, mkChar("Variance"));
    SET_STRING_ELT(names, Covariance_SLOT, mkChar("Covariance"));
    SET_STRING_ELT(names, ExpectationX_SLOT, mkChar("ExpectationX"));
    SET_STRING_ELT(names, dim_SLOT, mkChar("dimension"));
    SET_STRING_ELT(names, ExpectationInfluence_SLOT,
                   mkChar("ExpectationInfluence"));
    SET_STRING_ELT(names, Xfactor_SLOT, mkChar("Xfactor"));
    SET_STRING_ELT(names, CovarianceInfluence_SLOT,
                   mkChar("CovarianceInfluence"));
    SET_STRING_ELT(names, VarianceInfluence_SLOT,
                   mkChar("VarianceInfluence"));
    SET_STRING_ELT(names, TableBlock_SLOT, mkChar("TableBlock"));
    SET_STRING_ELT(names, Sumweights_SLOT, mkChar("Sumweights"));
    SET_STRING_ELT(names, PermutedLinearStatistic_SLOT,
                   mkChar("PermutedLinearStatistic"));
    SET_STRING_ELT(names, StandardisedPermutedLinearStatistic_SLOT,
                   mkChar("StandardisedPermutedLinearStatistic"));
    SET_STRING_ELT(names, tol_SLOT, mkChar("tol"));
    SET_STRING_ELT(names, Table_SLOT, mkChar("Table"));
    

    /* Table_SLOT is always last and only used in 2d case, ie omitted here */
    PROTECT(ans = allocVector(VECSXP, Table_SLOT + 1));
    SET_VECTOR_ELT(ans, LinearStatistic_SLOT, allocVector(REALSXP, PQ));
    SET_VECTOR_ELT(ans, Expectation_SLOT, allocVector(REALSXP, PQ));
    SET_VECTOR_ELT(ans, varonly_SLOT, vo = allocVector(INTSXP, 1));
    INTEGER(vo)[0] = varonly;
    if (varonly) {
        SET_VECTOR_ELT(ans, Variance_SLOT, tmp = allocVector(REALSXP, PQ));
    } else {
        /* always return variance */
        SET_VECTOR_ELT(ans, Variance_SLOT, tmp = allocVector(REALSXP, PQ));
        SET_VECTOR_ELT(ans, Covariance_SLOT,
                       tmp = allocVector(REALSXP, PP12(PQ)));
    }
    SET_VECTOR_ELT(ans, ExpectationX_SLOT, allocVector(REALSXP, P));
    SET_VECTOR_ELT(ans, dim_SLOT, d = allocVector(INTSXP, 2));
    INTEGER(d)[0] = P;
    INTEGER(d)[1] = Q;
    SET_VECTOR_ELT(ans, ExpectationInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q));
    for (int q = 0; q < B * Q; q++) REAL(tmp)[q] = 0.0;

    /* should always _both_ be there */
    SET_VECTOR_ELT(ans, VarianceInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q));
    for (int q = 0; q < B * Q; q++) REAL(tmp)[q] = 0.0;

    SET_VECTOR_ELT(ans, CovarianceInfluence_SLOT,
                   tmp = allocVector(REALSXP, B * Q * (Q + 1) / 2));
    for (int q = 0; q < B * Q * (Q + 1) / 2; q++) REAL(tmp)[q] = 0.0;

    SET_VECTOR_ELT(ans, Xfactor_SLOT, allocVector(INTSXP, 1));
    INTEGER(VECTOR_ELT(ans, Xfactor_SLOT))[0] = Xfactor;
    SET_VECTOR_ELT(ans, TableBlock_SLOT, tmp = allocVector(REALSXP, B + 1));
    for (int q = 0; q < B + 1; q++) REAL(tmp)[q] = 0.0;
    SET_VECTOR_ELT(ans, Sumweights_SLOT, allocVector(REALSXP, B));
    SET_VECTOR_ELT(ans, PermutedLinearStatistic_SLOT,
                   allocMatrix(REALSXP, 0, 0));
    SET_VECTOR_ELT(ans, StandardisedPermutedLinearStatistic_SLOT,
                   allocMatrix(REALSXP, 0, 0));
    SET_VECTOR_ELT(ans, tol_SLOT, tolerance = allocVector(REALSXP, 1));
    REAL(tolerance)[0] = tol;
    namesgets(ans, names);

    /* Initialise Zero */

    /* set inital zeros */
    for (int p = 0; p < PQ; p++) {
        C_get_LinearStatistic(ans)[p] = 0.0;
        C_get_Expectation(ans)[p] = 0.0;
        if (varonly)
            C_get_Variance(ans)[p] = 0.0;
    }
    if (!varonly) {
        for (int p = 0; p < PP12(PQ); p++)
            C_get_Covariance(ans)[p] = 0.0;
    }
    for (int q = 0; q < Q; q++) {
        C_get_ExpectationInfluence(ans)[q] = 0.0;
        C_get_VarianceInfluence(ans)[q] = 0.0;
    }
    for (int q = 0; q < Q * (Q + 1) / 2; q++)
        C_get_CovarianceInfluence(ans)[q] = 0.0;
    
    

    PROTECT(tabdim = allocVector(INTSXP, 3));
    INTEGER(tabdim)[0] = Lx + 1;
    INTEGER(tabdim)[1] = Ly + 1;
    INTEGER(tabdim)[2] = B;
    SET_VECTOR_ELT(ans, Table_SLOT,
                   tab = allocVector(REALSXP,
                       INTEGER(tabdim)[0] *
                       INTEGER(tabdim)[1] *
                       INTEGER(tabdim)[2]));
    dimgets(tab, tabdim);

    UNPROTECT(3);
    return(ans);
}


/* P-Values */

/* C_chisq_pvalue */

/* lower = 1 means p-value, lower = 0 means 1 - p-value */
double C_chisq_pvalue
(
    const double stat,
    const int df,
    const int lower,
    const int give_log
) {
    return(pchisq(stat, (double) df, lower, give_log));
}

/* C_perm_pvalue */

double C_perm_pvalue
(
    const int greater,
    const double nresample,
    const int lower,
    const int give_log
) {
    double ret;

    if (give_log) {
         if (lower) {
             ret = log1p(- (double) greater / nresample);
         } else {
             ret = log(greater) - log(nresample);
         }
    } else {
        if (lower) {
            ret = 1.0 - (double) greater / nresample;
        } else {
            ret = (double) greater / nresample;
        }
    }
    return(ret);
}

/* C_norm_pvalue */

double C_norm_pvalue
(
    const double stat,
    const int alternative,
    const int lower,
    const int give_log
) {
    double ret;

    if (alternative == ALTERNATIVE_less) {
        return(pnorm(stat, 0.0, 1.0, 1 - lower, give_log));
    } else if (alternative == ALTERNATIVE_greater) {
        return(pnorm(stat, 0.0, 1.0, lower, give_log));
    } else if (alternative == ALTERNATIVE_twosided) {
        if (lower) {
            ret = pnorm(fabs(stat)*-1.0, 0.0, 1.0, 1, 0);
            if (give_log) {
                return(log1p(- 2 * ret));
            } else {
                return(1 - 2 * ret);
            }
        } else {
            ret = pnorm(fabs(stat)*-1.0, 0.0, 1.0, 1, give_log);
            if (give_log) {
                return(ret + log(2));
            } else {
                return(2 * ret);
            }
        }
    }
    return(NA_REAL);
}

/* C_maxtype_pvalue */

double C_maxtype_pvalue
(
    const double stat,
    const double *Covariance,
    const int n,
    const int alternative,
    const int lower,
    const int give_log,
    int maxpts, /* const? */
    double releps,
    double abseps,
    double tol
) {
    int nu = 0, inform, i, j, sub, nonzero, *infin, *index, rnd = 0;
    double ans, myerror, *lowerbnd, *upperbnd, *delta, *corr, *sd;

    /* univariate problem */
    if (n == 1)
        return(C_norm_pvalue(stat, alternative, lower, give_log));

    /* Setup mvtnorm Memory */
    
    if (n == 2)
        corr = R_Calloc(1, double);
    else
        corr = R_Calloc(n + ((n - 2) * (n - 1))/2, double);

    sd = R_Calloc(n, double);
    lowerbnd = R_Calloc(n, double);
    upperbnd = R_Calloc(n, double);
    infin = R_Calloc(n, int);
    delta = R_Calloc(n, double);
    index = R_Calloc(n, int);

    /* determine elements with non-zero variance */

    nonzero = 0;
    for (i = 0; i < n; i++) {
        if (Covariance[S(i, i, n)] > tol) {
            index[nonzero] = i;
            nonzero++;
        }
    }
    

    /* Setup mvtnorm Correlation */
    
    for (int nz = 0; nz < nonzero; nz++) {
        /* handle elements with non-zero variance only */
        i = index[nz];

        /* standard deviations */
        sd[i] = sqrt(Covariance[S(i, i, n)]);

        if (alternative == ALTERNATIVE_less) {
            lowerbnd[nz] = stat;
            upperbnd[nz] = R_PosInf;
            infin[nz] = 1;
        } else if (alternative == ALTERNATIVE_greater) {
            lowerbnd[nz] = R_NegInf;
            upperbnd[nz] = stat;
            infin[nz] = 0;
        } else if (alternative == ALTERNATIVE_twosided) {
            lowerbnd[nz] = fabs(stat) * -1.0;
            upperbnd[nz] = fabs(stat);
            infin[nz] = 2;
        }

        delta[nz] = 0.0;

        /* set up vector of correlations, i.e., the upper
           triangular part of the covariance matrix) */
        for (int jz = 0; jz < nz; jz++) {
            j = index[jz];
            sub = (int) (jz + 1) + (double) ((nz - 1) * nz) / 2 - 1;
            if (sd[i] == 0.0 || sd[j] == 0.0)
                corr[sub] = 0.0;
            else
                corr[sub] = Covariance[S(i, j, n)] / (sd[i] * sd[j]);
        }
    }
    

    /* call mvtnorm's mvtdst C function defined in mvtnorm/include/mvtnormAPI.h */
    mvtnorm_C_mvtdst(&nonzero, &nu, lowerbnd, upperbnd, infin, corr, delta,
                     &maxpts, &abseps, &releps, &myerror, &ans, &inform, &rnd);

    /* inform == 0 means: everything is OK */
    switch (inform) {
        case 0: break;
        case 1: warning("cmvnorm: completion with ERROR > EPS"); break;
        case 2: warning("cmvnorm: N > 1000 or N < 1");
                ans = 0.0;
                break;
        case 3: warning("cmvnorm: correlation matrix not positive semi-definite");
                ans = 0.0;
                break;
        default: warning("cmvnorm: unknown problem in MVTDST");
                ans = 0.0;
    }
    R_Free(corr); R_Free(sd); R_Free(lowerbnd); R_Free(upperbnd);
    R_Free(infin); R_Free(delta); R_Free(index);

    /* ans = 1 - p-value */
    if (lower) {
        if (give_log)
            return(log(ans));   /* log(1 - p-value) */
        return(ans);            /* 1 - p-value */
    } else {
        if (give_log)
            return(log1p(ans)); /* log(p-value) */
        return(1 - ans);        /* p-value */
    }
}


/* KronSums */

/* C_KronSums_dweights_dsubset */

void C_KronSums_dweights_dsubset
(
    /* C KronSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    const int SYMMETRIC,
    double *centerx,
    double *centery,
    const int CENTER,
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    double *s, *w;
    /* KronSums Body */
    
        double *xx, *yy, cx = 0.0, cy = 0.0, *thisPQ_ans;
        int idx;

        for (int p = 0; p < P; p++) {
            for (int q = (SYMMETRIC ? p : 0); q < Q; q++) {
                /* SYMMETRIC is column-wise, default
                   is row-wise (maybe need to change this) */
                if (SYMMETRIC) {
                    idx = S(p, q, P);
                } else {
                    idx = q * P + p;
                }
                PQ_ans[idx] = 0.0;
                thisPQ_ans = PQ_ans + idx;
                yy = y + N * q;
                xx = x + N * p;

                if (CENTER) {
                    cx = centerx[p];
                    cy = centery[q];
                }
                /* init subset loop */
                
                R_xlen_t diff = 0;
                s = subset + offset;
                w = weights;
                /* subset is R-style index in 1:N */
                if (Nsubset > 0)
                    diff = (R_xlen_t) s[0] - 1;
                
                /* start subset loop */
                
                for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
                
                {
                    xx = xx + diff;
                    yy = yy + diff;
                    if (HAS_WEIGHTS) {
                        w = w + diff;
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0] * w[0];
                        }
                    } else {
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0];
                        }
                    }
                    /* continue subset loop */
                    
                    if (Nsubset > 0) {
                        /* NB: diff also works with R style index */
                        diff = (R_xlen_t) s[1] - s[0];
                        if (diff < 0)
                            error("subset not sorted");
                        s++;
                    } else {
                        diff = 1;
                    }
                    
                }
                xx = xx + diff;
                yy = yy + diff;
                if (HAS_WEIGHTS) {
                    w = w + diff;
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                } else {
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                }
            }
        }
    
}

/* C_KronSums_iweights_dsubset */

void C_KronSums_iweights_dsubset
(
    /* C KronSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    const int SYMMETRIC,
    double *centerx,
    double *centery,
    const int CENTER,
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    double *s;
    int *w;
    /* KronSums Body */
    
        double *xx, *yy, cx = 0.0, cy = 0.0, *thisPQ_ans;
        int idx;

        for (int p = 0; p < P; p++) {
            for (int q = (SYMMETRIC ? p : 0); q < Q; q++) {
                /* SYMMETRIC is column-wise, default
                   is row-wise (maybe need to change this) */
                if (SYMMETRIC) {
                    idx = S(p, q, P);
                } else {
                    idx = q * P + p;
                }
                PQ_ans[idx] = 0.0;
                thisPQ_ans = PQ_ans + idx;
                yy = y + N * q;
                xx = x + N * p;

                if (CENTER) {
                    cx = centerx[p];
                    cy = centery[q];
                }
                /* init subset loop */
                
                R_xlen_t diff = 0;
                s = subset + offset;
                w = weights;
                /* subset is R-style index in 1:N */
                if (Nsubset > 0)
                    diff = (R_xlen_t) s[0] - 1;
                
                /* start subset loop */
                
                for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
                
                {
                    xx = xx + diff;
                    yy = yy + diff;
                    if (HAS_WEIGHTS) {
                        w = w + diff;
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0] * w[0];
                        }
                    } else {
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0];
                        }
                    }
                    /* continue subset loop */
                    
                    if (Nsubset > 0) {
                        /* NB: diff also works with R style index */
                        diff = (R_xlen_t) s[1] - s[0];
                        if (diff < 0)
                            error("subset not sorted");
                        s++;
                    } else {
                        diff = 1;
                    }
                    
                }
                xx = xx + diff;
                yy = yy + diff;
                if (HAS_WEIGHTS) {
                    w = w + diff;
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                } else {
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                }
            }
        }
    
}

/* C_KronSums_iweights_isubset */

void C_KronSums_iweights_isubset
(
    /* C KronSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    const int SYMMETRIC,
    double *centerx,
    double *centery,
    const int CENTER,
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    int *s, *w;
    /* KronSums Body */
    
        double *xx, *yy, cx = 0.0, cy = 0.0, *thisPQ_ans;
        int idx;

        for (int p = 0; p < P; p++) {
            for (int q = (SYMMETRIC ? p : 0); q < Q; q++) {
                /* SYMMETRIC is column-wise, default
                   is row-wise (maybe need to change this) */
                if (SYMMETRIC) {
                    idx = S(p, q, P);
                } else {
                    idx = q * P + p;
                }
                PQ_ans[idx] = 0.0;
                thisPQ_ans = PQ_ans + idx;
                yy = y + N * q;
                xx = x + N * p;

                if (CENTER) {
                    cx = centerx[p];
                    cy = centery[q];
                }
                /* init subset loop */
                
                R_xlen_t diff = 0;
                s = subset + offset;
                w = weights;
                /* subset is R-style index in 1:N */
                if (Nsubset > 0)
                    diff = (R_xlen_t) s[0] - 1;
                
                /* start subset loop */
                
                for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
                
                {
                    xx = xx + diff;
                    yy = yy + diff;
                    if (HAS_WEIGHTS) {
                        w = w + diff;
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0] * w[0];
                        }
                    } else {
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0];
                        }
                    }
                    /* continue subset loop */
                    
                    if (Nsubset > 0) {
                        /* NB: diff also works with R style index */
                        diff = (R_xlen_t) s[1] - s[0];
                        if (diff < 0)
                            error("subset not sorted");
                        s++;
                    } else {
                        diff = 1;
                    }
                    
                }
                xx = xx + diff;
                yy = yy + diff;
                if (HAS_WEIGHTS) {
                    w = w + diff;
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                } else {
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                }
            }
        }
    
}

/* C_KronSums_dweights_isubset */

void C_KronSums_dweights_isubset
(
    /* C KronSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    const int SYMMETRIC,
    double *centerx,
    double *centery,
    const int CENTER,
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    int *s;
    double *w;
    /* KronSums Body */
    
        double *xx, *yy, cx = 0.0, cy = 0.0, *thisPQ_ans;
        int idx;

        for (int p = 0; p < P; p++) {
            for (int q = (SYMMETRIC ? p : 0); q < Q; q++) {
                /* SYMMETRIC is column-wise, default
                   is row-wise (maybe need to change this) */
                if (SYMMETRIC) {
                    idx = S(p, q, P);
                } else {
                    idx = q * P + p;
                }
                PQ_ans[idx] = 0.0;
                thisPQ_ans = PQ_ans + idx;
                yy = y + N * q;
                xx = x + N * p;

                if (CENTER) {
                    cx = centerx[p];
                    cy = centery[q];
                }
                /* init subset loop */
                
                R_xlen_t diff = 0;
                s = subset + offset;
                w = weights;
                /* subset is R-style index in 1:N */
                if (Nsubset > 0)
                    diff = (R_xlen_t) s[0] - 1;
                
                /* start subset loop */
                
                for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
                
                {
                    xx = xx + diff;
                    yy = yy + diff;
                    if (HAS_WEIGHTS) {
                        w = w + diff;
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0] * w[0];
                        }
                    } else {
                        if (CENTER) {
                            thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                        } else {
                            thisPQ_ans[0] += xx[0] * yy[0];
                        }
                    }
                    /* continue subset loop */
                    
                    if (Nsubset > 0) {
                        /* NB: diff also works with R style index */
                        diff = (R_xlen_t) s[1] - s[0];
                        if (diff < 0)
                            error("subset not sorted");
                        s++;
                    } else {
                        diff = 1;
                    }
                    
                }
                xx = xx + diff;
                yy = yy + diff;
                if (HAS_WEIGHTS) {
                    w = w + diff;
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy) * w[0];
                } else {
                    thisPQ_ans[0] += (xx[0] - cx) * (yy[0] - cy);
                }
            }
        }
    
}

/* C_XfactorKronSums_dweights_dsubset */

void C_XfactorKronSums_dweights_dsubset
(
    /* C XfactorKronSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    double *s, *w;
    /* XfactorKronSums Body */
    
    int *xx, ixi;
    double *yy;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        yy = y + N * q;
        xx = x;
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            yy = yy + diff;
            ixi = xx[0] - 1;
            if (HAS_WEIGHTS) {
                w = w + diff;
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0] * w[0];
            } else {
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0];
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        yy = yy + diff;
        ixi = xx[0] - 1;
        if (HAS_WEIGHTS) {
            w = w + diff;
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0] * w[0];
        } else {
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0];
        }
    }
    
}

/* C_XfactorKronSums_iweights_dsubset */

void C_XfactorKronSums_iweights_dsubset
(
    /* C XfactorKronSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    double *s;
    int *w;
    /* XfactorKronSums Body */
    
    int *xx, ixi;
    double *yy;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        yy = y + N * q;
        xx = x;
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            yy = yy + diff;
            ixi = xx[0] - 1;
            if (HAS_WEIGHTS) {
                w = w + diff;
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0] * w[0];
            } else {
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0];
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        yy = yy + diff;
        ixi = xx[0] - 1;
        if (HAS_WEIGHTS) {
            w = w + diff;
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0] * w[0];
        } else {
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0];
        }
    }
    
}

/* C_XfactorKronSums_iweights_isubset */

void C_XfactorKronSums_iweights_isubset
(
    /* C XfactorKronSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    int *s, *w;
    /* XfactorKronSums Body */
    
    int *xx, ixi;
    double *yy;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        yy = y + N * q;
        xx = x;
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            yy = yy + diff;
            ixi = xx[0] - 1;
            if (HAS_WEIGHTS) {
                w = w + diff;
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0] * w[0];
            } else {
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0];
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        yy = yy + diff;
        ixi = xx[0] - 1;
        if (HAS_WEIGHTS) {
            w = w + diff;
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0] * w[0];
        } else {
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0];
        }
    }
    
}

/* C_XfactorKronSums_dweights_isubset */

void C_XfactorKronSums_dweights_isubset
(
    /* C XfactorKronSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    int *s;
    double *w;
    /* XfactorKronSums Body */
    
    int *xx, ixi;
    double *yy;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        yy = y + N * q;
        xx = x;
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            yy = yy + diff;
            ixi = xx[0] - 1;
            if (HAS_WEIGHTS) {
                w = w + diff;
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0] * w[0];
            } else {
                if (ixi >= 0)
                    PQ_ans[ixi + q * P] += yy[0];
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        yy = yy + diff;
        ixi = xx[0] - 1;
        if (HAS_WEIGHTS) {
            w = w + diff;
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0] * w[0];
        } else {
            if (ixi >= 0)
                PQ_ans[ixi + q * P] += yy[0];
        }
    }
    
}

/* RC_KronSums */

/* RC_KronSums Prototype */

void RC_KronSums
(
    /* RC KronSums Input */
    
    /* R x Input */

    SEXP x,
    
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    /* C real y Input */

    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    const int SYMMETRIC,
    double *centerx,
    double *centery,
    const int CENTER,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
)

{
    if (TYPEOF(x) == INTSXP) {
        /* KronSums Integer x */
        
        if (SYMMETRIC) error("not implemented");
        if (CENTER) error("not implemented");
        if (TYPEOF(weights) == INTSXP) {
            if (TYPEOF(subset) == INTSXP) {
                C_XfactorKronSums_iweights_isubset(INTEGER(x), N, P, y, Q,
                    INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                    offset, Nsubset, PQ_ans);
            } else {
                C_XfactorKronSums_iweights_dsubset(INTEGER(x), N, P, y, Q,
                    INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                    offset, Nsubset, PQ_ans);
            }
        } else {
            if (TYPEOF(subset) == INTSXP) {
                C_XfactorKronSums_dweights_isubset(INTEGER(x), N, P, y, Q,
                    REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                    offset, Nsubset, PQ_ans);
            } else {
                C_XfactorKronSums_dweights_dsubset(INTEGER(x), N, P, y, Q,
                    REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                    offset, Nsubset, PQ_ans);
            }
        }
        
    } else {
        /* KronSums Double x */
        
        if (TYPEOF(weights) == INTSXP) {
            if (TYPEOF(subset) == INTSXP) {
                C_KronSums_iweights_isubset(REAL(x), N, P, y, Q, SYMMETRIC, centerx, centery, CENTER,
                    INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                    offset, Nsubset, PQ_ans);
            } else {
                C_KronSums_iweights_dsubset(REAL(x), N, P, y, Q, SYMMETRIC, centerx, centery, CENTER,
                    INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                    offset, Nsubset, PQ_ans);
            }
        } else {
            if (TYPEOF(subset) == INTSXP) {
                C_KronSums_dweights_isubset(REAL(x), N, P, y, Q, SYMMETRIC, centerx, centery, CENTER,
                    REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                    offset, Nsubset, PQ_ans);
            } else {
                C_KronSums_dweights_dsubset(REAL(x), N, P, y, Q, SYMMETRIC, centerx, centery, CENTER,
                    REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                    offset, Nsubset, PQ_ans);
            }
        }
        
    }
}

/* R_KronSums */

/* R_KronSums Prototype */

SEXP R_KronSums
(
    /* R x Input */
    
    SEXP x,
    
    SEXP P,
    /* R y Input */
    
    SEXP y,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    SEXP symmetric
)

{
    SEXP ans;
    /* C integer Q Input */
    
    int Q
    ;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;

    double center;

    Q = NCOL(y);
    N = XLENGTH(y) / Q;
    Nsubset = XLENGTH(subset);

    if (INTEGER(symmetric)[0]) {
        PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0] * (INTEGER(P)[0] + 1) / 2));
    } else {
        PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0] * Q));
    }
    RC_KronSums(x, N, INTEGER(P)[0], REAL(y), Q, INTEGER(symmetric)[0], &center, &center,
                !DoCenter, weights, subset, Offset0, Nsubset, REAL(ans));
    UNPROTECT(1);
    return(ans);
}

/* C_KronSums_Permutation_isubset */

void C_KronSums_Permutation_isubset
(
    /* C real x Input */
    
    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    int *subsety,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    /* KronSums Permutation Body */
    
    R_xlen_t qP, qN, pN, qPp;

    for (int q = 0; q < Q; q++) {
        qN = q * N;
        qP = q * P;
        for (int p = 0; p < P; p++) {
            qPp = qP + p;
            PQ_ans[qPp] = 0.0;
            pN = p * N;
            for (R_xlen_t i = offset; i < Nsubset; i++)
                PQ_ans[qPp] += y[qN + (R_xlen_t) subsety[i] - 1] *
                               x[pN + (R_xlen_t) subset[i] - 1];
        }
    }
    
}

/* C_KronSums_Permutation_dsubset */

void C_KronSums_Permutation_dsubset
(
    /* C real x Input */
    
    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    double *subsety,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    /* KronSums Permutation Body */
    
    R_xlen_t qP, qN, pN, qPp;

    for (int q = 0; q < Q; q++) {
        qN = q * N;
        qP = q * P;
        for (int p = 0; p < P; p++) {
            qPp = qP + p;
            PQ_ans[qPp] = 0.0;
            pN = p * N;
            for (R_xlen_t i = offset; i < Nsubset; i++)
                PQ_ans[qPp] += y[qN + (R_xlen_t) subsety[i] - 1] *
                               x[pN + (R_xlen_t) subset[i] - 1];
        }
    }
    
}

/* C_XfactorKronSums_Permutation_isubset */

void C_XfactorKronSums_Permutation_isubset
(
    /* C integer x Input */
    
    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    int *subsety,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    /* XfactorKronSums Permutation Body */
    
    R_xlen_t qP, qN;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        qP = q * P;
        qN = q * N;
        for (R_xlen_t i = offset; i < Nsubset; i++)
            PQ_ans[x[(R_xlen_t) subset[i] - 1] - 1 + qP] += y[qN + (R_xlen_t) subsety[i] - 1];
    }
    
}

/* C_XfactorKronSums_Permutation_dsubset */

void C_XfactorKronSums_Permutation_dsubset
(
    /* C integer x Input */
    
    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    double *subsety,
    /* C KronSums Answer */
    
    double *PQ_ans
    
) {
    /* XfactorKronSums Permutation Body */
    
    R_xlen_t qP, qN;

    for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int q = 0; q < Q; q++) {
        qP = q * P;
        qN = q * N;
        for (R_xlen_t i = offset; i < Nsubset; i++)
            PQ_ans[x[(R_xlen_t) subset[i] - 1] - 1 + qP] += y[qN + (R_xlen_t) subsety[i] - 1];
    }
    
}

/* RC_KronSums_Permutation */

/* RC_KronSums_Permutation Prototype */

void RC_KronSums_Permutation
(
    /* R x Input */
    
    SEXP x,
    
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer P Input */
    
    int P
    ,
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    SEXP subsety,
    /* C KronSums Answer */
    
    double *PQ_ans
    
)

{
    if (TYPEOF(x) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            C_XfactorKronSums_Permutation_isubset(INTEGER(x), N, P, y, Q,
                                                  INTEGER(subset), offset, Nsubset,
                                                  INTEGER(subsety), PQ_ans);
        } else {
            C_XfactorKronSums_Permutation_dsubset(INTEGER(x), N, P, y, Q,
                                                  REAL(subset), offset, Nsubset,
                                                  REAL(subsety), PQ_ans);
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            C_KronSums_Permutation_isubset(REAL(x), N, P, y, Q,
                                           INTEGER(subset), offset, Nsubset,
                                           INTEGER(subsety), PQ_ans);
        } else {
            C_KronSums_Permutation_dsubset(REAL(x), N, P, y, Q,
                                           REAL(subset), offset, Nsubset,
                                           REAL(subsety), PQ_ans);
        }
    }
}

/* R_KronSums_Permutation */

/* R_KronSums_Permutation Prototype */

SEXP R_KronSums_Permutation
(
    /* R x Input */
    
    SEXP x,
    
    SEXP P,
    /* R y Input */
    
    SEXP y,
    
    /* R subset Input */
    
    SEXP subset
    ,
    SEXP subsety
)

{
    SEXP ans;
    /* C integer Q Input */
    
    int Q
    ;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;

    Q = NCOL(y);
    N = XLENGTH(y) / Q;
    Nsubset = XLENGTH(subset);

    PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0] * Q));
    RC_KronSums_Permutation(x, N, INTEGER(P)[0], REAL(y), Q, subset, Offset0, Nsubset,
                            subsety, REAL(ans));
    UNPROTECT(1);
    return(ans);
}


/* colSums */

/* C_colSums_dweights_dsubset */

void C_colSums_dweights_dsubset
(
    /* C colSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    const int power,
    double *centerx,
    const int CENTER,
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C colSums Answer */
    
    double *P_ans
    
) {
    double *s, *w;
    /* colSums Body */
    
    double *xx, cx = 0.0;

    for (int p = 0; p < P; p++) {
        P_ans[0] = 0.0;
        xx = x + N * p;
        if (CENTER) {
            cx = centerx[p];
        }
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            if (HAS_WEIGHTS) {
                w = w + diff;
                P_ans[0] += pow(xx[0] - cx, power) * w[0];
            } else {
                P_ans[0] += pow(xx[0] - cx, power);
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[0] += pow(xx[0] - cx, power) * w[0];
        } else {
            P_ans[0] += pow(xx[0] - cx, power);
        }
        P_ans++;
    }
    
}

/* C_colSums_iweights_dsubset */

void C_colSums_iweights_dsubset
(
    /* C colSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    const int power,
    double *centerx,
    const int CENTER,
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C colSums Answer */
    
    double *P_ans
    
) {
    double *s;
    int *w;
    /* colSums Body */
    
    double *xx, cx = 0.0;

    for (int p = 0; p < P; p++) {
        P_ans[0] = 0.0;
        xx = x + N * p;
        if (CENTER) {
            cx = centerx[p];
        }
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            if (HAS_WEIGHTS) {
                w = w + diff;
                P_ans[0] += pow(xx[0] - cx, power) * w[0];
            } else {
                P_ans[0] += pow(xx[0] - cx, power);
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[0] += pow(xx[0] - cx, power) * w[0];
        } else {
            P_ans[0] += pow(xx[0] - cx, power);
        }
        P_ans++;
    }
    
}

/* C_colSums_iweights_isubset */

void C_colSums_iweights_isubset
(
    /* C colSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    const int power,
    double *centerx,
    const int CENTER,
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C colSums Answer */
    
    double *P_ans
    
) {
    int *s, *w;
    /* colSums Body */
    
    double *xx, cx = 0.0;

    for (int p = 0; p < P; p++) {
        P_ans[0] = 0.0;
        xx = x + N * p;
        if (CENTER) {
            cx = centerx[p];
        }
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            if (HAS_WEIGHTS) {
                w = w + diff;
                P_ans[0] += pow(xx[0] - cx, power) * w[0];
            } else {
                P_ans[0] += pow(xx[0] - cx, power);
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[0] += pow(xx[0] - cx, power) * w[0];
        } else {
            P_ans[0] += pow(xx[0] - cx, power);
        }
        P_ans++;
    }
    
}

/* C_colSums_dweights_isubset */

void C_colSums_dweights_isubset
(
    /* C colSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    const int power,
    double *centerx,
    const int CENTER,
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C colSums Answer */
    
    double *P_ans
    
) {
    int *s;
    double *w;
    /* colSums Body */
    
    double *xx, cx = 0.0;

    for (int p = 0; p < P; p++) {
        P_ans[0] = 0.0;
        xx = x + N * p;
        if (CENTER) {
            cx = centerx[p];
        }
        /* init subset loop */
        
        R_xlen_t diff = 0;
        s = subset + offset;
        w = weights;
        /* subset is R-style index in 1:N */
        if (Nsubset > 0)
            diff = (R_xlen_t) s[0] - 1;
        
        /* start subset loop */
        
        for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
        
        {
            xx = xx + diff;
            if (HAS_WEIGHTS) {
                w = w + diff;
                P_ans[0] += pow(xx[0] - cx, power) * w[0];
            } else {
                P_ans[0] += pow(xx[0] - cx, power);
            }
            /* continue subset loop */
            
            if (Nsubset > 0) {
                /* NB: diff also works with R style index */
                diff = (R_xlen_t) s[1] - s[0];
                if (diff < 0)
                    error("subset not sorted");
                s++;
            } else {
                diff = 1;
            }
            
        }
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[0] += pow(xx[0] - cx, power) * w[0];
        } else {
            P_ans[0] += pow(xx[0] - cx, power);
        }
        P_ans++;
    }
    
}

/* RC_colSums */

/* RC_colSums Prototype */

void RC_colSums
(
    /* C colSums Input */
    
    /* C real x Input */

    double *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    const int power,
    double *centerx,
    const int CENTER,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C colSums Answer */
    
    double *P_ans
    
)

{
    if (TYPEOF(weights) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            C_colSums_iweights_isubset(x, N, P, power, centerx, CENTER,
                                       INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                       offset, Nsubset, P_ans);
        } else {
            C_colSums_iweights_dsubset(x, N, P, power, centerx, CENTER,
                                       INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                                       offset, Nsubset, P_ans);
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            C_colSums_dweights_isubset(x, N, P, power, centerx, CENTER,
                                       REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                       offset, Nsubset, P_ans);
        } else {
            C_colSums_dweights_dsubset(x, N, P, power, centerx, CENTER,
                                       REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                                       offset, Nsubset, P_ans);
        }
    }
}

/* R_colSums */

/* R_colSums Prototype */

SEXP R_colSums
(
    /* R x Input */
    
    SEXP x,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans;
    int P;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    double center;

    P = NCOL(x);
    N = XLENGTH(x) / P;
    Nsubset = XLENGTH(subset);

    PROTECT(ans = allocVector(REALSXP, P));
    RC_colSums(REAL(x), N, P, Power1, &center, !DoCenter, weights, subset, Offset0,
               Nsubset, REAL(ans));
    UNPROTECT(1);
    return(ans);
}


/* SimpleSums */

/* C_Sums_dweights_dsubset */

double C_Sums_dweights_dsubset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    
) {
    double *s, *w;
    /* Sums Body */
    
    double ans = 0.0;

    if (Nsubset > 0) {
        if (!HAS_WEIGHTS) return((double) Nsubset);
    } else {
        if (!HAS_WEIGHTS) return((double) N);
    }

    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        w = w + diff;
        ans += w[0];
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    w = w + diff;
    ans += w[0];

    return(ans);
    
}

/* C_Sums_iweights_dsubset */

double C_Sums_iweights_dsubset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    
) {
    double *s;
    int *w;
    /* Sums Body */
    
    double ans = 0.0;

    if (Nsubset > 0) {
        if (!HAS_WEIGHTS) return((double) Nsubset);
    } else {
        if (!HAS_WEIGHTS) return((double) N);
    }

    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        w = w + diff;
        ans += w[0];
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    w = w + diff;
    ans += w[0];

    return(ans);
    
}

/* C_Sums_iweights_isubset */

double C_Sums_iweights_isubset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    
) {
    int *s, *w;
    /* Sums Body */
    
    double ans = 0.0;

    if (Nsubset > 0) {
        if (!HAS_WEIGHTS) return((double) Nsubset);
    } else {
        if (!HAS_WEIGHTS) return((double) N);
    }

    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        w = w + diff;
        ans += w[0];
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    w = w + diff;
    ans += w[0];

    return(ans);
    
}

/* C_Sums_dweights_isubset */

double C_Sums_dweights_isubset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    
) {
    int *s;
    double *w;
    /* Sums Body */
    
    double ans = 0.0;

    if (Nsubset > 0) {
        if (!HAS_WEIGHTS) return((double) Nsubset);
    } else {
        if (!HAS_WEIGHTS) return((double) N);
    }

    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        w = w + diff;
        ans += w[0];
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    w = w + diff;
    ans += w[0];

    return(ans);
    
}

/* RC_Sums */

/* RC_Sums Prototype */

double RC_Sums
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
)

{
    if (XLENGTH(weights) == 0) {
        if (XLENGTH(subset) == 0) {
            return((double) N);
        } else {
            return((double) Nsubset);
        }
    }
    if (TYPEOF(weights) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            return(C_Sums_iweights_isubset(N, INTEGER(weights), XLENGTH(weights),
                                           INTEGER(subset), offset, Nsubset));
        } else {
            return(C_Sums_iweights_dsubset(N, INTEGER(weights), XLENGTH(weights),
                                           REAL(subset), offset, Nsubset));
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            return(C_Sums_dweights_isubset(N, REAL(weights), XLENGTH(weights),
                                           INTEGER(subset), offset, Nsubset));
        } else {
            return(C_Sums_dweights_dsubset(N, REAL(weights), XLENGTH(weights),
                                           REAL(subset), offset, Nsubset));
        }
    }
}

/* R_Sums */

/* R_Sums Prototype */

SEXP R_Sums
(
    /* R N Input */
    
    SEXP N,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;

    Nsubset = XLENGTH(subset);

    PROTECT(ans = allocVector(REALSXP, 1));
    REAL(ans)[0] = RC_Sums(INTEGER(N)[0], weights, subset, Offset0, Nsubset);
    UNPROTECT(1);

    return(ans);
}


/* Tables */

/* C_OneTableSums_dweights_dsubset */

void C_OneTableSums_dweights_dsubset
(
    /* C OneTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
) {
    double *s, *w;
    /* OneTableSums Body */
    
    int *xx;

    for (int p = 0; p < P; p++) P_ans[p] = 0.0;

    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[xx[0]] += (double) w[0];
        } else {
            P_ans[xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        P_ans[xx[0]] += w[0];
    } else {
        P_ans[xx[0]]++;
    }
    
}

/* C_OneTableSums_iweights_dsubset */

void C_OneTableSums_iweights_dsubset
(
    /* C OneTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
) {
    double *s;
    int *w;
    /* OneTableSums Body */
    
    int *xx;

    for (int p = 0; p < P; p++) P_ans[p] = 0.0;

    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[xx[0]] += (double) w[0];
        } else {
            P_ans[xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        P_ans[xx[0]] += w[0];
    } else {
        P_ans[xx[0]]++;
    }
    
}

/* C_OneTableSums_iweights_isubset */

void C_OneTableSums_iweights_isubset
(
    /* C OneTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
) {
    int *s, *w;
    /* OneTableSums Body */
    
    int *xx;

    for (int p = 0; p < P; p++) P_ans[p] = 0.0;

    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[xx[0]] += (double) w[0];
        } else {
            P_ans[xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        P_ans[xx[0]] += w[0];
    } else {
        P_ans[xx[0]]++;
    }
    
}

/* C_OneTableSums_dweights_isubset */

void C_OneTableSums_dweights_isubset
(
    /* C OneTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
) {
    int *s;
    double *w;
    /* OneTableSums Body */
    
    int *xx;

    for (int p = 0; p < P; p++) P_ans[p] = 0.0;

    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            P_ans[xx[0]] += (double) w[0];
        } else {
            P_ans[xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        P_ans[xx[0]] += w[0];
    } else {
        P_ans[xx[0]]++;
    }
    
}

/* RC_OneTableSums */

/* RC_OneTableSums Prototype */

void RC_OneTableSums
(
    /* C OneTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
)

{
    if (TYPEOF(weights) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            C_OneTableSums_iweights_isubset(x, N, P,
                                        INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, P_ans);
        } else {
            C_OneTableSums_iweights_dsubset(x, N, P,
                                        INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, P_ans);
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            C_OneTableSums_dweights_isubset(x, N, P,
                                        REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, P_ans);
        } else {
            C_OneTableSums_dweights_dsubset(x, N, P,
                                        REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, P_ans);
        }
    }
}

/* R_OneTableSums */

/* R_OneTableSums Prototype */

SEXP R_OneTableSums
(
    /* R x Input */
    
    SEXP x,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    int P;

    N = XLENGTH(x);
    Nsubset = XLENGTH(subset);
    P = NLEVELS(x) + 1;

    PROTECT(ans = allocVector(REALSXP, P));
    RC_OneTableSums(INTEGER(x), N, P, weights, subset,
                    Offset0, Nsubset, REAL(ans));
    UNPROTECT(1);
    return(ans);
}

/* C_TwoTableSums_dweights_dsubset */

void C_TwoTableSums_dweights_dsubset
(
    /* C TwoTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C TwoTableSums Answer */
    
    double *PQ_ans
    
) {
    double *s, *w;
    /* TwoTableSums Body */
    
    int *xx, *yy;

    for (int p = 0; p < Q * P; p++) PQ_ans[p] = 0.0;

    yy = y;
    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQ_ans[yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQ_ans[yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQ_ans[yy[0] * P + xx[0]] += w[0];
    } else {
        PQ_ans[yy[0] * P + xx[0]]++;
    }
    
}

/* C_TwoTableSums_iweights_dsubset */

void C_TwoTableSums_iweights_dsubset
(
    /* C TwoTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C TwoTableSums Answer */
    
    double *PQ_ans
    
) {
    double *s;
    int *w;
    /* TwoTableSums Body */
    
    int *xx, *yy;

    for (int p = 0; p < Q * P; p++) PQ_ans[p] = 0.0;

    yy = y;
    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQ_ans[yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQ_ans[yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQ_ans[yy[0] * P + xx[0]] += w[0];
    } else {
        PQ_ans[yy[0] * P + xx[0]]++;
    }
    
}

/* C_TwoTableSums_iweights_isubset */

void C_TwoTableSums_iweights_isubset
(
    /* C TwoTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C TwoTableSums Answer */
    
    double *PQ_ans
    
) {
    int *s, *w;
    /* TwoTableSums Body */
    
    int *xx, *yy;

    for (int p = 0; p < Q * P; p++) PQ_ans[p] = 0.0;

    yy = y;
    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQ_ans[yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQ_ans[yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQ_ans[yy[0] * P + xx[0]] += w[0];
    } else {
        PQ_ans[yy[0] * P + xx[0]]++;
    }
    
}

/* C_TwoTableSums_dweights_isubset */

void C_TwoTableSums_dweights_isubset
(
    /* C TwoTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C TwoTableSums Answer */
    
    double *PQ_ans
    
) {
    int *s;
    double *w;
    /* TwoTableSums Body */
    
    int *xx, *yy;

    for (int p = 0; p < Q * P; p++) PQ_ans[p] = 0.0;

    yy = y;
    xx = x;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQ_ans[yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQ_ans[yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQ_ans[yy[0] * P + xx[0]] += w[0];
    } else {
        PQ_ans[yy[0] * P + xx[0]]++;
    }
    
}

/* RC_TwoTableSums */

/* RC_TwoTableSums Prototype */

void RC_TwoTableSums
(
    /* C TwoTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C TwoTableSums Answer */
    
    double *PQ_ans
    
)

{
    if (TYPEOF(weights) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            C_TwoTableSums_iweights_isubset(x, N, P, y, Q,
                                        INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, PQ_ans);
        } else {
            C_TwoTableSums_iweights_dsubset(x, N, P, y, Q,
                                        INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, PQ_ans);
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            C_TwoTableSums_dweights_isubset(x, N, P, y, Q,
                                        REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, PQ_ans);
        } else {
            C_TwoTableSums_dweights_dsubset(x, N, P, y, Q,
                                        REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, PQ_ans);
        }
    }
}

/* R_TwoTableSums */

/* R_TwoTableSums Prototype */

SEXP R_TwoTableSums
(
    /* R x Input */
    
    SEXP x,
    
    /* R y Input */
    
    SEXP y,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans, dim;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    int P, Q;

    N = XLENGTH(x);
    Nsubset = XLENGTH(subset);
    P = NLEVELS(x) + 1;
    Q = NLEVELS(y) + 1;

    PROTECT(ans = allocVector(REALSXP, mPQB(P, Q, 1)));
    PROTECT(dim = allocVector(INTSXP, 2));
    INTEGER(dim)[0] = P;
    INTEGER(dim)[1] = Q;
    dimgets(ans, dim);
    RC_TwoTableSums(INTEGER(x), N, P, INTEGER(y), Q,
                    weights, subset, Offset0, Nsubset, REAL(ans));
    UNPROTECT(2);
    return(ans);
}

/* C_ThreeTableSums_dweights_dsubset */

void C_ThreeTableSums_dweights_dsubset
(
    /* C ThreeTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer block Input */

    int *block,
    /* C integer B Input */

    int B
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C ThreeTableSums Answer */
    
    double *PQL_ans
    
) {
    double *s, *w;
    /* ThreeTableSums Body */
    
    int *xx, *yy, *bb, PQ = mPQB(P, Q, 1);

    for (int p = 0; p < PQ * B; p++) PQL_ans[p] = 0.0;

    yy = y;
    xx = x;
    bb = block;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        bb = bb + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    bb = bb + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += w[0];
    } else {
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
    }
    
}

/* C_ThreeTableSums_iweights_dsubset */

void C_ThreeTableSums_iweights_dsubset
(
    /* C ThreeTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer block Input */

    int *block,
    /* C integer B Input */

    int B
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C real subset Input */
    
    double *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C ThreeTableSums Answer */
    
    double *PQL_ans
    
) {
    double *s;
    int *w;
    /* ThreeTableSums Body */
    
    int *xx, *yy, *bb, PQ = mPQB(P, Q, 1);

    for (int p = 0; p < PQ * B; p++) PQL_ans[p] = 0.0;

    yy = y;
    xx = x;
    bb = block;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        bb = bb + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    bb = bb + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += w[0];
    } else {
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
    }
    
}

/* C_ThreeTableSums_iweights_isubset */

void C_ThreeTableSums_iweights_isubset
(
    /* C ThreeTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer block Input */

    int *block,
    /* C integer B Input */

    int B
    ,
    
    
    /* C integer weights Input */
    
    int *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C ThreeTableSums Answer */
    
    double *PQL_ans
    
) {
    int *s, *w;
    /* ThreeTableSums Body */
    
    int *xx, *yy, *bb, PQ = mPQB(P, Q, 1);

    for (int p = 0; p < PQ * B; p++) PQL_ans[p] = 0.0;

    yy = y;
    xx = x;
    bb = block;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        bb = bb + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    bb = bb + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += w[0];
    } else {
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
    }
    
}

/* C_ThreeTableSums_dweights_isubset */

void C_ThreeTableSums_dweights_isubset
(
    /* C ThreeTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer block Input */

    int *block,
    /* C integer B Input */

    int B
    ,
    
    
    /* C real weights Input */
    
    double *weights,
    int HAS_WEIGHTS,
    
    /* C integer subset Input */
    
    int *subset,
    /* C subset range Input */

    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    
    ,
    /* C ThreeTableSums Answer */
    
    double *PQL_ans
    
) {
    int *s;
    double *w;
    /* ThreeTableSums Body */
    
    int *xx, *yy, *bb, PQ = mPQB(P, Q, 1);

    for (int p = 0; p < PQ * B; p++) PQL_ans[p] = 0.0;

    yy = y;
    xx = x;
    bb = block;
    /* init subset loop */

    R_xlen_t diff = 0;
    s = subset + offset;
    w = weights;
    /* subset is R-style index in 1:N */
    if (Nsubset > 0)
        diff = (R_xlen_t) s[0] - 1;
    
    /* start subset loop */

    for (R_xlen_t i = 0; i < (Nsubset == 0 ? N : Nsubset) - 1; i++)
    
    {
        xx = xx + diff;
        yy = yy + diff;
        bb = bb + diff;
        if (HAS_WEIGHTS) {
            w = w + diff;
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += (double) w[0];
        } else {
            PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
        }
        /* continue subset loop */
        
        if (Nsubset > 0) {
            /* NB: diff also works with R style index */
            diff = (R_xlen_t) s[1] - s[0];
            if (diff < 0)
                error("subset not sorted");
            s++;
        } else {
            diff = 1;
        }
        
    }
    xx = xx + diff;
    yy = yy + diff;
    bb = bb + diff;
    if (HAS_WEIGHTS) {
        w = w + diff;
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]] += w[0];
    } else {
        PQL_ans[(bb[0] - 1) * PQ + yy[0] * P + xx[0]]++;
    }
    
}

/* RC_ThreeTableSums */

/* RC_ThreeTableSums Prototype */

void RC_ThreeTableSums
(
    /* C ThreeTableSums Input */
    
    /* C integer x Input */

    int *x,
    /* C integer N Input */

    R_xlen_t N
    ,
    /* C integer P Input */

    int P
    ,
    
    /* C integer y Input */

    int *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* C integer block Input */

    int *block,
    /* C integer B Input */

    int B
    ,
    
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C ThreeTableSums Answer */
    
    double *PQL_ans
    
)

{
    if (TYPEOF(weights) == INTSXP) {
        if (TYPEOF(subset) == INTSXP) {
            C_ThreeTableSums_iweights_isubset(x, N, P, y, Q, block, B,
                                        INTEGER(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, PQL_ans);
        } else {
            C_ThreeTableSums_iweights_dsubset(x, N, P, y, Q, block, B,
                                        INTEGER(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, PQL_ans);
        }
    } else {
        if (TYPEOF(subset) == INTSXP) {
            C_ThreeTableSums_dweights_isubset(x, N, P, y, Q, block, B,
                                        REAL(weights), XLENGTH(weights) > 0, INTEGER(subset),
                                        offset, Nsubset, PQL_ans);
        } else {
            C_ThreeTableSums_dweights_dsubset(x, N, P, y, Q, block, B,
                                        REAL(weights), XLENGTH(weights) > 0, REAL(subset),
                                        offset, Nsubset, PQL_ans);
        }
    }
}

/* R_ThreeTableSums */

/* R_ThreeTableSums Prototype */

SEXP R_ThreeTableSums
(
    /* R x Input */
    
    SEXP x,
    
    /* R y Input */
    
    SEXP y,
    
    /* R block Input */
    
    SEXP block
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans, dim;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    int P, Q, B;

    N = XLENGTH(x);
    Nsubset = XLENGTH(subset);
    P = NLEVELS(x) + 1;
    Q = NLEVELS(y) + 1;
    B = NLEVELS(block);

    PROTECT(ans = allocVector(REALSXP, mPQB(P, Q, B)));
    PROTECT(dim = allocVector(INTSXP, 3));
    INTEGER(dim)[0] = P;
    INTEGER(dim)[1] = Q;
    INTEGER(dim)[2] = B;
    dimgets(ans, dim);
    RC_ThreeTableSums(INTEGER(x), N, P, INTEGER(y), Q,
                      INTEGER(block), B,
                      weights, subset, Offset0, Nsubset, REAL(ans));
    UNPROTECT(2);
    return(ans);
}


/* Utils */

/* C_setup_subset */

void C_setup_subset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    SEXP ans
) {
    for (R_xlen_t i = 0; i < N; i++) {
        /* ans is R style index in 1:N */
        if (TYPEOF(ans) == INTSXP) {
            INTEGER(ans)[i] = i + 1;
        } else {
            REAL(ans)[i] = (double) i + 1;
        }
    }
}

/* C_setup_subset_block */

void C_setup_subset_block
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R block Input */
    
    SEXP block
    ,
    /* R blockTable Input */
    
    SEXP blockTable
    ,
    SEXP ans
) {
    double *cumtable;
    int Nlevels = LENGTH(blockTable);

    cumtable = R_Calloc(Nlevels, double);
    for (int k = 0; k < Nlevels; k++) cumtable[k] = 0.0;

    /* table[0] are missings, ie block == 0 ! */
    for (int k = 1; k < Nlevels; k++)
        cumtable[k] = cumtable[k - 1] + REAL(blockTable)[k - 1];

    for (R_xlen_t i = 0; i < N; i++) {
        /* ans is R style index in 1:N */
        if (TYPEOF(ans) == INTSXP) {
            INTEGER(ans)[(int) cumtable[INTEGER(block)[i]]++] = i + 1;
        } else {
            REAL(ans)[(R_xlen_t) cumtable[INTEGER(block)[i]]++] = (double) i + 1;
        }
    }

    R_Free(cumtable);
}

/* C_order_subset_wrt_block */

void C_order_subset_wrt_block
(
    /* R subset Input */
    
    SEXP subset
    ,
    /* R block Input */
    
    SEXP block
    ,
    /* R blockTable Input */
    
    SEXP blockTable
    ,
    SEXP ans
) {
    double *cumtable;
    int Nlevels = LENGTH(blockTable);

    cumtable = R_Calloc(Nlevels, double);
    for (int k = 0; k < Nlevels; k++) cumtable[k] = 0.0;

    /* table[0] are missings, ie block == 0 ! */
    for (int k = 1; k < Nlevels; k++)
        cumtable[k] = cumtable[k - 1] + REAL(blockTable)[k - 1];

    /* subset is R style index in 1:N */
    if (TYPEOF(subset) == INTSXP) {
        for (R_xlen_t i = 0; i < XLENGTH(subset); i++)
            INTEGER(ans)[(int) cumtable[INTEGER(block)[INTEGER(subset)[i] - 1]]++] = INTEGER(subset)[i];
    } else {
        for (R_xlen_t i = 0; i < XLENGTH(subset); i++)
            REAL(ans)[(R_xlen_t) cumtable[INTEGER(block)[(R_xlen_t) REAL(subset)[i] - 1]]++] = REAL(subset)[i];
    }

    R_Free(cumtable);
}

/* RC_order_subset_wrt_block */

/* RC_order_subset_wrt_block Prototype */

SEXP RC_order_subset_wrt_block
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* R block Input */
    
    SEXP block
    ,
    /* R blockTable Input */
    
    SEXP blockTable
    
)

{
    SEXP ans;
    int NOBLOCK = (XLENGTH(block) == 0 || XLENGTH(blockTable) == 2);

    if (XLENGTH(subset) > 0) {
        if (NOBLOCK) {
            return(subset);
        } else {
            PROTECT(ans = allocVector(TYPEOF(subset), XLENGTH(subset)));
            C_order_subset_wrt_block(subset, block, blockTable, ans);
            UNPROTECT(1);
            return(ans);
        }
    } else {
        PROTECT(ans = allocVector(TYPEOF(subset), N));
        if (NOBLOCK) {
            C_setup_subset(N, ans);
        } else {
            C_setup_subset_block(N, block, blockTable, ans);
        }
        UNPROTECT(1);
        return(ans);
    }
}

/* R_order_subset_wrt_block */

/* R_order_subset_wrt_block Prototype */

SEXP R_order_subset_wrt_block
(
    /* R y Input */
    
    SEXP y,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* R block Input */
    
    SEXP block
    
)

{
    /* C integer N Input */
    
    R_xlen_t N
    ;
    SEXP blockTable, ans;

    N = XLENGTH(y) / NCOL(y);

    if (XLENGTH(weights) > 0)
        error("cannot deal with weights here");

    if (NLEVELS(block) > 1) {
        PROTECT(blockTable = R_OneTableSums(block, weights, subset));
    } else {
        PROTECT(blockTable = allocVector(REALSXP, 2));
        REAL(blockTable)[0] = 0.0;
        REAL(blockTable)[1] = RC_Sums(N, weights, subset, Offset0, XLENGTH(subset));
    }

    PROTECT(ans = RC_order_subset_wrt_block(N, subset, block, blockTable));

    UNPROTECT(2);
    return(ans);
}


/* LinearStatistics */

/* RC_LinearStatistic */

/* RC_LinearStatistic Prototype */

void RC_LinearStatistic
(
    /* R x Input */
    
    SEXP x,
    
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer P Input */
    
    int P
    ,
    /* C real y Input */
    
    double *y,
    /* C integer Q Input */

    int Q
    ,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C KronSums Answer */
    
    double *PQ_ans
    
)

{
    double center;

    RC_KronSums(x, N, P, y, Q, !DoSymmetric, &center, &center, !DoCenter, weights,
                subset, offset, Nsubset, PQ_ans);
}


/* Permutations */

/* RC_setup_subset */

/* RC_setup_subset Prototype */

SEXP RC_setup_subset
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans, mysubset;
    R_xlen_t sumweights;

    if (XLENGTH(subset) == 0) {
        PROTECT(mysubset = allocVector(REALSXP, N));
        C_setup_subset(N, mysubset);
    } else {
        PROTECT(mysubset = coerceVector(subset, REALSXP));
    }

    if (XLENGTH(weights) == 0) {
        UNPROTECT(1);
        return(mysubset);
    }

    sumweights = (R_xlen_t) RC_Sums(N, weights, mysubset, Offset0, XLENGTH(subset));
    PROTECT(ans = allocVector(REALSXP, sumweights));

    R_xlen_t itmp = 0;
    for (R_xlen_t i = 0; i < XLENGTH(mysubset); i++) {
        if (TYPEOF(weights) == REALSXP) {
            for (R_xlen_t j = 0; j < REAL(weights)[(R_xlen_t) REAL(mysubset)[i] - 1]; j++)
                REAL(ans)[itmp++] = REAL(mysubset)[i];
        } else {
            for (R_xlen_t j = 0; j < INTEGER(weights)[(R_xlen_t) REAL(mysubset)[i] - 1]; j++)
                REAL(ans)[itmp++] = REAL(mysubset)[i];
        }
    }
    UNPROTECT(2);
    return(ans);
}

/* C_Permute */

void C_Permute
(
    double *subset,
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ,
    double *ans
) {
    R_xlen_t n = Nsubset, j;

    for (R_xlen_t i = 0; i < Nsubset; i++) {
        j = n * unif_rand();
        ans[i] = subset[j];
        subset[j] = subset[--n];
    }
}

/* C_doPermute */

void C_doPermute
(
    double *subset,
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ,
    double *Nsubset_tmp,
    double *perm
) {
    Memcpy(Nsubset_tmp, subset, Nsubset);
    C_Permute(Nsubset_tmp, Nsubset, perm);
}

/* C_PermuteBlock */

void C_PermuteBlock
(
    double *subset,
    double *table,
    int Nlevels,
    double *ans
) {
    double *px, *pans;

    px = subset;
    pans = ans;

    for (R_xlen_t j = 0; j < Nlevels; j++) {
        if (table[j] > 0) {
            C_Permute(px, (R_xlen_t) table[j], pans);
            px += (R_xlen_t) table[j];
            pans += (R_xlen_t) table[j];
        }
    }
}

/* C_doPermuteBlock */

void C_doPermuteBlock
(
    double *subset,
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ,
    double *table,
    int Nlevels,
    double *Nsubset_tmp,
    double *perm
) {
    Memcpy(Nsubset_tmp, subset, Nsubset);
    C_PermuteBlock(Nsubset_tmp, table, Nlevels, perm);
}


/* ExpectationCovariances */

/* RC_ExpectationInfluence */

/* RC_ExpectationInfluence Prototype */

void RC_ExpectationInfluence
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R y Input */
    
    SEXP y,
    
    /* C integer Q Input */
    
    int Q
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C sumweights Input */
    
    double sumweights
    ,
    /* C colSums Answer */
    
    double *P_ans
    
)

{
    double center;

    RC_colSums(REAL(y), N, Q, Power1, &center, !DoCenter, weights,
               subset, offset, Nsubset, P_ans);
    for (int q = 0; q < Q; q++)
        P_ans[q] = P_ans[q] / sumweights;
}

/* R_ExpectationInfluence */

/* R_ExpectationInfluence Prototype */

SEXP R_ExpectationInfluence
(
    /* R y Input */
    
    SEXP y,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans;
    /* C integer Q Input */
    
    int Q
    ;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    double sumweights;

    Q = NCOL(y);
    N = XLENGTH(y) / Q;
    Nsubset = XLENGTH(subset);

    sumweights = RC_Sums(N, weights, subset, Offset0, Nsubset);

    PROTECT(ans = allocVector(REALSXP, Q));
    RC_ExpectationInfluence(N, y, Q, weights, subset, Offset0, Nsubset, sumweights, REAL(ans));
    UNPROTECT(1);
    return(ans);
}

/* RC_CovarianceInfluence */

/* RC_CovarianceInfluence Prototype */

void RC_CovarianceInfluence
(
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* R y Input */
    
    SEXP y,
    
    /* C integer Q Input */
    
    int Q
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    double *ExpInf,
    /* C sumweights Input */
    
    double sumweights
    ,
    int VARONLY,
    /* C KronSums Answer */
    
    double *PQ_ans
    
)

{
    if (VARONLY) {
        RC_colSums(REAL(y), N, Q, Power2, ExpInf, DoCenter, weights,
                   subset, offset, Nsubset, PQ_ans);
        for (int q = 0; q < Q; q++)
            PQ_ans[q] = PQ_ans[q] / sumweights;
    } else {
        RC_KronSums(y, N, Q, REAL(y), Q, DoSymmetric, ExpInf, ExpInf, DoCenter, weights,
                    subset, offset, Nsubset, PQ_ans);
        for (int q = 0; q < Q * (Q + 1) / 2; q++)
            PQ_ans[q] = PQ_ans[q] / sumweights;
    }
}

/* R_CovarianceInfluence */

/* R_CovarianceInfluence Prototype */

SEXP R_CovarianceInfluence
(
    /* R y Input */
    
    SEXP y,
    
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    SEXP varonly
)

{
    SEXP ans;
    SEXP ExpInf;
    /* C integer Q Input */
    
    int Q
    ;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    double sumweights;

    Q = NCOL(y);
    N = XLENGTH(y) / Q;
    Nsubset = XLENGTH(subset);

    PROTECT(ExpInf = R_ExpectationInfluence(y, weights, subset));

    sumweights = RC_Sums(N, weights, subset, Offset0, Nsubset);

    if (INTEGER(varonly)[0]) {
        PROTECT(ans = allocVector(REALSXP, Q));
    } else {
        PROTECT(ans = allocVector(REALSXP, Q * (Q + 1) / 2));
    }
    RC_CovarianceInfluence(N, y, Q, weights, subset, Offset0, Nsubset, REAL(ExpInf), sumweights,
                           INTEGER(varonly)[0], REAL(ans));
    UNPROTECT(2);
    return(ans);
}

/* RC_ExpectationX */

/* RC_ExpectationX Prototype */

void RC_ExpectationX
(
    /* R x Input */
    
    SEXP x,
    
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer P Input */
    
    int P
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    /* C OneTableSums Answer */
    
    double *P_ans
    
)

{
    double center;

    if (TYPEOF(x) == INTSXP) {
        double* Pp1tmp = R_Calloc(P + 1, double);
        RC_OneTableSums(INTEGER(x), N, P + 1, weights, subset, offset, Nsubset, Pp1tmp);
        for (int p = 0; p < P; p++) P_ans[p] = Pp1tmp[p + 1];
        R_Free(Pp1tmp);
    } else {
        RC_colSums(REAL(x), N, P, Power1, &center, !DoCenter, weights, subset, offset, Nsubset, P_ans);
    }
}

/* R_ExpectationX */

/* R_ExpectationX Prototype */

SEXP R_ExpectationX
(
    /* R x Input */
    
    SEXP x,
    
    SEXP P,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    
)

{
    SEXP ans;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;

    N = XLENGTH(x) / INTEGER(P)[0];
    Nsubset = XLENGTH(subset);

    PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0]));
    RC_ExpectationX(x, N, INTEGER(P)[0], weights, subset,
                    Offset0, Nsubset, REAL(ans));
    UNPROTECT(1);
    return(ans);
}

/* RC_CovarianceX */

/* RC_CovarianceX Prototype */

void RC_CovarianceX
(
    /* R x Input */
    
    SEXP x,
    
    /* C integer N Input */
    
    R_xlen_t N
    ,
    /* C integer P Input */
    
    int P
    ,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    /* C subset range Input */
    
    R_xlen_t offset,
    /* C integer Nsubset Input */

    R_xlen_t Nsubset
    
    ,
    double *ExpX,
    int VARONLY,
    /* C KronSums Answer */
    
    double *PQ_ans
    
)

{
    double center;

    if (TYPEOF(x) == INTSXP) {
        if (VARONLY) {
            for (int p = 0; p < P; p++) PQ_ans[p] = ExpX[p];
        } else {
            for (int p = 0; p < PP12(P); p++)
                PQ_ans[p] = 0.0;
            for (int p = 0; p < P; p++)
                PQ_ans[S(p, p, P)] = ExpX[p];
        }
    } else {
        if (VARONLY) {
            RC_colSums(REAL(x), N, P, Power2, &center, !DoCenter, weights,
                       subset, offset, Nsubset, PQ_ans);
        } else {
            RC_KronSums(x, N, P, REAL(x), P, DoSymmetric, &center, &center, !DoCenter, weights,
                        subset, offset, Nsubset, PQ_ans);
        }
    }
}

/* R_CovarianceX */

/* R_CovarianceX Prototype */

SEXP R_CovarianceX
(
    /* R x Input */
    
    SEXP x,
    
    SEXP P,
    /* R weights Input */
    
    SEXP weights
    ,
    /* R subset Input */
    
    SEXP subset
    ,
    SEXP varonly
)

{
    SEXP ans;
    SEXP ExpX;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;

    N = XLENGTH(x) / INTEGER(P)[0];
    Nsubset = XLENGTH(subset);

    PROTECT(ExpX = R_ExpectationX(x, P, weights, subset));

    if (INTEGER(varonly)[0]) {
        PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0]));
    } else {
        PROTECT(ans = allocVector(REALSXP, INTEGER(P)[0] * (INTEGER(P)[0] + 1) / 2));
    }
    RC_CovarianceX(x, N, INTEGER(P)[0], weights, subset, Offset0, Nsubset, REAL(ExpX),
                   INTEGER(varonly)[0], REAL(ans));
    UNPROTECT(2);
    return(ans);
}

/* C_ExpectationLinearStatistic */

void C_ExpectationLinearStatistic
(
    /* C integer P Input */
    
    int P
    ,
    /* C integer Q Input */
    
    int Q
    ,
    double *ExpInf,
    double *ExpX,
    const int add,
    double *PQ_ans
) {
    if (!add)
        for (int p = 0; p < mPQB(P, Q, 1); p++) PQ_ans[p] = 0.0;

    for (int p = 0; p < P; p++) {
        for (int q = 0; q < Q; q++)
            PQ_ans[q * P + p] += ExpX[p] * ExpInf[q];
    }
}

/* C_CovarianceLinearStatistic */

void C_CovarianceLinearStatistic
(
    /* C integer P Input */
    
    int P
    ,
    /* C integer Q Input */
    
    int Q
    ,
    double *CovInf,
    double *ExpX,
    double *CovX,
    /* C sumweights Input */
    
    double sumweights
    ,
    const int add,
    double *PQPQ_sym_ans
) {
    double f1 = sumweights / (sumweights - 1);
    double f2 = 1.0 / (sumweights - 1);
    double tmp, *PP_sym_tmp;

    if (mPQB(P, Q, 1) == 1) {
        tmp = f1 * CovInf[0] * CovX[0];
        tmp -= f2 * CovInf[0] * ExpX[0] * ExpX[0];
        if (add) {
            PQPQ_sym_ans[0] += tmp;
        } else {
            PQPQ_sym_ans[0] = tmp;
        }
    } else {
        PP_sym_tmp = R_Calloc(PP12(P), double);
        C_KronSums_sym_(ExpX, 1, P,
                        PP_sym_tmp);
        for (int p = 0; p < PP12(P); p++)
            PP_sym_tmp[p] = f1 * CovX[p] - f2 * PP_sym_tmp[p];
        C_kronecker_sym(CovInf, Q, PP_sym_tmp, P, 1 - (add >= 1),
                        PQPQ_sym_ans);
        R_Free(PP_sym_tmp);
    }
}

/* C_VarianceLinearStatistic */

void C_VarianceLinearStatistic
(
    /* C integer P Input */
    
    int P
    ,
    /* C integer Q Input */
    
    int Q
    ,
    double *VarInf,
    double *ExpX,
    double *VarX,
    /* C sumweights Input */
    
    double sumweights
    ,
    const int add,
    double *PQ_ans
) {
    if (mPQB(P, Q, 1) == 1) {
        C_CovarianceLinearStatistic(P, Q, VarInf, ExpX, VarX,
                                    sumweights, (add >= 1),
                                    PQ_ans);
    } else {
        double *P_tmp;
        P_tmp = R_Calloc(P, double);
        double f1 = sumweights / (sumweights - 1);
        double f2 = 1.0 / (sumweights - 1);
        for (int p = 0; p < P; p++)
            P_tmp[p] = f1 * VarX[p] - f2 * ExpX[p] * ExpX[p];
        C_kronecker(VarInf, 1, Q, P_tmp, 1, P, 1 - (add >= 1),
                    PQ_ans);
        R_Free(P_tmp);
    }
}


/* Test Statistics */

/* C_maxstand_Covariance */

double C_maxstand_Covariance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *covar_sym,
    const double tol
) {
    double ans = R_NegInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (covar_sym[S(p, p, PQ)] > tol)
            tmp = (linstat[p] - expect[p]) / sqrt(covar_sym[S(p, p, PQ)]);
        if (tmp > ans) ans = tmp;
    }
    return(ans);
}

/* C_maxstand_Variance */

double C_maxstand_Variance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *var,
    const double tol
) {
    double ans = R_NegInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (var[p] > tol)
            tmp = (linstat[p] - expect[p]) / sqrt(var[p]);
        if (tmp > ans) ans = tmp;
    }
    return(ans);
}

/* C_minstand_Covariance */

double C_minstand_Covariance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *covar_sym,
    const double tol
) {
    double ans = R_PosInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (covar_sym[S(p, p, PQ)] > tol)
            tmp = (linstat[p] - expect[p]) / sqrt(covar_sym[S(p, p, PQ)]);
        if (tmp < ans) ans = tmp;
    }
    return(ans);
}

/* C_minstand_Variance */

double C_minstand_Variance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *var,
    const double tol
) {
    double ans = R_PosInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (var[p] > tol)
            tmp = (linstat[p] - expect[p]) / sqrt(var[p]);
        if (tmp < ans) ans = tmp;
    }
    return(ans);
}

/* C_maxabsstand_Covariance */

double C_maxabsstand_Covariance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *covar_sym,
    const double tol
) {
    double ans = R_NegInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (covar_sym[S(p, p, PQ)] > tol)
            tmp = fabs((linstat[p] - expect[p]) /
                  sqrt(covar_sym[S(p, p, PQ)]));
        if (tmp > ans) ans = tmp;
    }
    return(ans);
}

/* C_maxabsstand_Variance */

double C_maxabsstand_Variance
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *var,
    const double tol
) {
    double ans = R_NegInf, tmp = 0.0;

    for (int p = 0; p < PQ; p++) {
        tmp = 0.0;
        if (var[p] > tol)
            tmp = fabs((linstat[p] - expect[p]) / sqrt(var[p]));
        if (tmp > ans) ans = tmp;
    }
    return(ans);
}

/* C_quadform */

double C_quadform
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *MPinv_sym
) {
    double ans = 0.0, tmp = 0.0;

    for (int q = 0; q < PQ; q++) {
        tmp = 0.0;
        for (int p = 0; p < PQ; p++)
            tmp += (linstat[p] - expect[p]) * MPinv_sym[S(p, q, PQ)];
        ans += tmp * (linstat[q] - expect[q]);
    }

    return(ans);
}

/* R_quadform */

/* R_quadform Prototype */

SEXP R_quadform
(
    SEXP linstat,
    SEXP expect,
    SEXP MPinv_sym
)

{
    SEXP ans;
    int n, PQ;
    double *dlinstat, *dexpect, *dMPinv_sym, *dans;

    n = NCOL(linstat);
    PQ = NROW(linstat);
    dlinstat = REAL(linstat);
    dexpect = REAL(expect);
    dMPinv_sym = REAL(MPinv_sym);

    PROTECT(ans = allocVector(REALSXP, n));
    dans = REAL(ans);
    for (int i = 0; i < n; i++)
      dans[i] = C_quadform(PQ, dlinstat + PQ * i, dexpect, dMPinv_sym);

    UNPROTECT(1);
    return(ans);
}

/* C_maxtype */

double C_maxtype
(
    const int PQ,
    const double *linstat,
    const double *expect,
    const double *covar,
    const int varonly,
    const double tol,
    const int alternative
) {
    double ret = 0.0;

    if (varonly) {
        if (alternative == ALTERNATIVE_twosided) {
            ret = C_maxabsstand_Variance(PQ, linstat, expect, covar, tol);
        } else if (alternative == ALTERNATIVE_less) {
            ret = C_minstand_Variance(PQ, linstat, expect, covar, tol);
        } else if (alternative == ALTERNATIVE_greater) {
            ret = C_maxstand_Variance(PQ, linstat, expect, covar, tol);
        }
    } else {
        if (alternative == ALTERNATIVE_twosided) {
            ret = C_maxabsstand_Covariance(PQ, linstat, expect, covar, tol);
        } else if (alternative == ALTERNATIVE_less) {
            ret = C_minstand_Covariance(PQ, linstat, expect, covar, tol);
        } else if (alternative == ALTERNATIVE_greater) {
            ret = C_maxstand_Covariance(PQ, linstat, expect, covar, tol);
        }
    }
    return(ret);
}

/* C_standardise */

void C_standardise
(
    const int PQ,
    double *linstat,      /* in place standardisation */
    const double *expect,
    const double *covar,
    const int varonly,
    const double tol
) {
    double var;

    for (int p = 0; p < PQ; p++) {
        if (varonly) {
            var = covar[p];
        } else {
            var = covar[S(p, p, PQ)];
        }
        if (var > tol) {
            linstat[p] = (linstat[p] - expect[p]) / sqrt(var);
        } else {
            linstat[p] = NAN;
        }
    }
}

/* C_ordered_Xfactor */

void C_ordered_Xfactor
(
    /* maxstat Xfactor Variables */
    
    SEXP LECV,
    const int minbucket,
    const int teststat,
    int *wmax,
    double *maxstat,
    double *bmaxstat,
    double *pval,
    const int lower,
    const int give_log
    
) {
    /* Setup maxstat Variables */
    
    double *linstat, *expect, *covar, *varinf, *covinf, *ExpX, *blinstat, tol, *ls;
    int P, Q, B;
    R_xlen_t nresample;

    double *mlinstat, *mblinstat, *mexpect, *mvar, *mcovar, *mMPinv,
           tmp, sumleft, sumright, sumweights;
    int rank, PQ, greater;

    Q = C_get_Q(LECV);
    P = C_get_P(LECV);
    PQ = mPQB(P, Q, 1);
    B = C_get_B(LECV);
    if (B > 1) {
        if (C_get_varonly(LECV))
            error("need covariance for maximally statistics with blocks");
        covar = C_get_Covariance(LECV);
    } else {
        covar = C_get_Variance(LECV); /* make -Wall happy */
    }
    linstat = C_get_LinearStatistic(LECV);
    expect = C_get_Expectation(LECV);
    ExpX = C_get_ExpectationX(LECV);
    /* both need to be there */
    varinf = C_get_VarianceInfluence(LECV);
    covinf = C_get_CovarianceInfluence(LECV);
    nresample = C_get_nresample(LECV);
    if (nresample > 0)
        blinstat = C_get_PermutedLinearStatistic(LECV);
    tol = C_get_tol(LECV);
    

    /* Setup maxstat Memory */
    
    mlinstat = R_Calloc(Q, double);
    mexpect = R_Calloc(Q, double);
    if (teststat == TESTSTAT_maximum) {
        mvar = R_Calloc(Q, double);
        /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mcovar = R_Calloc(1, double);
        mMPinv = R_Calloc(1, double);
    } else {
        mcovar = R_Calloc(Q * (Q + 1) / 2, double);
        mMPinv = R_Calloc(Q * (Q + 1) / 2, double);
        /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mvar = R_Calloc(1, double);
    }
    if (nresample > 0) {
        mblinstat = R_Calloc(Q * nresample, double);
    } else { /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mblinstat = R_Calloc(1, double);
        blinstat = R_Calloc(1, double);
    }

    maxstat[0] = 0.0;

    for (int q = 0; q < Q; q++) {
        mlinstat[q] = 0.0;
        mexpect[q] = 0.0;
        if (teststat == TESTSTAT_maximum)
            mvar[q] = 0.0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            mblinstat[q + np * Q] = 0.0;
            bmaxstat[np] = 0.0;
        }
    }
    if (teststat == TESTSTAT_quadratic) {
        for (int q = 0; q < Q * (Q + 1) / 2; q++)
            mcovar[q] = 0.0;
    }

    sumleft = 0.0;
    sumright = 0.0;
    for (int p = 0; p < P; p++)
        sumright += ExpX[p];
    sumweights = sumright;
    

    wmax[0] = NA_INTEGER;

    for (int p = 0; p < P; p++) {
        sumleft += ExpX[p];
        sumright -= ExpX[p];

        for (int q = 0; q < Q; q++) {
            mlinstat[q] += linstat[q * P + p];
            for (R_xlen_t np = 0; np < nresample; np++)
                mblinstat[q + np * Q] += blinstat[q * P + p + np * PQ];
            mexpect[q] += expect[q * P + p];
            if (B == 1) {
                /* Compute maxstat Variance / Covariance Directly */
                
                /* does not work with blocks! */
                if (teststat == TESTSTAT_maximum) {
                    C_VarianceLinearStatistic(1, Q, varinf, &sumleft, &sumleft,
                                              sumweights, 0, mvar);
                } else {
                    C_CovarianceLinearStatistic(1, Q, covinf, &sumleft, &sumleft,
                                                sumweights, 0, mcovar);
                }
                
            } else {
                /* Compute maxstat Variance / Covariance from Total Covariance */
                
                if (teststat == TESTSTAT_maximum) {
                    for (int pp = 0; pp < p; pp++)
                        mvar[q] += 2 * covar[S(pp + q * P, p + P * q, mPQB(P, Q, 1))];
                    mvar[q] += covar[S(p + q * P, p + P * q, mPQB(P, Q, 1))];
                } else {
                    for (int qq = 0; qq <= q; qq++) {
                        for (int pp = 0; pp < p; pp++)
                            mcovar[S(q, qq, Q)] += 2 * covar[S(pp + q * P, p + P * qq, mPQB(P, Q, 1))];
                        mcovar[S(q, qq, Q)] += covar[S(p + q * P, p + P * qq, mPQB(P, Q, 1))];
                    }
                }
                
            }
        }

        if ((sumleft >= minbucket) && (sumright >= minbucket) && (ExpX[p] > 0)) {
            ls = mlinstat;
            /* compute MPinv only once */
            if (teststat != TESTSTAT_maximum)
                C_MPinv_sym(mcovar, Q, tol, mMPinv, &rank);
            /* Compute maxstat Test Statistic */
            
            if (teststat == TESTSTAT_maximum) {
                tmp = C_maxtype(Q, ls, mexpect, mvar, 1, tol,
                                ALTERNATIVE_twosided);
            } else {
                tmp = C_quadform(Q, ls, mexpect, mMPinv);
            }
            
            if (tmp > maxstat[0]) {
                wmax[0] = p;
                maxstat[0] = tmp;
            }

            for (R_xlen_t np = 0; np < nresample; np++) {
                ls = mblinstat + np * Q;
                /* Compute maxstat Test Statistic */
                
                if (teststat == TESTSTAT_maximum) {
                    tmp = C_maxtype(Q, ls, mexpect, mvar, 1, tol,
                                    ALTERNATIVE_twosided);
                } else {
                    tmp = C_quadform(Q, ls, mexpect, mMPinv);
                }
                
                if (tmp > bmaxstat[np])
                    bmaxstat[np] = tmp;
            }
        }
    }
    /* Compute maxstat Permutation P-Value */
    
    if (nresample > 0) {
        greater = 0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            if (bmaxstat[np] > maxstat[0]) greater++;
        }
        pval[0] = C_perm_pvalue(greater, nresample, lower, give_log);
    }
    
    R_Free(mlinstat); R_Free(mexpect); R_Free(mblinstat);
    R_Free(mvar); R_Free(mcovar); R_Free(mMPinv);
    if (nresample == 0) R_Free(blinstat);
}

/* C_unordered_Xfactor */

void C_unordered_Xfactor
(
    /* maxstat Xfactor Variables */
    
    SEXP LECV,
    const int minbucket,
    const int teststat,
    int *wmax,
    double *maxstat,
    double *bmaxstat,
    double *pval,
    const int lower,
    const int give_log
    
) {
    double *mtmp;
    int qPp, nc, *levels, Pnonzero, *indl, *contrast;

    /* Setup maxstat Variables */
    
    double *linstat, *expect, *covar, *varinf, *covinf, *ExpX, *blinstat, tol, *ls;
    int P, Q, B;
    R_xlen_t nresample;

    double *mlinstat, *mblinstat, *mexpect, *mvar, *mcovar, *mMPinv,
           tmp, sumleft, sumright, sumweights;
    int rank, PQ, greater;

    Q = C_get_Q(LECV);
    P = C_get_P(LECV);
    PQ = mPQB(P, Q, 1);
    B = C_get_B(LECV);
    if (B > 1) {
        if (C_get_varonly(LECV))
            error("need covariance for maximally statistics with blocks");
        covar = C_get_Covariance(LECV);
    } else {
        covar = C_get_Variance(LECV); /* make -Wall happy */
    }
    linstat = C_get_LinearStatistic(LECV);
    expect = C_get_Expectation(LECV);
    ExpX = C_get_ExpectationX(LECV);
    /* both need to be there */
    varinf = C_get_VarianceInfluence(LECV);
    covinf = C_get_CovarianceInfluence(LECV);
    nresample = C_get_nresample(LECV);
    if (nresample > 0)
        blinstat = C_get_PermutedLinearStatistic(LECV);
    tol = C_get_tol(LECV);
    

    /* Setup maxstat Memory */
    
    mlinstat = R_Calloc(Q, double);
    mexpect = R_Calloc(Q, double);
    if (teststat == TESTSTAT_maximum) {
        mvar = R_Calloc(Q, double);
        /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mcovar = R_Calloc(1, double);
        mMPinv = R_Calloc(1, double);
    } else {
        mcovar = R_Calloc(Q * (Q + 1) / 2, double);
        mMPinv = R_Calloc(Q * (Q + 1) / 2, double);
        /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mvar = R_Calloc(1, double);
    }
    if (nresample > 0) {
        mblinstat = R_Calloc(Q * nresample, double);
    } else { /* not needed, but allocate anyway to make -Wmaybe-uninitialized happy */
        mblinstat = R_Calloc(1, double);
        blinstat = R_Calloc(1, double);
    }

    maxstat[0] = 0.0;

    for (int q = 0; q < Q; q++) {
        mlinstat[q] = 0.0;
        mexpect[q] = 0.0;
        if (teststat == TESTSTAT_maximum)
            mvar[q] = 0.0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            mblinstat[q + np * Q] = 0.0;
            bmaxstat[np] = 0.0;
        }
    }
    if (teststat == TESTSTAT_quadratic) {
        for (int q = 0; q < Q * (Q + 1) / 2; q++)
            mcovar[q] = 0.0;
    }

    sumleft = 0.0;
    sumright = 0.0;
    for (int p = 0; p < P; p++)
        sumright += ExpX[p];
    sumweights = sumright;
    
    mtmp = R_Calloc(P, double);

    for (int p = 0; p < P; p++) wmax[p] = NA_INTEGER;

    /* Count Levels */
    
    contrast = R_Calloc(P, int);
    Pnonzero = 0;
    for (int p = 0; p < P; p++) {
        if (ExpX[p] > 0) Pnonzero++;
    }
    levels = R_Calloc(Pnonzero, int);
    nc = 0;
    for (int p = 0; p < P; p++) {
        if (ExpX[p] > 0) {
            levels[nc] = p;
            nc++;
        }
    }

    if (Pnonzero >= 31)
        error("cannot search for unordered splits in >= 31 levels");

    int mi = 1;
    for (int l = 1; l < Pnonzero; l++) mi *= 2;
    indl = R_Calloc(Pnonzero, int);
    for (int p = 0; p < Pnonzero; p++) indl[p] = 0;
    

    for (int j = 1; j < mi; j++) { /* go though all splits */

        /* Setup unordered maxstat Contrasts */
        
        /* indl determines if level p is left or right */
        int jj = j;
        for (int l = 1; l < Pnonzero; l++) {
            indl[l] = (jj%2);
            jj /= 2;
        }

        sumleft = 0.0;
        sumright = 0.0;
        for (int p = 0; p < P; p++) contrast[p] = 0;
        for (int p = 0; p < Pnonzero; p++) {
            sumleft += indl[p] * ExpX[levels[p]];
            sumright += (1 - indl[p]) * ExpX[levels[p]];
            contrast[levels[p]] = indl[p];
        }
        

        /* Compute unordered maxstat Linear Statistic and Expectation */
        
        for (int q = 0; q < Q; q++) {
            mlinstat[q] = 0.0;
            mexpect[q] = 0.0;
            for (R_xlen_t np = 0; np < nresample; np++)
                mblinstat[q + np * Q] = 0.0;
            for (int p = 0; p < P; p++) {
                qPp = q * P + p;
                mlinstat[q] += contrast[p] * linstat[qPp];
                mexpect[q] += contrast[p] * expect[qPp];
                for (R_xlen_t np = 0; np < nresample; np++)
                    mblinstat[q + np * Q] += contrast[p] * blinstat[q * P + p + np * PQ];
            }
        }
        

        if (B == 1) {
            /* Compute unordered maxstat Variance / Covariance Directly */
            
            if (teststat == TESTSTAT_maximum) {
                C_VarianceLinearStatistic(1, Q, varinf, &sumleft, &sumleft,
                                          sumweights, 0, mvar);
            } else {
                C_CovarianceLinearStatistic(1, Q, covinf, &sumleft, &sumleft,
                                            sumweights, 0, mcovar);
            }
            
        } else {
            /* Compute unordered maxstat Variance / Covariance from Total Covariance */
            
            if (teststat == TESTSTAT_maximum) {
                for (int q = 0; q < Q; q++) {
                    mvar[q] = 0.0;
                    for (int p = 0; p < P; p++) {
                        qPp = q * P + p;
                        mtmp[p] = 0.0;
                        for (int pp = 0; pp < P; pp++)
                            mtmp[p] += contrast[pp] * covar[S(pp + q * P, qPp, PQ)];
                    }
                    for (int p = 0; p < P; p++)
                        mvar[q] += contrast[p] * mtmp[p];
                }
            } else {
                for (int q = 0; q < Q; q++) {
                    for (int qq = 0; qq <= q; qq++)
                        mcovar[S(q, qq, Q)] = 0.0;
                    for (int qq = 0; qq <= q; qq++) {
                        for (int p = 0; p < P; p++) {
                            mtmp[p] = 0.0;
                            for (int pp = 0; pp < P; pp++)
                                mtmp[p] += contrast[pp] * covar[S(pp + q * P, p + P * qq,
                                                                  mPQB(P, Q, 1))];
                        }
                        for (int p = 0; p < P; p++)
                            mcovar[S(q, qq, Q)] += contrast[p] * mtmp[p];
                    }
                }
            }
            
        }

        if ((sumleft >= minbucket) && (sumright >= minbucket)) {
            ls = mlinstat;
            /* compute MPinv only once */
            if (teststat != TESTSTAT_maximum)
                C_MPinv_sym(mcovar, Q, tol, mMPinv, &rank);
            /* Compute maxstat Test Statistic */
            
            if (teststat == TESTSTAT_maximum) {
                tmp = C_maxtype(Q, ls, mexpect, mvar, 1, tol,
                                ALTERNATIVE_twosided);
            } else {
                tmp = C_quadform(Q, ls, mexpect, mMPinv);
            }
            
            if (tmp > maxstat[0]) {
                for (int p = 0; p < Pnonzero; p++)
                    wmax[levels[p]] = contrast[levels[p]];
                maxstat[0] = tmp;
            }

            for (R_xlen_t np = 0; np < nresample; np++) {
                ls = mblinstat + np * Q;
                /* Compute maxstat Test Statistic */
                
                if (teststat == TESTSTAT_maximum) {
                    tmp = C_maxtype(Q, ls, mexpect, mvar, 1, tol,
                                    ALTERNATIVE_twosided);
                } else {
                    tmp = C_quadform(Q, ls, mexpect, mMPinv);
                }
                
                if (tmp > bmaxstat[np])
                    bmaxstat[np] = tmp;
            }
        }
    }

    /* Compute maxstat Permutation P-Value */
    
    if (nresample > 0) {
        greater = 0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            if (bmaxstat[np] > maxstat[0]) greater++;
        }
        pval[0] = C_perm_pvalue(greater, nresample, lower, give_log);
    }
    

    R_Free(mlinstat); R_Free(mexpect); R_Free(levels); R_Free(contrast); R_Free(indl); R_Free(mtmp);
    R_Free(mblinstat); R_Free(mvar); R_Free(mcovar); R_Free(mMPinv);
    if (nresample == 0) R_Free(blinstat);
}


/* User Interface */

/* RC_ExpectationCovarianceStatistic */

void RC_ExpectationCovarianceStatistic
(
    /* User Interface Input */
    
    /* R x Input */

    SEXP x,
    
    /* R y Input */

    SEXP y,
    
    /* R weights Input */

    SEXP weights
    ,
    /* R subset Input */

    SEXP subset
    ,
    /* R block Input */

    SEXP block
    ,
    
    SEXP ans
) {
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer P Input */
    
    int P
    ;
    /* C integer Q Input */
    
    int Q
    ;
    /* C integer B Input */
    
    int B
    ;
    double *sumweights, *table;
    double *ExpInf, *VarInf, *CovInf, *ExpX, *ExpXtotal, *VarX, *CovX;
    double *tmpV, *tmpCV;
    SEXP nullvec, subset_block;

    /* Extract Dimensions */
    
    P = C_get_P(ans);
    Q = C_get_Q(ans);
    N = NROW(x);
    B = C_get_B(ans);
    

    /* Compute Linear Statistic */
    
    RC_LinearStatistic(x, N, P, REAL(y), Q, weights, subset,
                       Offset0, XLENGTH(subset),
                       C_get_LinearStatistic(ans));
    

    /* Setup Memory and Subsets in Blocks */
    
    ExpInf = C_get_ExpectationInfluence(ans);
    VarInf = C_get_VarianceInfluence(ans);
    CovInf = C_get_CovarianceInfluence(ans);
    ExpXtotal = C_get_ExpectationX(ans);
    for (int p = 0; p < P; p++) ExpXtotal[p] = 0.0;
    ExpX = R_Calloc(P, double);
    /* Fix by Joanidis Kristoforos: P > INT_MAX is possible
       for maximally selected statistics (when X is an integer).
       2018-12-13 */
    if (C_get_varonly(ans)) {
        VarX = R_Calloc(P, double);
        CovX = R_Calloc(1, double);
    } else {
        VarX = R_Calloc(1, double);
        CovX = R_Calloc(PP12(P), double);
    }
    table = C_get_TableBlock(ans);
    sumweights = C_get_Sumweights(ans);
    PROTECT(nullvec = allocVector(INTSXP, 0));

    if (B == 1) {
        table[0] = 0.0;
        table[1] = RC_Sums(N, nullvec, subset, Offset0, XLENGTH(subset));
    } else {
        RC_OneTableSums(INTEGER(block), N, B + 1, nullvec, subset, Offset0,
                        XLENGTH(subset), table);
    }
    if (table[0] > 0)
        error("No missing values allowed in block");
    PROTECT(subset_block = RC_order_subset_wrt_block(N, subset, block,
                                                     VECTOR_ELT(ans, TableBlock_SLOT)));
    

    /* start with subset[0] */
    R_xlen_t offset = (R_xlen_t) table[0];

    for (int b = 0; b < B; b++) {

        /* Compute Sum of Weights in Block */
        
        /* compute sum of case weights in block b of subset */
        if (table[b + 1] > 0) {
            sumweights[b] = RC_Sums(N, weights, subset_block,
                                    offset, (R_xlen_t) table[b + 1]);
        } else {
            /* offset = something and Nsubset = 0 means Nsubset = N in
               RC_Sums; catch empty or zero-weight block levels here */
            sumweights[b] = 0.0;
        }
        

        /* don't do anything for empty blocks or blocks with weight 1 */
        if (sumweights[b] > 1) {

            /* Compute Expectation Linear Statistic */
            
            RC_ExpectationInfluence(N, y, Q, weights, subset_block, offset,
                                    (R_xlen_t) table[b + 1], sumweights[b], ExpInf + b * Q);
            RC_ExpectationX(x, N, P, weights, subset_block, offset,
                            (R_xlen_t) table[b + 1], ExpX);
            for (int p = 0; p < P; p++) ExpXtotal[p] += ExpX[p];
            C_ExpectationLinearStatistic(P, Q, ExpInf + b * Q, ExpX, b,
                                         C_get_Expectation(ans));
            

            /* Compute Covariance Influence */
            
            /* C_ordered_Xfactor and C_unordered_Xfactor need both VarInf and CovInf */
            RC_CovarianceInfluence(N, y, Q, weights, subset_block, offset,
                                  (R_xlen_t) table[b + 1], ExpInf + b * Q, sumweights[b],
                                  !DoVarOnly, CovInf + b * Q * (Q + 1) / 2);
            /* extract variance from covariance */
            tmpCV = CovInf + b * Q * (Q + 1) / 2;
            tmpV = VarInf + b * Q;
            for (int q = 0; q < Q; q++) tmpV[q] = tmpCV[S(q, q, Q)];
            

            if (C_get_varonly(ans)) {
                /* Compute Variance Linear Statistic */
                
                RC_CovarianceX(x, N, P, weights, subset_block, offset,
                               (R_xlen_t) table[b + 1], ExpX, DoVarOnly, VarX);
                C_VarianceLinearStatistic(P, Q, VarInf + b * Q, ExpX, VarX, sumweights[b],
                                          b, C_get_Variance(ans));
                
            } else {
                /* Compute Covariance Linear Statistic */
                
                RC_CovarianceX(x, N, P, weights, subset_block, offset,
                               (R_xlen_t) table[b + 1], ExpX, !DoVarOnly, CovX);
                C_CovarianceLinearStatistic(P, Q, CovInf + b * Q * (Q + 1) / 2,
                                            ExpX, CovX, sumweights[b], b,
                                            C_get_Covariance(ans));
                
            }
        }

        /* next iteration starts with subset[cumsum(table[1:(b + 1)])] */
        offset += (R_xlen_t) table[b + 1];
    }

    /* Compute Variance from Covariance */
    
    /* always return variances */
    if (!C_get_varonly(ans)) {
        for (int p = 0; p < mPQB(P, Q, 1); p++)
            C_get_Variance(ans)[p] = C_get_Covariance(ans)[S(p, p, mPQB(P, Q, 1))];
    }
    

    R_Free(ExpX); R_Free(VarX); R_Free(CovX);
    UNPROTECT(2);
}

/* R_ExpectationCovarianceStatistic */

/* R_ExpectationCovarianceStatistic Prototype */

SEXP R_ExpectationCovarianceStatistic
(
    /* User Interface Input */
    
    /* R x Input */

    SEXP x,
    
    /* R y Input */

    SEXP y,
    
    /* R weights Input */

    SEXP weights
    ,
    /* R subset Input */

    SEXP subset
    ,
    /* R block Input */

    SEXP block
    ,
    
    SEXP varonly,
    SEXP tol
)

{
    SEXP ans;

    /* Setup Dimensions */
    
    int P, Q, B;

    if (TYPEOF(x) == INTSXP) {
        P = NLEVELS(x);
    } else {
        P = NCOL(x);
    }
    Q = NCOL(y);

    B = 1;
    if (LENGTH(block) > 0)
        B = NLEVELS(block);
    

    PROTECT(ans = RC_init_LECV_1d(P, Q, INTEGER(varonly)[0], B, TYPEOF(x) == INTSXP, REAL(tol)[0]));

    RC_ExpectationCovarianceStatistic(x, y, weights, subset, block, ans);

    UNPROTECT(1);
    return(ans);
}

/* R_PermutedLinearStatistic */

/* R_PermutedLinearStatistic Prototype */

SEXP R_PermutedLinearStatistic
(
    /* User Interface Input */
    
    /* R x Input */

    SEXP x,
    
    /* R y Input */

    SEXP y,
    
    /* R weights Input */

    SEXP weights
    ,
    /* R subset Input */

    SEXP subset
    ,
    /* R block Input */

    SEXP block
    ,
    
    SEXP nresample
)

{
    SEXP ans, expand_subset, block_subset, perm, tmp, blockTable;
    double *linstat;
    int PQ;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    R_xlen_t inresample;

    /* Setup Dimensions */
    
    int P, Q, B;

    if (TYPEOF(x) == INTSXP) {
        P = NLEVELS(x);
    } else {
        P = NCOL(x);
    }
    Q = NCOL(y);

    B = 1;
    if (LENGTH(block) > 0)
        B = NLEVELS(block);
    
    PQ = mPQB(P, Q, 1);
    N = NROW(y);
    inresample = (R_xlen_t) REAL(nresample)[0];

    PROTECT(ans = allocMatrix(REALSXP, PQ, inresample));
    PROTECT(expand_subset = RC_setup_subset(N, weights, subset));
    Nsubset = XLENGTH(expand_subset);
    PROTECT(tmp = allocVector(REALSXP, Nsubset));
    PROTECT(perm = allocVector(REALSXP, Nsubset));

    GetRNGstate();
    if (B == 1) {
        for (R_xlen_t np = 0; np < inresample; np++) {
            /* Setup Linear Statistic */
            
            if (np % 256 == 0) R_CheckUserInterrupt();
            linstat = REAL(ans) + PQ * np;
            for (int p = 0; p < PQ; p++)
                linstat[p] = 0.0;
            
            C_doPermute(REAL(expand_subset), Nsubset, REAL(tmp), REAL(perm));
            RC_KronSums_Permutation(x, NROW(x), P, REAL(y), Q, expand_subset,
                                    Offset0, Nsubset, perm, linstat);
        }
    } else {
        PROTECT(blockTable = allocVector(REALSXP, B + 1));
        /* same as RC_OneTableSums(block, noweights, expand_subset) */
        RC_OneTableSums(INTEGER(block), XLENGTH(block), B + 1, weights, subset, Offset0,
                        XLENGTH(subset), REAL(blockTable));
        PROTECT(block_subset = RC_order_subset_wrt_block(XLENGTH(block), expand_subset,
                                                         block, blockTable));

        for (R_xlen_t np = 0; np < inresample; np++) {
            /* Setup Linear Statistic */
            
            if (np % 256 == 0) R_CheckUserInterrupt();
            linstat = REAL(ans) + PQ * np;
            for (int p = 0; p < PQ; p++)
                linstat[p] = 0.0;
            
            C_doPermuteBlock(REAL(block_subset), Nsubset, REAL(blockTable),
                             B + 1, REAL(tmp), REAL(perm));
            RC_KronSums_Permutation(x, NROW(x), P, REAL(y), Q, block_subset,
                                    Offset0, Nsubset, perm, linstat);
        }
        UNPROTECT(2);
    }
    PutRNGstate();

    UNPROTECT(4);
    return(ans);
}

/* R_StandardisePermutedLinearStatistic */

/* R_StandardisePermutedLinearStatistic Prototype */

SEXP R_StandardisePermutedLinearStatistic
(
    SEXP LECV
)

{
    SEXP ans;
    R_xlen_t nresample = C_get_nresample(LECV);
    double *ls;
    if (!nresample) return(R_NilValue);
    int PQ = C_get_P(LECV) * C_get_Q(LECV);

    PROTECT(ans = allocMatrix(REALSXP, PQ, nresample));

    for (R_xlen_t np = 0; np < nresample; np++) {
        ls = REAL(ans) + PQ * np;
        /* copy first; standarisation is in place */
        for (int p = 0; p < PQ; p++)
            ls[p] = C_get_PermutedLinearStatistic(LECV)[p + PQ * np];
        if (C_get_varonly(LECV)) {
            C_standardise(PQ, ls, C_get_Expectation(LECV),
                          C_get_Variance(LECV), 1, C_get_tol(LECV));
        } else {
            C_standardise(PQ, ls, C_get_Expectation(LECV),
                          C_get_Covariance(LECV), 0, C_get_tol(LECV));
        }
    }
    UNPROTECT(1);
    return(ans);
}


/* 2d User Interface */

/* RC_ExpectationCovarianceStatistic_2d */

void RC_ExpectationCovarianceStatistic_2d
(
    /* 2d User Interface Input */
    
    /* R x Input */

    SEXP x,
    
    SEXP ix,
    /* R y Input */

    SEXP y,
    
    SEXP iy,
    /* R weights Input */

    SEXP weights
    ,
    /* R subset Input */

    SEXP subset
    ,
    /* R block Input */

    SEXP block
    ,
    
    SEXP ans
) {
    /* 2d Memory */
    
    SEXP Rcsum, Rrsum;
    int P, Q, Lxp1, Lyp1, B, Xfactor;
    double *ExpInf, *ExpX, *CovX;
    double *table, *table2d, *csum, *rsum, *sumweights, *btab, *linstat;

    P = C_get_P(ans);
    Q = C_get_Q(ans);

    ExpInf = C_get_ExpectationInfluence(ans);
    ExpX = C_get_ExpectationX(ans);
    table = C_get_Table(ans);
    sumweights = C_get_Sumweights(ans);

    Lxp1 = C_get_dimTable(ans)[0];
    Lyp1 = C_get_dimTable(ans)[1];
    B = C_get_B(ans);
    Xfactor = C_get_Xfactor(ans);

    if (C_get_varonly(ans)) {
        CovX = R_Calloc(P, double);
    } else {
        CovX = R_Calloc(PP12(P), double);
    }

    table2d = R_Calloc(Lxp1 * Lyp1, double);
    PROTECT(Rcsum = allocVector(REALSXP, Lyp1));
    csum = REAL(Rcsum);
    PROTECT(Rrsum = allocVector(REALSXP, Lxp1));
    rsum = REAL(Rrsum);
    

    /* 2d Total Table */
    
    for (int i = 0; i < Lxp1 * Lyp1; i++)
        table2d[i] = 0.0;
    for (int b = 0; b < B; b++) {
        for (int i = 0; i < Lxp1; i++) {
            for (int j = 0; j < Lyp1; j++)
                table2d[j * Lxp1 + i] += table[b * Lxp1 * Lyp1 + j * Lxp1 + i];
        }
    }
    

    linstat = C_get_LinearStatistic(ans);
    for (int p = 0; p < mPQB(P, Q, 1); p++)
        linstat[p] = 0.0;

    for (int b = 0; b < B; b++) {
        btab = table + Lxp1 * Lyp1 * b;

        /* Linear Statistic 2d */
        
        if (Xfactor) {
            for (int j = 1; j < Lyp1; j++) {     /* j = 0 means NA */
                for (int i = 1; i < Lxp1; i++) { /* i = 0 means NA */
                    for (int q = 0; q < Q; q++)
                        linstat[q * (Lxp1 - 1) + (i - 1)] +=
                            btab[j * Lxp1 + i] * REAL(y)[q * Lyp1 + j];
                }
            }
        } else {
            for (int p = 0; p < P; p++) {
                for (int q = 0; q < Q; q++) {
                    int qPp = q * P + p;
                    int qLy = q * Lyp1;
                    for (int i = 0; i < Lxp1; i++) {
                        int pLxi = p * Lxp1 + i;
                        for (int j = 0; j < Lyp1; j++)
                            linstat[qPp] += REAL(y)[qLy + j] * REAL(x)[pLxi] * btab[j * Lxp1 + i];
                    }
                }
            }
        }
        

        /* Col Row Total Sums */
        
        /* Remember: first row / column count NAs */
        /* column sums */
        for (int q = 1; q < Lyp1; q++) {
            csum[q] = 0;
            for (int p = 1; p < Lxp1; p++)
                csum[q] += btab[q * Lxp1 + p];
        }
        csum[0] = 0; /* NA */
        /* row sums */
        for (int p = 1; p < Lxp1; p++) {
            rsum[p] = 0;
            for (int q = 1; q < Lyp1; q++)
                rsum[p] += btab[q * Lxp1 + p];
        }
        rsum[0] = 0; /* NA */
        /* total sum */
        sumweights[b] = 0;
        for (int i = 1; i < Lxp1; i++) sumweights[b] += rsum[i];
        

        /* 2d Expectation */
        
        RC_ExpectationInfluence(NROW(y), y, Q, Rcsum, subset, Offset0, 0, sumweights[b], ExpInf);

        if (LENGTH(x) == 0) {
            for (int p = 0; p < P; p++)
                ExpX[p] = rsum[p + 1];
            } else {
                RC_ExpectationX(x, NROW(x), P, Rrsum, subset, Offset0, 0, ExpX);
        }

        C_ExpectationLinearStatistic(P, Q, ExpInf, ExpX, b, C_get_Expectation(ans));
        

        /* 2d Covariance */
        
        /* C_ordered_Xfactor needs both VarInf and CovInf */
        RC_CovarianceInfluence(NROW(y), y, Q, Rcsum, subset, Offset0, 0, ExpInf, sumweights[b],
                               !DoVarOnly, C_get_CovarianceInfluence(ans));
        for (int q = 0; q < Q; q++)
            C_get_VarianceInfluence(ans)[q] = C_get_CovarianceInfluence(ans)[S(q, q, Q)];

        if (C_get_varonly(ans)) {
            if (LENGTH(x) == 0) {
                for (int p = 0; p < P; p++) CovX[p] = ExpX[p];
            } else {
                RC_CovarianceX(x, NROW(x), P, Rrsum, subset, Offset0, 0, ExpX, DoVarOnly, CovX);
            }
            C_VarianceLinearStatistic(P, Q, C_get_VarianceInfluence(ans),
                                      ExpX, CovX, sumweights[b], b,
                                      C_get_Variance(ans));
        } else {
            if (LENGTH(x) == 0) {
                for (int p = 0; p < PP12(P); p++) CovX[p] = 0.0;
                for (int p = 0; p < P; p++) CovX[S(p, p, P)] = ExpX[p];
            } else {
                RC_CovarianceX(x, NROW(x), P, Rrsum, subset, Offset0, 0, ExpX, !DoVarOnly, CovX);
            }
            C_CovarianceLinearStatistic(P, Q, C_get_CovarianceInfluence(ans),
                                        ExpX, CovX, sumweights[b], b,
                                        C_get_Covariance(ans));
        }
        
    }

    /* always return variances */
    if (!C_get_varonly(ans)) {
        for (int p = 0; p < mPQB(P, Q, 1); p++)
            C_get_Variance(ans)[p] = C_get_Covariance(ans)[S(p, p, mPQB(P, Q, 1))];
    }

    R_Free(CovX);
    R_Free(table2d);
    UNPROTECT(2);
}

/* R_ExpectationCovarianceStatistic_2d */

/* R_ExpectationCovarianceStatistic_2d Prototype */

SEXP R_ExpectationCovarianceStatistic_2d
(
    /* 2d User Interface Input */
    
    /* R x Input */

    SEXP x,
    
    SEXP ix,
    /* R y Input */

    SEXP y,
    
    SEXP iy,
    /* R weights Input */

    SEXP weights
    ,
    /* R subset Input */

    SEXP subset
    ,
    /* R block Input */

    SEXP block
    ,
    
    SEXP varonly,
    SEXP tol
)

{
    SEXP ans;
    /* C integer N Input */
    
    R_xlen_t N
    ;
    /* C integer Nsubset Input */
    
    R_xlen_t Nsubset
    ;
    int Xfactor;

    N = XLENGTH(ix);
    Nsubset = XLENGTH(subset);
    Xfactor = XLENGTH(x) == 0;

    /* Setup Dimensions 2d */
    
    int P, Q, B, Lx, Ly;

    if (XLENGTH(x) == 0) {
        P = NLEVELS(ix);
    } else {
        P = NCOL(x);
    }
    Q = NCOL(y);

    B = 1;
    if (XLENGTH(block) > 0)
        B = NLEVELS(block);

    Lx = NLEVELS(ix);
    Ly = NLEVELS(iy);
    

    PROTECT(ans = RC_init_LECV_2d(P, Q, INTEGER(varonly)[0],
                                  Lx, Ly, B, Xfactor, REAL(tol)[0]));

    if (B == 1) {
        RC_TwoTableSums(INTEGER(ix), N, Lx + 1, INTEGER(iy), Ly + 1,
                        weights, subset, Offset0, Nsubset,
                        C_get_Table(ans));
    } else {
        RC_ThreeTableSums(INTEGER(ix), N, Lx + 1, INTEGER(iy), Ly + 1,
                          INTEGER(block), B, weights, subset, Offset0, Nsubset,
                          C_get_Table(ans));
    }
    RC_ExpectationCovarianceStatistic_2d(x, ix, y, iy, weights,
                                         subset, block, ans);

    UNPROTECT(1);
    return(ans);
}

/* R_PermutedLinearStatistic_2d */

/* R_PermutedLinearStatistic_2d Prototype */

SEXP R_PermutedLinearStatistic_2d
(
    /* R x Input */
    
    SEXP x,
    
    SEXP ix,
    /* R y Input */
    
    SEXP y,
    
    SEXP iy,
    /* R block Input */
    
    SEXP block
    ,
    SEXP nresample,
    SEXP itable
)

{
    SEXP ans, Ritable;
    int *csum, *rsum, *sumweights, *jwork, *table, *rtable2, maxn = 0, Lxp1, Lyp1, *btab, PQ, Xfactor;
    R_xlen_t inresample;
    double *fact, *linstat;

    /* Setup Dimensions 2d */
    
    int P, Q, B, Lx, Ly;

    if (XLENGTH(x) == 0) {
        P = NLEVELS(ix);
    } else {
        P = NCOL(x);
    }
    Q = NCOL(y);

    B = 1;
    if (XLENGTH(block) > 0)
        B = NLEVELS(block);

    Lx = NLEVELS(ix);
    Ly = NLEVELS(iy);
    

    PQ = mPQB(P, Q, 1);
    Xfactor = XLENGTH(x) == 0;
    Lxp1 = Lx + 1;
    Lyp1 = Ly + 1;
    inresample = (R_xlen_t) REAL(nresample)[0];

    PROTECT(ans = allocMatrix(REALSXP, PQ, inresample));

    /* Setup Working Memory */
    
    csum = R_Calloc(Lyp1 * B, int);
    rsum = R_Calloc(Lxp1 * B, int);
    sumweights = R_Calloc(B, int);
    table = R_Calloc(Lxp1 * Lyp1, int);
    rtable2 = R_Calloc(Lx * Ly , int);
    jwork = R_Calloc(Lyp1, int);
    

    /* Convert Table to Integer */
    
    PROTECT(Ritable = allocVector(INTSXP, LENGTH(itable)));
    for (int i = 0; i < LENGTH(itable); i++) {
        if (REAL(itable)[i] > INT_MAX)
            error("cannot deal with weights larger INT_MAX in R_PermutedLinearStatistic_2d");
        INTEGER(Ritable)[i] = (int) REAL(itable)[i];
    }
    

    for (int b = 0; b < B; b++) {
        btab = INTEGER(Ritable) + Lxp1 * Lyp1 * b;
        /* Col Row Total Sums */
        
        /* Remember: first row / column count NAs */
        /* column sums */
        for (int q = 1; q < Lyp1; q++) {
            csum[q] = 0;
            for (int p = 1; p < Lxp1; p++)
                csum[q] += btab[q * Lxp1 + p];
        }
        csum[0] = 0; /* NA */
        /* row sums */
        for (int p = 1; p < Lxp1; p++) {
            rsum[p] = 0;
            for (int q = 1; q < Lyp1; q++)
                rsum[p] += btab[q * Lxp1 + p];
        }
        rsum[0] = 0; /* NA */
        /* total sum */
        sumweights[b] = 0;
        for (int i = 1; i < Lxp1; i++) sumweights[b] += rsum[i];
        
        if (sumweights[b] > maxn) maxn = sumweights[b];
    }

    /* Setup Log-Factorials */
    
    fact = R_Calloc(maxn + 1, double);
    /* Calculate log-factorials.  fact[i] = lgamma(i+1) */
    fact[0] = fact[1] = 0.;
    for (int j = 2; j <= maxn; j++)
        fact[j] = fact[j - 1] + log(j);
    

    GetRNGstate();

    for (R_xlen_t np = 0; np < inresample; np++) {
        /* Setup Linear Statistic */
        
        if (np % 256 == 0) R_CheckUserInterrupt();
        linstat = REAL(ans) + PQ * np;
        for (int p = 0; p < PQ; p++)
            linstat[p] = 0.0;
        

        for (int p = 0; p < Lxp1 * Lyp1; p++)
            table[p] = 0;

        for (int b = 0; b < B; b++) {
            /* Compute Permuted Linear Statistic 2d */
            
            #if defined(R_VERSION) && R_VERSION >= R_Version(4, 1, 0)
                        S_rcont2(Lx, Ly,
                                 rsum + Lxp1 * b + 1,
                                 csum + Lyp1 * b + 1,
                                 sumweights[b], fact, jwork, rtable2);
            #else
                        S_rcont2(&Lx, &Ly,
                                 rsum + Lxp1 * b + 1,
                                 csum + Lyp1 * b + 1,
                                 sumweights + b, fact, jwork, rtable2);
            #endif

            for (int j1 = 1; j1 <= Lx; j1++) {
                for (int j2 = 1; j2 <= Ly; j2++)
                    table[j2 * Lxp1 + j1] = rtable2[(j2 - 1) * Lx + (j1 - 1)];
            }
            btab = table;
            /* Linear Statistic 2d */

            if (Xfactor) {
                for (int j = 1; j < Lyp1; j++) {     /* j = 0 means NA */
                    for (int i = 1; i < Lxp1; i++) { /* i = 0 means NA */
                        for (int q = 0; q < Q; q++)
                            linstat[q * (Lxp1 - 1) + (i - 1)] +=
                                btab[j * Lxp1 + i] * REAL(y)[q * Lyp1 + j];
                    }
                }
            } else {
                for (int p = 0; p < P; p++) {
                    for (int q = 0; q < Q; q++) {
                        int qPp = q * P + p;
                        int qLy = q * Lyp1;
                        for (int i = 0; i < Lxp1; i++) {
                            int pLxi = p * Lxp1 + i;
                            for (int j = 0; j < Lyp1; j++)
                                linstat[qPp] += REAL(y)[qLy + j] * REAL(x)[pLxi] * btab[j * Lxp1 + i];
                        }
                    }
                }
            }
            
            
        }
    }

    PutRNGstate();

    R_Free(csum); R_Free(rsum); R_Free(sumweights); R_Free(rtable2);
    R_Free(jwork); R_Free(fact); R_Free(table);
    UNPROTECT(2);
    return(ans);
}


/* Tests */

/* R_QuadraticTest */

/* R_QuadraticTest Prototype */

SEXP R_QuadraticTest
(
    /* R LECV Input */
    
    SEXP LECV
    ,
    SEXP pvalue,
    SEXP lower,
    SEXP give_log,
    SEXP PermutedStatistics
)

{
    SEXP ans, stat, pval, names, permstat;
    double *MPinv, *ls, st, pst, *ex;
    int rank, P, Q, PQ, greater = 0;
    R_xlen_t nresample;

    /* Setup Test Memory */
    
    P = C_get_P(LECV);
    Q = C_get_Q(LECV);
    PQ = mPQB(P, Q, 1);

    if (C_get_varonly(LECV) && PQ > 1)
            error("cannot compute adjusted p-value based on variances only");
    /*  if (C_get_nresample(LECV) > 0 && INTEGER(PermutedStatistics)[0]) { */
        PROTECT(ans = allocVector(VECSXP, 3));
        PROTECT(names = allocVector(STRSXP, 3));
        SET_VECTOR_ELT(ans, 2, permstat = allocVector(REALSXP, C_get_nresample(LECV)));
        SET_STRING_ELT(names, 2, mkChar("PermutedStatistics"));
    /*  } else {
        PROTECT(ans = allocVector(VECSXP, 2));
        PROTECT(names = allocVector(STRSXP, 2));
    }
    */
    SET_VECTOR_ELT(ans, 0, stat = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 0, mkChar("TestStatistic"));
    SET_VECTOR_ELT(ans, 1, pval = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 1, mkChar("p.value"));
    namesgets(ans, names);
    REAL(pval)[0] = NA_REAL;
    int LOWER = INTEGER(lower)[0];
    int GIVELOG = INTEGER(give_log)[0];
    int PVALUE = INTEGER(pvalue)[0];
    int PSTAT = INTEGER(PermutedStatistics)[0];
    

    MPinv = R_Calloc(PP12(PQ), double); /* was: C_get_MPinv(LECV); */
    C_MPinv_sym(C_get_Covariance(LECV), PQ, C_get_tol(LECV), MPinv, &rank);

    REAL(stat)[0] = C_quadform(PQ, C_get_LinearStatistic(LECV),
                               C_get_Expectation(LECV), MPinv);

    if (!PVALUE) {
        UNPROTECT(2);
        R_Free(MPinv);
        return(ans);
    }

    if (C_get_nresample(LECV) == 0) {
        REAL(pval)[0] = C_chisq_pvalue(REAL(stat)[0], rank, LOWER, GIVELOG);
    } else {
        nresample = C_get_nresample(LECV);
        ls = C_get_PermutedLinearStatistic(LECV);
        st = REAL(stat)[0];
        ex = C_get_Expectation(LECV);
        greater = 0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            pst = C_quadform(PQ, ls + PQ * np, ex, MPinv);
            if (GE(pst, st, C_get_tol(LECV)))
                greater++;
            if (PSTAT) REAL(permstat)[np] = pst;
        }
        REAL(pval)[0] = C_perm_pvalue(greater, nresample, LOWER, GIVELOG);
    }

    UNPROTECT(2);
    R_Free(MPinv);
    return(ans);
}

/* R_MaximumTest */

/* R_MaximumTest Prototype */

SEXP R_MaximumTest
(
    /* R LECV Input */
    
    SEXP LECV
    ,
    SEXP alternative,
    SEXP pvalue,
    SEXP lower,
    SEXP give_log,
    SEXP PermutedStatistics,
    SEXP maxpts,
    SEXP releps,
    SEXP abseps
)

{
    SEXP ans, stat, pval, names, permstat;
    double st, pst, *ex, *cv, *ls, tl;
    int P, Q, PQ, vo, alt, greater;
    R_xlen_t nresample;

    /* Setup Test Memory */
    
    P = C_get_P(LECV);
    Q = C_get_Q(LECV);
    PQ = mPQB(P, Q, 1);

    if (C_get_varonly(LECV) && PQ > 1)
            error("cannot compute adjusted p-value based on variances only");
    /*  if (C_get_nresample(LECV) > 0 && INTEGER(PermutedStatistics)[0]) { */
        PROTECT(ans = allocVector(VECSXP, 3));
        PROTECT(names = allocVector(STRSXP, 3));
        SET_VECTOR_ELT(ans, 2, permstat = allocVector(REALSXP, C_get_nresample(LECV)));
        SET_STRING_ELT(names, 2, mkChar("PermutedStatistics"));
    /*  } else {
        PROTECT(ans = allocVector(VECSXP, 2));
        PROTECT(names = allocVector(STRSXP, 2));
    }
    */
    SET_VECTOR_ELT(ans, 0, stat = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 0, mkChar("TestStatistic"));
    SET_VECTOR_ELT(ans, 1, pval = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 1, mkChar("p.value"));
    namesgets(ans, names);
    REAL(pval)[0] = NA_REAL;
    int LOWER = INTEGER(lower)[0];
    int GIVELOG = INTEGER(give_log)[0];
    int PVALUE = INTEGER(pvalue)[0];
    int PSTAT = INTEGER(PermutedStatistics)[0];
    

    if (C_get_varonly(LECV)) {
        cv = C_get_Variance(LECV);
    } else {
        cv = C_get_Covariance(LECV);
    }
    REAL(stat)[0] = C_maxtype(PQ, C_get_LinearStatistic(LECV),
        C_get_Expectation(LECV), cv, C_get_varonly(LECV), C_get_tol(LECV),
        INTEGER(alternative)[0]);
    if (!PVALUE) {
        UNPROTECT(2);
        return(ans);
    }

    if (C_get_nresample(LECV) == 0) {
        if (C_get_varonly(LECV) && PQ > 1) {
            REAL(pval)[0] = NA_REAL;
            UNPROTECT(2);
            return(ans);
        }
        REAL(pval)[0] = C_maxtype_pvalue(REAL(stat)[0], cv,
            PQ, INTEGER(alternative)[0], LOWER, GIVELOG, INTEGER(maxpts)[0],
            REAL(releps)[0], REAL(abseps)[0], C_get_tol(LECV));
    } else {
        nresample = C_get_nresample(LECV);
        ls = C_get_PermutedLinearStatistic(LECV);
        ex = C_get_Expectation(LECV);
        vo = C_get_varonly(LECV);
        alt = INTEGER(alternative)[0];
        st = REAL(stat)[0];
        tl = C_get_tol(LECV);
        greater = 0;
        for (R_xlen_t np = 0; np < nresample; np++) {
            pst = C_maxtype(PQ, ls + PQ * np, ex, cv, vo, tl, alt);
            if (alt == ALTERNATIVE_less) {
                if (LE(pst, st, tl)) greater++;
            } else {
                if (GE(pst, st, tl)) greater++;
            }
            if (PSTAT) REAL(permstat)[np] = pst;
        }
        REAL(pval)[0] = C_perm_pvalue(greater, nresample, LOWER, GIVELOG);
    }
    UNPROTECT(2);
    return(ans);
}

/* R_MaximallySelectedTest */

/* R_MaximallySelectedTest Prototype */

SEXP R_MaximallySelectedTest
(
    SEXP LECV,
    SEXP ordered,
    SEXP teststat,
    SEXP minbucket,
    SEXP lower,
    SEXP give_log
)

{
    SEXP ans, index, stat, pval, names, permstat;
    int P, mb;

    P = C_get_P(LECV);
    mb = INTEGER(minbucket)[0];

    PROTECT(ans = allocVector(VECSXP, 4));
    PROTECT(names = allocVector(STRSXP, 4));
    SET_VECTOR_ELT(ans, 0, stat = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 0, mkChar("TestStatistic"));
    SET_VECTOR_ELT(ans, 1, pval = allocVector(REALSXP, 1));
    SET_STRING_ELT(names, 1, mkChar("p.value"));
    SET_VECTOR_ELT(ans, 3, permstat = allocVector(REALSXP, C_get_nresample(LECV)));
    SET_STRING_ELT(names, 3, mkChar("PermutedStatistics"));
    REAL(pval)[0] = NA_REAL;

    if (INTEGER(ordered)[0]) {
        SET_VECTOR_ELT(ans, 2, index = allocVector(INTSXP, 1));
        C_ordered_Xfactor(LECV, mb, INTEGER(teststat)[0],
                          INTEGER(index), REAL(stat), REAL(permstat),
                          REAL(pval), INTEGER(lower)[0],
                          INTEGER(give_log)[0]);
        if (REAL(stat)[0] > 0)
            INTEGER(index)[0]++; /* R style indexing */
    } else {
        SET_VECTOR_ELT(ans, 2, index = allocVector(INTSXP, P));
        C_unordered_Xfactor(LECV, mb, INTEGER(teststat)[0],
                            INTEGER(index), REAL(stat), REAL(permstat),
                            REAL(pval), INTEGER(lower)[0],
                            INTEGER(give_log)[0]);
    }

    SET_STRING_ELT(names, 2, mkChar("index"));
    namesgets(ans, names);

    UNPROTECT(2);
    return(ans);
}



