00001
00009 #include "party.h"
00010
00011 void C_remove_weights(SEXP subtree) {
00012
00013 SET_VECTOR_ELT(subtree, S3_WEIGHTS, R_NilValue);
00014
00015 if (!S3get_nodeterminal(subtree)) {
00016 C_remove_weights(S3get_leftnode(subtree));
00017 C_remove_weights(S3get_rightnode(subtree));
00018 }
00019 }
00020
00021
00033 SEXP R_Ensemble(SEXP learnsample, SEXP weights, SEXP bwhere, SEXP bweights,
00034 SEXP fitmem, SEXP controls) {
00035
00036 SEXP nweights, tree, where, ans, bw;
00037 double *dnweights, *dweights, sw = 0.0, *prob, tmp;
00038 int nobs, i, b, B , nodenum = 1, *iweights, *iweightstmp,
00039 *iwhere, replace, fraction, wgrzero = 0, realweights = 0;
00040
00041 B = get_ntree(controls);
00042 nobs = get_nobs(learnsample);
00043
00044 PROTECT(ans = allocVector(VECSXP, B));
00045
00046 iweights = Calloc(nobs, int);
00047 iweightstmp = Calloc(nobs, int);
00048 prob = Calloc(nobs, double);
00049 dweights = REAL(weights);
00050
00051 for (i = 0; i < nobs; i++) {
00052
00053 sw += dweights[i];
00054
00055 if (dweights[i] > 0) wgrzero++;
00056
00057 if (dweights[i] - ftrunc(dweights[i]) > 0)
00058 realweights = 1;
00059 }
00060 for (i = 0; i < nobs; i++)
00061 prob[i] = dweights[i]/sw;
00062
00063 replace = get_replace(controls);
00064
00065 if (realweights) {
00066
00067 tmp = (get_fraction(controls) * wgrzero);
00068 } else {
00069
00070 tmp = (get_fraction(controls) * sw);
00071 }
00072 fraction = (int) ftrunc(tmp);
00073 if (ftrunc(tmp) < tmp) fraction++;
00074
00075 if (!replace) {
00076 if (fraction < 10)
00077 error("fraction of %f is too small", fraction);
00078 }
00079
00080
00081
00082 GetRNGstate();
00083
00084 for (b = 0; b < B; b++) {
00085 SET_VECTOR_ELT(ans, b, tree = allocVector(VECSXP, NODE_LENGTH + 1));
00086 SET_VECTOR_ELT(bwhere, b, where = allocVector(INTSXP, nobs));
00087 SET_VECTOR_ELT(bweights, b, bw = allocVector(REALSXP, nobs));
00088
00089 iwhere = INTEGER(where);
00090 for (i = 0; i < nobs; i++) iwhere[i] = 0;
00091
00092 C_init_node(tree, nobs, get_ninputs(learnsample),
00093 get_maxsurrogate(get_splitctrl(controls)),
00094 ncol(get_predict_trafo(GET_SLOT(learnsample,
00095 PL2_responsesSym))));
00096
00097
00098 if (replace) {
00099
00100 rmultinom((int) sw, prob, nobs, iweights);
00101 } else {
00102
00103 C_SampleSplitting(nobs, prob, iweights, fraction);
00104 }
00105
00106 nweights = S3get_nodeweights(tree);
00107 dnweights = REAL(nweights);
00108 for (i = 0; i < nobs; i++) {
00109 REAL(bw)[i] = (double) iweights[i];
00110 dnweights[i] = REAL(bw)[i];
00111 }
00112
00113 C_TreeGrow(tree, learnsample, fitmem, controls, iwhere, &nodenum, 1);
00114 nodenum = 1;
00115 C_remove_weights(tree);
00116 }
00117
00118 PutRNGstate();
00119
00120 Free(prob); Free(iweights); Free(iweightstmp);
00121 UNPROTECT(1);
00122 return(ans);
00123 }