I'm trying to use the rfe function from caret package but i can't make it work for the gbm model using the ROC metric.
I found some insights there:
Feature Selection in caret rfe + sum with ROC
http://www.cybaea.net/Blogs/Feature-selection-Using-the-caret-package.html
I've ended with this piece of code :
gbmFuncs <- treebagFuncs
gbmFuncs$fit <- function (x, y, first, last, ...) {
library("gbm")
n.levels <- length(unique(y))
if ( n.levels == 2 ) {
distribution = "bernoulli"
} else {
distribution = "gaussian"
}
gbm.fit(x, y, distribution = distribution, ...)
}
gbmFuncs$pred <- function (object, x) {
n.trees <- suppressWarnings(gbm.perf(object,
plot.it = FALSE,
method = "OOB"))
if ( n.trees <= 0 ) n.trees <- object$n.trees
predict(object, x, n.trees = n.trees, type = "link")
}
control <- rfeControl(functions = gbmFuncs, method = "cv", verbose = TRUE, returnResamp="final",
number = 5)
trainctrl <- trainControl(classProbs= TRUE,
summaryFunction = twoClassSummary)
gbmFit_bernoulli_sel <- rfe(data_model[x, -as.numeric(y)+2,
sizes=c(10, 15, 20, 30, 40, 50), rfeControl = control, verbose = FALSE,
interaction.depth = 14, n.trees = 10000, shrinkage = .01, metric="ROC",
trControl = trainctrl)
But I get this error :
Error in { :
task 1 failed - "argument inutilisé (trControl = list(method = "boot", number = 25, repeats = 25, p = 0.75, initialWindow = NULL, horizon = 1, fixedWindow = TRUE, verboseIter = FALSE, returnData = TRUE, returnResamp = "final", savePredictions = FALSE, classProbs = TRUE, summaryFunction = function (data, lev = NULL, model = NULL)
{
require(pROC)
if (!all(levels(data[, "pred"]) == levels(data[, "obs"]))) stop("levels of observed and predicted data do not match")
rocObject <- try(pROC::roc(data$obs, data[, lev[1]]), silent = TRUE)
rocAUC <- if (class(rocObject)[1] == "try-error") NA else rocObject$auc
out <- c(rocAUC, sensitivity(data[, "pred"], data[, "obs"], lev[1]), specificity(data[, "pred"], data[, "obs"], lev[2]))
names(out) <- c("ROC", "Sens", "Spec")
out
EDIT
Work with this code :
caretFuncs$summary <- twoClassSummary
controlrfe <- rfeControl(functions = caretFuncs, method = "cv", number = 3, verbose = TRUE)
gbmGrid <- expand.grid(interaction.depth = 5, n.trees = 1000, shrinkage = .01)
confroltrain <- trainControl(method = "none", classProbs=T, summaryFunction = twoClassSummary, verbose = TRUE)
gbmFit_bernoulli_sel <- rfe(data_model[,-ncol(data_model)], data_model[,ncol(data_model)],
sizes=c(10,15), rfeControl = controlrfe, metric="ROC",
trControl = confroltrain, tuneGrid=gbmGrid, method="gbm")
I had to use the train function because when I used gbmFuncs, I had some problem apparently because gbm.fit need a numeric target variable but the ROC metric evaluation need a factor.
Thanks for you help.
You are trying to pass trControl to gbm.fit. Connect the (three) dots =]
Try removing trControl = trainctrl.
Max
Related
When I use createFolds() and set k = 5, the model output says the Resampling was cross-validated (10 folds). However, the summary of sample sizes is 800, 800, 801, 800, 800 which correspond to my k = 5. Why the discrepancy?
library(liver)
library(caret)
library(dplyr)
data(churn)
head(churn)
churn_data <- churn
# minority = yes; majority = no
churn_data %>% group_by(churn) %>% count()
set.seed(1994)
train.index <- createDataPartition(churn_data$churn, p = 0.8, list = FALSE)
train_churn <- churn_data[train.index,]
test_churn <- churn_data[-train.index,]
myFolds <- createFolds(train_churn$churn, k = 5)
myControl <- trainControl(
summaryFunction = twoClassSummary,
classProbs = TRUE,
verboseIter = TRUE,
savePredictions = TRUE,
index = myFolds,
sampling = "up",
method = "cv")
set.seed(1994)
model_rf <- train(churn ~ .,
data = train_churn,
method = "rf",
ntree = 100,
tuneLength = 10,
metric = "ROC",
maximize = TRUE,
trControl = myControl)
model_rf
I am trying to implement the genetic algorithm for feature selection as done in the book Feature Engineering and Selection: A Practical Approach for Predictive Models
by Max Kuhn and Kjell Johnson. I copied the code from here https://github.com/topepo/FES/blob/master/12_Global_Search/12_03_Genetic_Algorithms.R
I keep getting this error, "cannot take a sample larger than the population when 'replace = FALSE'". For the sake of demonstration, I tried it on the churn data set. Also, I reduced the iterations from 15 to 1 to increase the speed.
library(caret)
library(liver)
data(churn)
head(churn)
set.seed(3456)
trainIndex <- createDataPartition(churn$churn, p = .8,
list = FALSE,
times = 1)
train <- churn[ trainIndex,]
test <- churn[-trainIndex,]
# ------------------------------------------------------------------------------
many_stats <-
function(data, lev = levels(data$obs), model = NULL) {
c(
twoClassSummary(data = data, lev = levels(data$obs), model),
prSummary(data = data, lev = levels(data$obs), model),
mnLogLoss(data = data, lev = levels(data$obs), model),
defaultSummary(data = data, lev = levels(data$obs), model)
)
}
# ------------------------------------------------------------------------------
ga_funcs <- caretGA
ga_funcs$fitness_extern <- many_stats
ga_funcs$initial <- function(vars, popSize, ...) {
x <- matrix(NA, nrow = popSize, ncol = vars)
probs <- seq(0.1, 0.90, length = popSize)
for (i in 1:popSize) {
x[i, ] <-
sample(0:1, replace = TRUE, size = vars, prob = c(probs[i], 1 - probs[i]))
}
var_count <- apply(x, 1, sum)
if (any(var_count == 0)) {
for (i in which(var_count == 0)) {
p <- sample(1:length(vars), size = 2)
x[i, p] <- 1
}
}
x
}
ctrl_rs <- trainControl(
method = "LGOCV",
p = 0.90,
number = 1,
summaryFunction = many_stats,
classProbs = TRUE,
allowParallel = FALSE
)
ga_ctrl <- gafsControl(
method = "cv",
metric = c(internal = "ROC", external = "ROC"),
maximize = c(internal = TRUE, external = TRUE),
functions = ga_funcs,
returnResamp = "all",
verbose = TRUE
)
options(digits = 3)
nb_grid <- data.frame(usekernel = TRUE, fL = 0, adjust = 1)
set.seed(325)
gen_algo <- gafs(
x = train[,-20],
y = train$churn,
data = train,
iters = 1,
gafsControl = ga_ctrl,
method = "nb",
tuneGrid = nb_grid,
trControl = ctrl_rs,
metric = "ROC"
)
The code specifies, "replace = TRUE", but clearly I am missing something. Any help is greatly appreciated!
Thanks!
I use Iris dataset to build a neuralnet model.
My goal is to use the caret package from R to predict the species class of various Iris flowers.
I try to train model with leave one out cross validation by caret.
formula.bpn <- setosa+versicolor+virginica ~ Sepal.Length+Sepal.Width+Petal.Length+Petal.Width
smp.size <- floor(0.8*nrow(data))
set.seed(542)
train.ind <- sample(seq_len(nrow(data)), smp.size)
train <- data[train.ind,]
test <- data[-train.ind,]
train.control <- trainControl(method="LOOCV",
search="grid",
verboseIter=FALSE,
returnData=TRUE,
returnResamp="final",
savePredictions="final",
# classProbs=TRUE,
selectionFunction="best",
indexFinal=NULL,
allowParallel=TRUE
)
model <- train(form=formula.bpn,
data=train,
method="neuralnet",
metric="RMSE",
maximize=FALSE,
trControl=train.control,
tuneGrid=expand.grid(.layer1=c(1:4), .layer2=c(0:4), .layer3=c(0)),
na.action=na.omit,
startweights=NULL,
algorithm="rprop+", # resilient backpropagation with weight backtracking
err.fct="sse",
act.fct="logistic",
threshold=0.01,
stepmax=5e10,
linear.output=FALSE
)
But I got the error : Error in cut.default(y, breaks, include.lowest = TRUE) : invalid number of intervals
This is the traceback :
11: stop("invalid number of intervals")
10: cut.default(y, breaks, include.lowest = TRUE)
9: cut(y, breaks, include.lowest = TRUE)
8: createFolds(outcome, n, returnTrain = TRUE)
7: make_resamples(trControl, outcome = y)
6: with_preserve_seed({
set_seed(list(seed = seed, rng_kind = rng_kind))
code
})
5: withr::with_seed(rs_seed, make_resamples(trControl, outcome = y))
4: train.default(x, y, weights = w, ...)
3: train(x, y, weights = w, ...)
2: train.formula(form = formula.bpn, data = train, method = "neuralnet",
metric = "RMSE", maximize = FALSE, trControl = train.control,
tuneGrid = expand.grid(.layer1 = c(1:4), .layer2 = c(0:4),
.layer3 = c(0)), na.action = na.omit, startweights = NULL,
algorithm = "rprop+", err.fct = "sse", act.fct = "logistic",
threshold = 0.01, stepmax = 5e+10, linear.output = FALSE)
1: train(form = formula.bpn, data = train, method = "neuralnet",
metric = "RMSE", maximize = FALSE, trControl = train.control,
tuneGrid = expand.grid(.layer1 = c(1:4), .layer2 = c(0:4),
.layer3 = c(0)), na.action = na.omit, startweights = NULL,
algorithm = "rprop+", err.fct = "sse", act.fct = "logistic",
threshold = 0.01, stepmax = 5e+10, linear.output = FALSE)
If I set form=setosa ~ Sepal.Length+Sepal.Width+Petal.Length+Petal.Width or versicolor ~ Sepal.Length+Sepal.Width+Petal.Length+Petal.Width or virginica ~ Sepal.Length+Sepal.Width+Petal.Length+Petal.Width, then train() can be performed normally.
How can I fix this error ?
I am using Caret R package to train an SVM modell. My code is as follows:
options(show.error.locations = TRUE)
svmTrain <- function(svmType, subsetSizes, data, seeds, metric){
svmFuncs$summary <- function(...) c(twoClassSummary(...), defaultSummary(...), prSummary(...))
data_x <- data.frame(data[,2:ncol(data)])
data_y <- unlist(data[,1])
FSctrl <- rfeControl(method = "cv",
number = 10,
rerank = TRUE,
verbose = TRUE,
functions = svmFuncs,
saveDetails = TRUE,
seeds = seeds
)
TRctrl <- trainControl(method = "cv",
savePredictions = TRUE,
classProbs = TRUE,
verboseIter = TRUE,
sampling = "down",
number = 10,
search = "random",
repeats = 3,
returnResamp = "all",
allowParallel = TRUE
)
svmProf <- rfe( x = data_x,
y = data_y,
sizes = subsetSizes,
metric = metric,
rfeControl = FSctrl,
method = svmType,
preProc = c("center", "scale"),
trControl = TRctrl,
selectSize = pickSizeBest(data, metric = "AUC", maximize = TRUE),
tuneLength = 5
)
}
data1a = openTable(3, 'a')
data1b = openTable(3, 'b')
data = rbind(data1a, data1b)
last <- roundToTens(ncol(data)-1)
subsetSizes <- c( 3:9, seq(10, last, 10) )
svmTrain <- svmTrain("svmRadial", subsetSizes, data, seeds, "AUC")
When I comment out pickSizeBest row, the algorithm runs fine. However, when I do not comment, it gives the following error:
Error in { (from svm.r#58) : task 1 failed - "Stopping"
Row 58 is svmProf <- rfe( x = data_x,..
I tried to look up if I use pickSizeBest the wrong way, but I cannot find the problem. Could somebody help me?
Many thanks!
EDIT: I just realized that pickSizeBest (data, ...) should not use data. However, I still do not know what should be add there.
I can't run your example, but I would suggest that you just pass the function pickSizeBest, i.e.:
[...]
trControl = TRctrl,
selectSize = pickSizeBest,
tuneLength = 5
[...]
The functionality is described here:
http://topepo.github.io/caret/recursive-feature-elimination.html#backwards-selection
When i only used mtry parameter as the tuingrid, it worked but when i added ntree parameter the error becomes Error in train.default(x, y, weights = w, ...): The tuning parameter grid should have columns mtry. The code is as below:
require(RCurl)
require(prettyR)
library(caret)
url <- "https://raw.githubusercontent.com/gastonstat/CreditScoring/master/CleanCreditScoring.csv"
cs_data <- getURL(url)
cs_data <- read.csv(textConnection(cs_data))
classes <- cs_data[, "Status"]
predictors <- cs_data[, -match(c("Status", "Seniority", "Time", "Age", "Expenses",
"Income", "Assets", "Debt", "Amount", "Price", "Finrat", "Savings"), colnames(cs_data))]
train_set <- createDataPartition(classes, p = 0.8, list = FALSE)
set.seed(123)
cs_data_train = cs_data[train_set, ]
cs_data_test = cs_data[-train_set, ]
# Define the tuned parameter
grid <- expand.grid(mtry = seq(4,16,4), ntree = c(700, 1000,2000) )
ctrl <- trainControl(method = "cv", number = 10, summaryFunction = twoClassSummary,classProbs = TRUE)
rf_fit <- train(Status ~ ., data = cs_data_train,
method = "rf",
preProcess = c("center", "scale"),
tuneGrid = grid,
trControl = ctrl,
family= "binomial",
metric= "ROC" #define which metric to optimize metric='RMSE'
)
rf_fit
You have to create a custom RF using the random forest package and then include the param that you want to include.
customRF <- list(type = "Classification", library = "randomForest", loop = NULL)
customRF$parameters <- data.frame(parameter = c("mtry", "ntree"), class = rep("numeric", 2), label = c("mtry", "ntree"))
customRF$grid <- function(x, y, len = NULL, search = "grid") {}
customRF$fit <- function(x, y, wts, param, lev, last, weights, classProbs, ...) {
randomForest(x, y, mtry = param$mtry, ntree=param$ntree, ...)
}
customRF$predict <- function(modelFit, newdata, preProc = NULL, submodels = NULL)
predict(modelFit, newdata)
customRF$prob <- function(modelFit, newdata, preProc = NULL, submodels = NULL)
predict(modelFit, newdata, type = "prob")
customRF$sort <- function(x) x[order(x[,1]),]
customRF$levels <- function(x) x$classes
customRF
Then you can use method as [customRF] in the train function.
You should change:
grid <- expand.grid(.mtry = seq(4,16,4),. ntree = c(700, 1000,2000) )