RandomForest.c

Go to the documentation of this file.
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          /* sum of weights */
00053          sw += dweights[i];
00054          /* number of weights > 0 */
00055          if (dweights[i] > 0) wgrzero++;
00056          /* case weights or real weights? */
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      /* fraction of number of obs with weight > 0 */
00065      if (realweights) {
00066          /* fraction of number of obs with weight > 0 for real weights*/
00067          tmp = (get_fraction(controls) * wgrzero);
00068      } else {
00069          /* fraction of sum of weights for case weights */
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      /* <FIXME> can we call those guys ONCE? what about the deeper
00081          calls??? </FIXME> */
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          /* generate altered weights for perturbation */
00098          if (replace) {
00099              /* weights for a bootstrap sample */
00100              rmultinom((int) sw, prob, nobs, iweights);
00101          } else {
00102              /* weights for sample splitting */
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 }

Generated on Mon Jul 23 10:05:59 2007 for party by  doxygen 1.4.6