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 double C_TestStatistic(const SEXP linexpcov, const int type, const double tol) {
00060
00061 int pq;
00062 double ans = 0.0;
00063
00064 pq = get_dimension(linexpcov);
00065
00066 switch(type) {
00067
00068 case 1:
00069 ans = C_maxabsTestStatistic(
00070 REAL(GET_SLOT(linexpcov, PL2_linearstatisticSym)),
00071 REAL(GET_SLOT(linexpcov, PL2_expectationSym)),
00072 REAL(GET_SLOT(linexpcov, PL2_covarianceSym)),
00073 pq, tol);
00074 break;
00075
00076 case 2:
00077 ans = C_quadformTestStatistic(
00078 REAL(GET_SLOT(linexpcov, PL2_linearstatisticSym)),
00079 REAL(GET_SLOT(linexpcov, PL2_expectationSym)),
00080 REAL(GET_SLOT(linexpcov, PL2_MPinvSym)), pq);
00081 break;
00082 default: error("C_TestStatistic: undefined value for type argument");
00083 }
00084 return(ans);
00085 }
00086
00087
00099 double C_ConditionalPvalue(const double tstat, SEXP linexpcov,
00100 const int type, double tol,
00101 int *maxpts, double *releps, double *abseps) {
00102
00103 int pq;
00104 double ans = 0.0;
00105
00106 pq = get_dimension(linexpcov);
00107
00108 switch(type) {
00109
00110 case MAXABS:
00111 ans = C_maxabsConditionalPvalue(tstat,
00112 REAL(GET_SLOT(linexpcov, PL2_covarianceSym)),
00113 pq, maxpts, releps, abseps, &tol);
00114 break;
00115
00116 case QUADFORM:
00117 ans = C_quadformConditionalPvalue(tstat,
00118 REAL(GET_SLOT(linexpcov, PL2_rankSym))[0]);
00119 break;
00120 default: error("C_ConditionalPvalue: undefined value for type argument");
00121 }
00122 return(ans);
00123 }
00124
00125
00131 SEXP R_get_response(SEXP learnsample) {
00132 return(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
00133 PL2_variablesSym), 0));
00134 }
00135
00136
00143 void R_set_response(SEXP learnsample, SEXP y) {
00144
00145 double *v, *t, *j, *dy;
00146 int i, n;
00147
00148 n = LENGTH(y);
00149 dy = REAL(y);
00150
00151 if (LENGTH(R_get_response(learnsample)) != n)
00152 error("lengths of arguments don't match");
00153
00154 v = REAL(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
00155 PL2_variablesSym), 0));
00156 t = REAL(VECTOR_ELT(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
00157 PL2_transformationsSym), 0));
00158 j = REAL(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
00159 PL2_jointtransfSym));
00160
00161 for (i = 0; i < n; i++) {
00162 v[i] = dy[i];
00163 t[i] = dy[i];
00164 j[i] = dy[i];
00165 }
00166 }