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
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
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
00142 case MAXABS:
00143 ans = C_maxabsConditionalPvalue(tstat,
00144 REAL(GET_SLOT(linexpcov, PL2_covarianceSym)),
00145 pq, maxpts, releps, abseps, &tol);
00146 break;
00147
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 }