Làm cách nào để thay đổi số liệu bằng cách sử dụng thư viện (dấu mũ)?

Question

Tôi muốn thay đổi số liệu từ RMSE để RMSLE sử dụng

caret library 

Với một số dữ liệu mẫu:

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) 

Ở đây tôi muốn thay đổi để RMSLE và giữ ý tưởng của đồ thị

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

Answer 1

Không chắc chắn cách/nếu bạn có thể dễ dàng chuyển đổi RMSE thành RMSLE, vì vậy bạn có thể thử thay đổi chức năng điều khiển.

Nhìn vào rfFuncs$summary nó gọi một hàm postResample. Đây là nơi các RMSE được tính - nhìn vào phần

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

Vì vậy, bạn có thể sửa đổi chức năng này để tính toán RMSLE thay vì:

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

Sau đó, nếu chức năng sửa đổi này đã được lưu trong một chức năng gọi là mypostResample, sau đó bạn cần cập nhật rfFuncs$summary.

---

Vì vậy, hoàn toàn:

Đầu tiên cập nhật các chức năng tóm tắt - điều này sẽ gọi hàm mới với 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"]) 
      } 

Sau đó, xác định chức năng mới để tính toán 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 
       } 

Cập nhật 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])