Come modificare le metriche utilizzando la libreria (caret)?

Question

Vorrei cambiare la metrica da RMSE al RMSLE utilizzando il

caret library 

Dato alcuni dati di esempio:

ivar1<-rnorm(500, mean = 3, sd = 1) 
    ivar2<-rnorm(500, mean = 4, sd = 1) 
    ivar3<-rnorm(500, mean = 5, sd = 1) 
    ivar4<-rnorm(500, mean = 4, sd = 1) 
    dvar<-rpois(500, exp(3+ 0.1*ivar1 - 0.25*ivar2)) 

    data<-data.frame(dvar,ivar4,ivar3,ivar2,ivar1) 



    ctrl <- rfeControl(functions=rfFuncs, 
        method="cv", 
        repeats = 5, 
        verbose = FALSE, 
        number=5) 

model <- rfe(data[,2:4], data[,1], sizes=c(1:4), rfeControl=ctrl) 

Qui vorrei cambiare per RMSLE e mantenere l'idea del grafico

plot <-ggplot(model,type=c("g", "o"), metric="RMSE")+ scale_x_continuous(breaks = 2:4, labels = names(data)[2:4]) 

Answer 1

Non so come/se è possibile convertire facilmente RMSE in RMSLE, quindi è possibile provare a cambiare la funzione di controllo.

Vedere rfFuncs$summary chiama una funzione postResample. Questo è dove il RMSE è calcolato - consultare la sezione

mse <- mean((pred - obs)^2) 
n <- length(obs) 
out <- c(sqrt(mse), resamplCor^2) 

Quindi è possibile modificare questa funzione per calcolare il RMSLE invece:

msle <- mean((log(pred) - log(obs))^2) 
out <- sqrt(msle) 
} 
names(out) <- "RMSLE" 

Poi se questa funzione modificato è stato salvato in una funzione chiamata mypostResample, è quindi necessario aggiornare il rfFuncs$summary.

---

Quindi tutto:

primo aggiornamento la funzione di sintesi - questo chiamerà la nuova funzione con RMSLE

newSumm <- function (data, lev = NULL, model = NULL) 
      { 
      if (is.character(data$obs)) 
      data$obs <- factor(data$obs, levels = lev) 
      mypostResample(data[, "pred"], data[, "obs"]) 
      } 

quindi definire nuova funzione per calcolare RMSLE

mypostResample <- function (pred, obs) 
       { 
       isNA <- is.na(pred) 
       pred <- pred[!isNA] 
       obs <- obs[!isNA] 

       msle <- mean((log(pred) - log(obs))^2) 
       out <- sqrt(msle) 
       names(out) <- "RMSLE" 

       if (any(is.nan(out))) 
        out[is.nan(out)] <- NA 
       out 
       } 

Aggiorna rfFuncs

# keep old settings for future use 
oldSumm <- rfFuncs$summary 

# update with new function 
rfFuncs$summary <- newSumm 

ctrl <- rfeControl(functions=rfFuncs, 
        method="cv", 
        repeats = 5, 
        verbose = FALSE, 
        number=5) 
set.seed(1) 
model <- rfe(data[,2:4], data[,1], sizes=c(1:4), rfeControl=ctrl, metric="RMSLE") 

# plot 
ggplot(model,type=c("g", "o"), metric="RMSLE")+ scale_x_continuous(breaks = 2:4, labels = names(data)[2:4])