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