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