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 }
