R/err.w.sample.R

In thomaswiemann/SMLpractical:

#' Create weighted bootstrap sample to create expert Forests
#'
#' @param x is an object
#' @return y is the output
#' @export

err.w.sample <- function(y.train_0, y.test, y.hat,
                         n.train, n.test,
                         err.ctry=matrix(99,ncol=26,nrow=1), uniq.crty){
  err.ctry <- pmin(err.ctry, t(table(y.test[!as.character(y.hat)==as.character(y.test)])))
  prob.ctry <- (2*err.ctry)/sum(2*err.ctry)

  prob <- matrix(0, nrow=n.train,1)
  for(ctry in 1:26){
    boolean <- as.character(y.train_0)==as.character(uniq.crty[ctry])
    prob[boolean] <- prob.ctry[ctry]*matrix(1, nrow=sum(boolean), 1)
  }

  new.train <- sample(c(1:n.train), size=n.train, replace=TRUE, prob = prob)
  return(list(new.train=new.train,err.ctry=err.ctry))
}