1#' @title Classification error 2#' @description Calculates the classification error 3#' 4#' @param actual A vector of the labels 5#' @param predicted A vector of predicted values 6#' @param \dots additional parameters to be passed the the s3 methods 7#' @param modelObject the model object. Currently supported \code{lm, glm, randomForest, glmerMod, gbm, rpart} 8#' 9#' @export 10 11ce <- function(...){ 12 UseMethod("ce") 13} 14 15#' @rdname ce 16#' @export 17ce.default <- function(actual, predicted, ...){ 18 ce_(actual, predicted) 19} 20 21#' @rdname ce 22#' @export 23ce.lm <- function(modelObject, ...){ 24 25 predicted <- modelObject$fitted.values 26 actual <- modelObject$residuals + predicted 27 28 ce.default(actual, predicted) 29} 30 31 32#' @rdname ce 33#' @export 34ce.glm <- function(modelObject, ...){ 35 36 family <- family(modelObject)[[1]] 37 if(any(family %in% c('binomial', 'poisson'))){ 38 actual <- modelObject$y 39 predicted <- modelObject$fitted.values 40 } else { 41 stop(paste0("family: ", family, " is not currently supported")) 42 } 43 44 ce.default(actual, predicted) 45} 46 47#' @rdname ce 48#' @export 49ce.randomForest <- function(modelObject, ...){ 50 51 actual <- as.numeric(modelObject$y) - 1 52 predicted <- predict(modelObject, type = 'prob')[,2] 53 54 ce.default(actual, predicted) 55} 56 57#' @rdname ce 58#' @export 59ce.glmerMod <- function(modelObject, ...){ 60 61 actual <- modelObject@resp$y 62 predicted <- modelObject@resp$mu 63 64 ce.default(actual, predicted) 65} 66 67#' @rdname ce 68#' @export 69ce.gbm <- function(modelObject, ...){ 70 71 actual <- modelObject$data$y 72 predicted <- modelObject$fit 73 74 ce.default(actual, predicted) 75} 76 77#' @rdname ce 78#' @export 79ce.rpart <- function(modelObject, ...){ 80 81 actual <- modelObject$y 82 predicted <- predict(modelObject) 83 84 msle.default(actual, predicted) 85} 86