00001 00009 #include "party.h" 00010 00011 00023 void C_standardize(const double *t, const double *mu, const double *Sigma, 00024 int pq, double tol, double *ans) { 00025 00026 int i; 00027 double sd; 00028 00029 for (i = 0; i < pq; i++) { 00030 sd = Sigma[i*pq + i]; 00031 if (sd > tol) 00032 ans[i] = (t[i] - mu[i])/sqrt(sd); 00033 else 00034 ans[i] = 0.0; 00035 } 00036 } 00037 00038 00049 void C_absstandardize(const double *t, const double *mu, const double *Sigma, 00050 int pq, double tol, double *ans) { 00051 00052 C_standardize(t, mu, Sigma, pq, tol, ans); 00053 C_abs(ans, pq); 00054 } 00055 00056 00066 double C_maxabsTestStatistic(const double *t, const double *mu, const double *Sigma, 00067 int pq, double tol) { 00068 00069 double *mem, ans; 00070 00071 mem = Calloc(pq, double); 00072 C_absstandardize(t, mu, Sigma, pq, tol, mem); 00073 ans = C_max(mem, pq); 00074 Free(mem); 00075 return(ans); 00076 } 00077 00078 00087 SEXP R_maxabsTestStatistic(SEXP t, SEXP mu, SEXP Sigma, SEXP tol) { 00088 00089 SEXP ans; 00090 int pq; 00091 00092 pq = LENGTH(t); 00093 00094 PROTECT(ans = allocVector(REALSXP, 1)); 00095 REAL(ans)[0] = C_maxabsTestStatistic(REAL(t), REAL(mu), REAL(Sigma), pq, 00096 REAL(tol)[0]); 00097 UNPROTECT(1); 00098 return(ans); 00099 } 00100 00101 00110 double C_quadformTestStatistic(const double *t, const double *mu, 00111 const double *SigmaPlus, int pq) { 00112 00113 int i, j; 00114 double quadform = 0.0, *tmmu, *tmmuSigmaPlus; 00115 00116 tmmu = Calloc(pq, double); 00117 for (i = 0; i < pq; i++) 00118 tmmu[i] = t[i] - mu[i]; 00119 00120 tmmuSigmaPlus = Calloc(pq, double); 00121 for (i = 0; i < pq; i++) { 00122 tmmuSigmaPlus[i] = 0.0; 00123 for (j = 0; j < pq; j++) 00124 tmmuSigmaPlus[i] += tmmu[j] * SigmaPlus[i * pq + j]; 00125 quadform += tmmuSigmaPlus[i] * tmmu[i]; 00126 } 00127 00128 Free(tmmu); Free(tmmuSigmaPlus); 00129 return(quadform); 00130 } 00131 00132 00140 SEXP R_quadformTestStatistic(SEXP t, SEXP mu, SEXP SigmaPlus) { 00141 00142 SEXP ans; 00143 int pq; 00144 00145 pq = LENGTH(t); 00146 PROTECT(ans = allocVector(REALSXP, 1)); 00147 REAL(ans)[0] = C_quadformTestStatistic(REAL(t), 00148 REAL(mu), REAL(SigmaPlus), pq); 00149 UNPROTECT(1); 00150 return(ans); 00151 }