R/fitRF.R

Defines functions predRF fitRF

# random forest
fitRF <- function(TD, par0 = NULL, TDout = NULL) {
  cat("Estimating random forest model........")
  PARAM <- readRDS("./input/PARAM.RDS")

  names(TD)[1] <- "y"
  ind0 <- abs(TD$y) < PARAM$RF$outl

  rf_feats <- names(TD)[-1]
  rf_feats <- rf_feats[ sapply(rf_feats, function(s)mean( is.na(TD[[s]]) )) < 0.01]

  TD <- na.omit( TD[ind0, c("y", rf_feats), with = FALSE] )

  out <- list(fit = randomForest(y = TD[, y], x = TD[, rf_feats, with = FALSE],
                                 nodesize = PARAM$RF$nodesize, ntree = PARAM$RF$ntree, do.trace = FALSE),
              feats = rf_feats,
              predf = predRF)

  cat("   DONE\n")

  out
}

predRF <- function(l, newX, ...) {
  lipsis <- list(...)

  if(is.null(lipsis$base_pred)){
    base_pred <- 0
  }else{
    base_pred <- lipsis$base_pred
  }

  NAmat <- sapply(newX[, l$feats, with = FALSE], is.na)
  ind0 <- apply(NAmat, 1, sum) == 0

  pred <- predict(l$fit, newX[ind0, l$feats, with = FALSE])

  newX[, PRED := base_pred]; newX[ind0, PRED := pred]

  newX$PRED
}
steinarv/k1 documentation built on Oct. 19, 2017, 4:41 a.m.