Main Page | Directories | File List | File Members | Related Pages

# Convenience.c

Go to the documentation of this file.

    00001
    00009 #include "party.h"
    00010
    00011
    00026 void C_LinStatExpCov(const double *x, const int p,
    00027                      const double *y, const int q,
    00028                      const double *weights, const int n,
    00029                      const int cexpcovinf, SEXP expcovinf, SEXP ans) {
    00030
    00031     C_LinearStatistic(x, p, y, q, weights, n,
    00032                       REAL(GET_SLOT(ans, PL2_linearstatisticSym)));
    00033     if (cexpcovinf)
    00034         C_ExpectCovarInfluence(y, q, weights, n, expcovinf);
    00035     C_ExpectCovarLinearStatistic(x, p, y, q, weights, n,
    00036                                  expcovinf, ans);
    00037 }
    00038
    00039
    00046 void C_LinStatExpCovMPinv(SEXP linexpcov, double tol) {
    00047     C_MPinv(GET_SLOT(linexpcov, PL2_covarianceSym), tol,
    00048             GET_SLOT(linexpcov, PL2_svdmemSym), linexpcov);
    00049 }
    00050
    00051
    00059 void C_MLinearStatistic(SEXP linexpcov, SEXP ScoreMatrix, SEXP ans) {
    00060
    00061     int nr, nc, pq;
    00062     double *dummy;
    00063
    00064     nr = nrow(ScoreMatrix);
    00065     nc = ncol(ScoreMatrix);
    00066     pq = get_dimension(linexpcov);
    00067     dummy = Calloc(nr * pq, double);
    00068
    00069     C_matprod(REAL(ScoreMatrix), nrow(ScoreMatrix), ncol(ScoreMatrix),
    00070               REAL(GET_SLOT(linexpcov, PL2_linearstatisticSym)), pq, 1,
    00071               REAL(GET_SLOT(ans, PL2_linearstatisticSym)));
    00072     C_matprod(REAL(ScoreMatrix), nr, nc,
    00073               REAL(GET_SLOT(linexpcov, PL2_expectationSym)), pq, 1,
    00074               REAL(GET_SLOT(ans, PL2_expectationSym)));
    00075     C_matprod(REAL(ScoreMatrix), nr, nc,
    00076               REAL(GET_SLOT(linexpcov, PL2_covarianceSym)), pq, pq,
    00077               dummy);
    00078     C_matprodT(dummy, nr, pq, REAL(ScoreMatrix), nr, nc,
    00079                REAL(GET_SLOT(ans, PL2_covarianceSym)));
    00080     Free(dummy);
    00081 }
    00082
    00083
    00091 double C_TestStatistic(const SEXP linexpcov, const int type, const double tol) {
    00092
    00093     int pq;
    00094     double ans = 0.0;
    00095
    00096     pq = get_dimension(linexpcov);
    00097
    00098     switch(type) {
    00099         /* maxabs-type test statistic */
    00100         case 1:
    00101             ans = C_maxabsTestStatistic(
    00102                 REAL(GET_SLOT(linexpcov, PL2_linearstatisticSym)),
    00103                 REAL(GET_SLOT(linexpcov, PL2_expectationSym)),
    00104                 REAL(GET_SLOT(linexpcov, PL2_covarianceSym)),
    00105                 pq, tol);
    00106             break;
    00107         /* quadform-type test statistic */
    00108         case 2:
    00109             ans = C_quadformTestStatistic(
    00110                 REAL(GET_SLOT(linexpcov, PL2_linearstatisticSym)),
    00111                 REAL(GET_SLOT(linexpcov, PL2_expectationSym)),
    00112                 REAL(GET_SLOT(linexpcov, PL2_MPinvSym)), pq);
    00113             break;
    00114         default: error("C_TestStatistic: undefined value for type argument");
    00115     }
    00116     return(ans);
    00117 }
    00118
    00119
    00131 double C_ConditionalPvalue(const double tstat, SEXP linexpcov,
    00132                            const int type, double tol,
    00133                            int *maxpts, double *releps, double *abseps) {
    00134
    00135     int pq;
    00136     double ans = 0.0;
    00137
    00138     pq = get_dimension(linexpcov);
    00139
    00140     switch(type) {
    00141         /* maxabs-type test statistic */
    00142         case MAXABS:
    00143             ans = C_maxabsConditionalPvalue(tstat,
    00144                 REAL(GET_SLOT(linexpcov, PL2_covarianceSym)),
    00145                 pq, maxpts, releps, abseps, &tol);
    00146             break;
    00147         /* quadform-type test statistic */
    00148         case QUADFORM:
    00149             ans = C_quadformConditionalPvalue(tstat,
    00150                 REAL(GET_SLOT(linexpcov, PL2_rankSym))[0]);
    00151             break;
    00152         default: error("C_ConditionalPvalue: undefined value for type argument");
    00153     }
    00154     return(ans);
    00155 }
    00156
    00157
    00163 SEXP R_get_response(SEXP learnsample) {
    00164     return(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
    00165                                PL2_variablesSym), 0));
    00166 }
    00167
    00168
    00175 void R_set_response(SEXP learnsample, SEXP y) {
    00176
    00177     double *v, *t, *j, *dy;
    00178     int i, n;
    00179
    00180     n = LENGTH(y);
    00181     dy = REAL(y);
    00182
    00183     if (LENGTH(R_get_response(learnsample)) != n)
    00184         error("lengths of arguments don't match");
    00185
    00186     v = REAL(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
    00187                                  PL2_variablesSym), 0));
    00188     t = REAL(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
    00189                                  PL2_transformationsSym), 0));
    00190     j = REAL(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
    00191                       PL2_jointtransfSym));
    00192
    00193     for (i = 0; i < n; i++) {
    00194         v[i] = dy[i];
    00195         t[i] = dy[i];
    00196         j[i] = dy[i];
    00197     }
    00198 }