Main Page | Directories | File List | File Members | Related Pages

RandomForest.c

Go to the documentation of this file.
00001 
00009 #include "party.h"
00010 
00011 
00021 SEXP R_Ensemble(SEXP learnsample, SEXP weights, SEXP fitmem, SEXP controls) {
00022             
00023      SEXP nweights, tree, where, ans;
00024      double *dnweights, *dweights, sw = 0.0, *prob, fraction;
00025      int nobs, i, b, B , nodenum = 1, *iweights, *iweightstmp, 
00026          *iwhere, replace;
00027      
00028      B = get_ntree(controls);
00029      nobs = get_nobs(learnsample);
00030      
00031      PROTECT(ans = allocVector(VECSXP, B));
00032 
00033      iweights = Calloc(nobs, int);
00034      iweightstmp = Calloc(nobs, int);
00035      prob = Calloc(nobs, double);
00036      dweights = REAL(weights);
00037 
00038      for (i = 0; i < nobs; i++)
00039          sw += dweights[i];
00040      for (i = 0; i < nobs; i++)
00041          prob[i] = dweights[i]/sw;
00042 
00043      replace = get_replace(controls);
00044      fraction = get_fraction(controls) * nobs;
00045 
00046      if (!replace) {
00047          if (fraction < 10)
00048              error("fraction of %f is too small", fraction);
00049      }
00050   
00051      for (b  = 0; b < B; b++) {
00052          SET_VECTOR_ELT(ans, b, tree = allocVector(VECSXP, NODE_LENGTH + 1));
00053          SET_VECTOR_ELT(tree, NODE_LENGTH, where = allocVector(INTSXP, nobs));
00054          iwhere = INTEGER(where);
00055          for (i = 0; i < nobs; i++) iwhere[i] = 0;
00056      
00057          C_init_node(tree, nobs, get_ninputs(learnsample), 
00058                      get_maxsurrogate(get_splitctrl(controls)),
00059                      ncol(GET_SLOT(GET_SLOT(learnsample, PL2_responsesSym), 
00060                           PL2_jointtransfSym)));
00061                           
00062          /* <FIXME> can we call those guys ONCE? what about the deeper
00063             calls??? </FIXME> */
00064          GetRNGstate();
00065 
00066          /* generate altered weights for perturbation */
00067          if (replace) {
00068              /* weights for a bootstrap sample */
00069              rmultinom((int) sw, prob, nobs, iweights);
00070          } else {
00071              /* weights for sample splitting */
00072              C_SampleNoReplace(iweightstmp, nobs, nobs, iweights);
00073              for (i = 0; i < nobs; i++) {
00074                  if (iweights[i] < fraction) {
00075                      iweights[i] = 1;
00076                  } else {
00077                     iweights[i] = 0;
00078                  } 
00079              }
00080          }
00081          PutRNGstate();
00082 
00083          nweights = S3get_nodeweights(tree);
00084          dnweights = REAL(nweights);
00085          for (i = 0; i < nobs; i++) dnweights[i] = (double) iweights[i];
00086      
00087          C_TreeGrow(tree, learnsample, fitmem, controls, iwhere, &nodenum, 1);
00088          nodenum = 1;
00089      }
00090 
00091 
00092      Free(prob); Free(iweights); Free(iweightstmp);
00093      UNPROTECT(1);
00094      return(ans);
00095 }

Generated on Fri Aug 25 14:30:01 2006 for party by  doxygen 1.4.4