RandomForest.c

Go to the documentation of this file.
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          /* sum of weights */
00042          sw += dweights[i];
00043          /* number of weights > 0 */
00044          if (dweights[i] > 0) wgrzero++;
00045          /* case weights or real weights? */
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      /* fraction of number of obs with weight > 0 */
00054      if (realweights) {
00055          /* fraction of number of obs with weight > 0 for real weights*/
00056          tmp = (get_fraction(controls) * wgrzero);
00057      } else {
00058          /* fraction of sum of weights for case weights */
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      /* <FIXME> can we call those guys ONCE? what about the deeper
00070          calls??? </FIXME> */
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          /* generate altered weights for perturbation */
00087          if (replace) {
00088              /* weights for a bootstrap sample */
00089              rmultinom((int) sw, prob, nobs, iweights);
00090          } else {
00091              /* weights for sample splitting */
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);
00105      }
00106 
00107      PutRNGstate();
00108 
00109      Free(prob); Free(iweights); Free(iweightstmp);
00110      UNPROTECT(1);
00111      return(ans);
00112 }

Generated on Fri Nov 30 16:04:21 2007 for party by  doxygen 1.4.6