void rlm_compute_se_R(double *X, double *Y, int *n, int *p, double *beta, double *resids, double *weights, double *se_estimates, double *varcov, double *residSE, int *method){ rlm_compute_se(X, Y, *n, *p, beta, resids, weights, se_estimates, varcov, residSE, *method, psi_huber, 1.345); }
SEXP R_plmd_model(SEXP Y, SEXP PsiCode, SEXP PsiK, SEXP Groups, SEXP Ngroups){ SEXP R_return_value; SEXP R_weights; SEXP R_residuals; SEXP R_beta; SEXP R_SE; SEXP R_was_split; SEXP R_return_value_names; SEXP dim1; double *beta; double *residuals; double *weights; double *se; int *was_split; int *groups; double residSE; double *Ymat; double *X; /* Needed for SE */ int X_cols, X_rows; int rows; int cols; int ngroups; int howmany_split =0; int i; PROTECT(dim1 = getAttrib(Y,R_DimSymbol)); rows = INTEGER(dim1)[0]; cols = INTEGER(dim1)[1]; UNPROTECT(1); PROTECT(R_return_value = allocVector(VECSXP,5)); /* Don't allocate R_beta/R_SE straight away, we won't know how much space these will actually need until finishing the PLM-d fitting procedure. Instead we will just allocate those for which we currently know the size */ PROTECT(R_weights = allocMatrix(REALSXP,rows,cols)); PROTECT(R_residuals = allocMatrix(REALSXP,rows,cols)); PROTECT(R_was_split = allocVector(INTSXP,rows)); /* 0 - beta (added below) 1 - weights 2 - residuals 3 - standard errors (added below) 4 - R_was_split */ SET_VECTOR_ELT(R_return_value,1,R_weights); SET_VECTOR_ELT(R_return_value,2,R_residuals); SET_VECTOR_ELT(R_return_value,4,R_was_split); UNPROTECT(3); residuals = NUMERIC_POINTER(R_residuals); weights = NUMERIC_POINTER(R_weights); was_split = INTEGER_POINTER(R_was_split); groups = INTEGER_POINTER(Groups); ngroups = INTEGER(Ngroups)[0]; Ymat = NUMERIC_POINTER(Y); beta = Calloc(cols + rows*ngroups -1, double); se = Calloc(cols + rows*ngroups -1, double); plmd_fit(Ymat, rows, cols, ngroups, groups, was_split, beta, residuals, weights, PsiFunc(asInteger(PsiCode)),asReal(PsiK), 20); for (i = 0; i < rows; i++){ howmany_split+=was_split[i]; } if (howmany_split > 0){ PROTECT(R_beta = allocVector(REALSXP,rows + cols + howmany_split*(ngroups-1))); PROTECT(R_SE = allocVector(REALSXP,rows + cols + howmany_split*(ngroups-1))); X = plmd_get_design_matrix(rows, cols, ngroups, groups,was_split,&X_rows,&X_cols); rlm_compute_se(X,Ymat, X_rows, X_cols, beta, residuals, weights, se,(double *)NULL, &residSE, 2, PsiFunc(asInteger(PsiCode)),asReal(PsiK)); Free(X); for (i = cols; i < rows + cols + howmany_split*(ngroups-1) - 1; i++) beta[rows + cols + howmany_split*(ngroups-1) -1]-=beta[i]; for (i = 0; i < rows + cols + howmany_split*(ngroups-1) ; i++){ NUMERIC_POINTER(R_beta)[i] = beta[i]; NUMERIC_POINTER(R_SE)[i] = se[i]; } } else { /* Note use 2 rather than 4 for SE method */ rlm_compute_se_anova(Ymat, rows, cols, beta, residuals, weights,se, (double *) NULL, &residSE, 2, PsiFunc(asInteger(PsiCode)),asReal(PsiK)); beta[rows+cols -1] = 0.0; se[rows+cols -1] = 0.0; for (i = cols; i < rows + cols -1; i++) beta[rows+cols -1]-=beta[i]; PROTECT(R_beta = allocVector(REALSXP,rows+cols)); PROTECT(R_SE = allocVector(REALSXP,rows+cols)); for (i = 0; i < rows + cols; i++){ NUMERIC_POINTER(R_beta)[i] = beta[i]; NUMERIC_POINTER(R_SE)[i] = se[i]; } } Free(beta); Free(se); SET_VECTOR_ELT(R_return_value,0,R_beta); SET_VECTOR_ELT(R_return_value,3,R_SE); UNPROTECT(2); PROTECT(R_return_value_names= allocVector(STRSXP,5)); SET_VECTOR_ELT(R_return_value_names,0,mkChar("Estimates")); SET_VECTOR_ELT(R_return_value_names,1,mkChar("Weights")); SET_VECTOR_ELT(R_return_value_names,2,mkChar("Residuals")); SET_VECTOR_ELT(R_return_value_names,3,mkChar("StdErrors")); SET_VECTOR_ELT(R_return_value_names,4,mkChar("WasSplit")); setAttrib(R_return_value, R_NamesSymbol,R_return_value_names); UNPROTECT(2); return R_return_value; }