00001
00009 #include "party.h"
00010
00011
00022 SEXP R_Ensemble(SEXP learnsample, SEXP weights, SEXP fitmem, SEXP controls, SEXP ntrees) {
00023
00024 SEXP nweights, tree, where, ans;
00025 double *dnweights, *dweights, sw = 0.0, *prob;
00026 int nobs, i, b, B , nodenum = 1, *iweights, *iwhere;
00027
00028 B = INTEGER(ntrees)[0];
00029 nobs = get_nobs(learnsample);
00030 PROTECT(ans = allocVector(VECSXP, B));
00031
00032 iweights = Calloc(nobs, int);
00033 prob = Calloc(nobs, double);
00034 dweights = REAL(weights);
00035
00036 for (i = 0; i < nobs; i++)
00037 sw += dweights[i];
00038 for (i = 0; i < nobs; i++)
00039 prob[i] = dweights[i]/sw;
00040
00041 for (b = 0; b < B; b++) {
00042 SET_VECTOR_ELT(ans, b, tree = allocVector(VECSXP, NODE_LENGTH + 1));
00043 SET_VECTOR_ELT(tree, NODE_LENGTH, where = allocVector(INTSXP, nobs));
00044 iwhere = INTEGER(where);
00045 for (i = 0; i < nobs; i++) iwhere[i] = 0;
00046
00047 C_init_node(tree, nobs, get_ninputs(learnsample),
00048 get_maxsurrogate(get_splitctrl(controls)),
00049 ncol(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym),
00050 PL2_jointtransfSym)));
00051
00052
00053 GetRNGstate();
00054 rmultinom((int) sw, prob, nobs, iweights);
00055 PutRNGstate();
00056
00057 nweights = S3get_nodeweights(tree);
00058 dnweights = REAL(nweights);
00059 for (i = 0; i < nobs; i++) dnweights[i] = (double) iweights[i];
00060
00061 C_TreeGrow(tree, learnsample, fitmem, controls, iwhere, &nodenum, 1);
00062 nodenum = 1;
00063 }
00064 Free(prob); Free(iweights);
00065 UNPROTECT(1);
00066 return(ans);
00067 }