Commit e7ba2d59 authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files

Complementa a validação cruzada com caret.

parent d418346a
......@@ -48,61 +48,426 @@ help(trainControl, h = "html")
# p:
# (0 < p < 1): proporção dos dados usado para treino. O resto é
# validação.
``**
```
# Métodos para contrução de partições
Nessa seção serão vistas as funções disponíveis no `caret` para criação
de partições dos dados. Essas funções permitem separar os dados em
conjunto de treino e de teste e possuem parâmetros para controlar o
tamanho das partições, além de outros aspectos.
As funções para a criação das partições começam com o nome `create`.
```{r}
# Funções para criar partições nos dados.
apropos("^create[A-Z]")
```
O tipo mais simples de partição, o *holdout*, é feito usando a
`createDataPartition()`. Essa função retorna os índices das observações
que serão do conjunto de treino. As do conjunto de teste podem ser
obtidas por eliminação, usando os índices com sinal negativo.
**Exercício**: Faça a sua própria implementação dessa função usando a
`sample()`.
```{r}
#-----------------------------------------------------------------------
# Holdout simples (sem reposição).
# help(createDataPartition)
args(createDataPartition)
prop <- 0.6 # Proporção de dados de treino.
prop * nrow(swiss) # Número de registros (será aredondado).
index <- createDataPartition(y = swiss$Infant.Mortality,
times = 3,
p = prop)
# Índices dos registros que serão dados de treino.
str(index)
# IMPORTANT: as 3 partições são divisões independentes, ou seja, são
# reamostragens independentes dos dados.
# Número de registros selecionados por reamostragem (sem reposição).
sapply(index, FUN = length)
# Para ver os dados de treino e teste.
da <- swiss
da$set <- "test"
da$set[index[[1]]] <- "train"
splom(da[, -ncol(da)],
groups = da$set,
auto.key = TRUE,
pch = 19,
alpha = 0.5,
cex = 0.6,
as.matrix = TRUE)
# Tabela de frequência dos registros usados no traino.
tb <- table(unlist(index))
cbind(tb[1:10])
```
A validação cruzada por $k$ partições em conjuntos disjuntos é a mais
comum, conhecida por $k$-folds. A função que faz esse particionamento é
a `createFolds()`. Por padrão, a função retorna os índices das
observações de teste. As observações de treino podem ser obtidas por
eliminação, usando os índices negativos.
**Exercício**: Faça a sua própria implementação dessa função usando a
`sample()`.
```{r}
#-----------------------------------------------------------------------
# Criando conjuntos por k-fold.
# Com `returnTrain = FALSE` (default), retorna os índices das partições
# disjuntas.
k <- 5 # Número de folds.
nrow(swiss)/k # Número médio de obs por fold.
index <- createFolds(swiss$Infant.Mortality,
k = k,
returnTrain = FALSE)
str(index)
```
A função `createMultiFolds()` faz o particionamento por $k$-fold com $r$
repetições independentes. Basicamente é a aplicação repetida do caso anterior.
**Exercício**: Faça a sua própria implementação dessa função usando a
`sample()` e a `replicate()`.
```{r}
#-----------------------------------------------------------------------
# k-fold com repetições independentes.
# Com `returnTrain = FALSE` (default), retorna os índices das partições
# disjuntas.
k <- 5 # Número de folds.
nrow(swiss)/k # Número médio de obs por fold.
index <- createMultiFolds(swiss$Infant.Mortality,
k = k,
times = 3)
str(index)
```
A função `groupKFold()` faz a divisão dos dados conforme uma variável
agrupadora (fator). Ela retorna os índices das observações de treino
deixando como teste aquelas que correspondem a categoria da variável
agrupadora. Essa variável pode ter sido criada antes ou pode ser uma
variável que indentifica meses, trimestres, municípios, etc.
**Exercício**: Faça a sua própria implementação dessa função usando a
`split()`.
```{r}
#-----------------------------------------------------------------------
# k-fold agrupado.
index <- groupKFold(group = iris$Species)
str(index)
# Para verificar que os grupos são criados deixando de fora um nível por
# vez.
sapply(index, FUN = function(i) table(iris$Species[i]))
```
Para o caso de dados cronológicos ou de séries temporais, como os
registros não são independentes, o particionamento deve ser feito de tal
forma a considerar a potencial dependência cronológica entre
observações. A função `createTimeSlices()` faz esse particionamento que
usa uma janela móvel de tamanho `initialWindow` sobre os dados
cronológicamente ordenados para prever `horizon` dados à frente.
**Exercício**: Faça a sua própria implementação dessa função usando a
`seq()`.
```{r}
#-----------------------------------------------------------------------
# Para o caso de dados cronológicos.
# help(createTimeSlices)
args(createTimeSlices)
# help(austres)
str(austres)
n <- length(austres)
index <- createTimeSlices(y = austres,
initialWindow = n - 6,
horizon = 2)
str(index)
```
# Validação cruzada *k*-fold
Por último, tem-se a reamostragem com reposição que é feita pela
`createResample()`.
**Exercício**: Faça a sua própria implementação dessa função usando a
`sample(..., replace = TRUE)`.
```{r}
#-----------------------------------------------------------------------
# Reamostragens com reposição.
# Reamostragem com reposição de tamanho n.
index <- createResample(swiss$Infant.Mortality, times = 3)
# Índices dos registros que serão dados de treino.
str(index)
# IMPORTANT: as 3 partições são reamostragens independentes com
# reposição dos dados igual ao tamanho original.
```
# Avaliação da performance usando validação cruzada
Para avaliar a performance de um algorítmo de aprendizado
supervisionado, seja para regressão (resposta numérica) ou classificação
(resposta categórica), é utilizado a validação cruzada. O
algorítmo/modelo é ajustado aos dados de treino e sua performance é
avaliada nos dados de testes. A performance média e a variância da
performance são usados para acessar o desempenho do modelo.
Para ilustrar com as funções do pacote `caret` será usando regressão
linear múltipla e regressão logística.
```{r}
# Estrutura dos dados.
str(swiss)
# Criando os folds por fora.
# help(createFolds, help_type = "html")
apropos("^create[A-Z]")
cv_folds <- createFolds(swiss$Infant.Mortality, k = 5, list = TRUE)
str(cv_folds)
# Validação cruzada 5-fold (aqui é refeito).
control_list <-
trainControl(method = "repeatedcv", # Idem à createMultiFolds().
number = 5, # Número de folds.
repeats = 3, # Núm. de repetições.
verboseIter = TRUE, # Mostra progresso.
returnResamp = "all", # Retorna os índices.
savePredictions = "all") # Salva as predições.
names(control_list)
# Faz o processo de ajuste de regressão linear simples.
fit <- train(Infant.Mortality ~ .,
data = swiss,
method = "lm",
trControl = control_list)
# Resultado do modelo final ajustado com todos os dados.
# ATTENTION: o modelo final é aquele AJUSTADO COM TODOS OS DADOS.
fit # Idem a `fit$finalModel`.
# Resultado do modelo aplicado.
summary(fit)
# summary(fit$finalModel)
```
O modelo ajustado pela `train()` foi o modelo de regressão linear
múltipla conforme argumento passado para o parâmetro `method`. O modelo
final retornado é aquele ajustado considerando todos os dados, ignorando
qualquer estrutura de particionamento feito para avaliação da
performance. A seguir serão extraídos o desempenho em cada partição.
```{r}
#--------------------------------------------
# Inspeção do objeto.
# Classe, métodos e conteúdo.
class(fit)
methods(class = "train")
names(fit)
# Resultados de performance agregados nos particionamentos.
fit$results
#--------------------------------------------
# Extração dos resultados em cada fold.
# Tabela com preditos e observados nos dados de teste.
res <- fit$pred
res$d_squared <- (res$obs - res$pred)^2
str(res)
# Agrega dentro de cada fold.
res <- aggregate(cbind(mse = d_squared) ~ Resample,
data = res,
FUN = mean)
res$rmse <- sqrt(res$mse)
str(res)
# bwplot(~rmse, data = res, pch = "|")
# xyplot(rmse ~ 1, jitter.x = TRUE, data = res, type = c("p", "a"))
densityplot(~rmse,
data = res,
xlab = "Root mean squared error",
ylab = "Density")
# O mesmo retornado pela `fit$results`.
aggregate(rmse ~ 1, data = res, FUN = mean)
#--------------------------------------------
# Gráficos.
# Gráficos.
histogram(fit,
type = "density",
col = "gray50",
col.line = "red",
n = 8,
panel = function(x, ...) {
panel.histogram(x, ...)
panel.densityplot(x, ...)
panel.rug(x)
})
# Métodos aplicáveis quando houver hiperparâmetros.
# plot(fit) # Valores agragados.
# xyplot(fit) # Individual por fold.
#--------------------------------------------
# Mais conteúdo.
fit$modelType # Tipo de tarefa de aprendizado.
str(fit$trainingData) # Dados usados para o ajuste final.
names(fit$modelInfo) # Informações sobre o modelo usado.
# Índices das observações usadas para treino e teste.
# fit$control
sapply(fit$control$index, FUN = length)
sapply(fit$control$indexOut, FUN = length)
# Importância relativa das variáveis.
varImp(fit)
# A função para a importância das variáveis está disponível.
fit$modelInfo$varImp(fit)
# Medida de ajuste com todos os dados no melhor valor de hiperparâmetro.
RMSE(pred = predict(fit), obs = fit$trainingData$.outcome)
#-----------------------------------------------------------------------
```
# Tunning de hiperparâmetros usando validação cruzada
Para exemplificar o tunning de hiperparâmetros, será usado o algorítimo
de $k$ vizinhos mais próximos. O número de vizinhos $k$ é o
hiperparâmetro desse algorítmo que pode ser usado para regressão e
classificação.
## $k$-NN para regressão
```{r}
# Validação cruzada 5-fold (aqui é refeito).
control_list <- trainControl(method = "cv",
control_list <- trainControl(method = "repeatedcv",
number = 5,
verboseIter = TRUE,
repeats = 4,
verboseIter = FALSE,
returnResamp = "all",
savePredictions = "all",
search = "grid")
names(control_list)
# Conjunto de valores dos hiperparâmetros para serem avaliados.
tune_grid <- data.frame(k = 1:15)
dim(tune_grid)
# Faz o processo de ajuste.
fit <- train(Infant.Mortality ~ .,
data = swiss,
method = "knn",
preProcess = c("center", "scale"),
trControl = control_list)
trControl = control_list,
tuneGrid = tune_grid)
# Resultado do ajuste.
# Resultado dos ajustes para cada valor do hiperparâmetro.
fit
# Conteúdo e classe do objeto.
names(fit)
#--------------------------------------------
# Inspeção da performance.
# Classe, métodos e conteúdo.
class(fit)
methods(class = "train")
names(fit)
# Resultados agregados de performance para tunning.
fit$results
# Gráficos.
histogram(fit,
type = "density",
col.line = "orange",
col = "gray90",
panel = function(x, ...) {
panel.histogram(x, ...)
panel.densityplot(x, ...)
panel.rug(x)
panel.abline(v = mean(x), col = "red")
})
c(plot(fit), # Valores agragados.
xyplot(fit)) # Individual por fold.
# Sobrepondo os dois gráficos.
xyplot(fit, jitter.x = TRUE) +
latticeExtra::as.layer(plot(fit))
#--------------------------------------------
# Extração dos resultados em cada fold.
res <- fit$pred
str(res)
# Faz a agregração.
res$d_squared <- (res$obs - res$pred)^2
res <- aggregate(cbind(mse = d_squared) ~ k + Resample,
data = res,
FUN = mean)
res$rmse <- sqrt(res$mse)
xyplot(rmse ~ k, groups = Resample, data = res, type = c("p", "a"))
# Gráfico.
xyplot(rmse ~ k,
groups = Resample,
data = res,
lty = 2,
type = c("p", "a")) +
latticeExtra::as.layer({
xyplot(rmse ~ k,
data = res,
type = c("a"), col = "black",
lwd = 2)
})
# O mesmo que `fit$results`.
aggregate(rmse ~ k, data = res, FUN = mean)
# fit$trainingData
# fit$modelInfo
# fit$modelType
# Gráficos com barras de 1 erro padrão para RMSE.
ggplot(data = fit$results,
mapping = aes(x = k, y = RMSE)) +
geom_point() +
geom_line() +
geom_errorbar(mapping = aes(ymin = RMSE - RMSESD,
ymax = RMSE + RMSESD),
width = 0.25)
# Gráficos com barras de 1 erro padrão para MAE.
ggplot(data = fit$results,
mapping = aes(x = k, y = MAE)) +
geom_point() +
geom_line() +
geom_errorbar(mapping = aes(ymin = MAE - MAESD,
ymax = MAE + MAESD),
width = 0.25)
#--------------------------------------------
# Mais conteúdo.
fit$modelType
str(fit$trainingData)
names(fit$modelInfo)
# Índices das observações usadas para treino e teste.
# fit$control
......@@ -111,23 +476,145 @@ sapply(fit$control$indexOut, FUN = length)
# Resultado do modelo aplicado.
summary(fit)
summary(fit$finalModel)
# summary(fit$finalModel)
# Importância relativa das variáveis.
varImp(fit)
# Medida de ajuste com todos os dados no melhor valor de hiperparâmetro.
RMSE(pred = predict(fit),
obs = fit$trainingData$.outcome)
#-----------------------------------------------------------------------
```
## $k$-NN para classificação
```{r}
# Validação cruzada 5-fold (aqui é refeito).
control_list <- trainControl(method = "repeatedcv",
number = 5,
repeats = 4,
verboseIter = FALSE,
returnResamp = "all",
savePredictions = "all",
search = "grid")
names(control_list)
# Conjunto de valores dos hiperparâmetros para serem avaliados.
tune_grid <- data.frame(k = seq(1, 19, by = 2))
dim(tune_grid)
# Faz o processo de ajuste.
fit <- train(Species ~ .,
data = iris,
method = "knn",
preProcess = c("center", "scale"),
trControl = control_list,
tuneGrid = tune_grid)
# Resultado dos ajustes para cada valor do hiperparâmetro.
fit
#--------------------------------------------
# Inspeção da performance.
# Classe, métodos e conteúdo.
class(fit)
methods(class = "train")
names(fit)
# Resultados agregados de performance para tunning.
fit$results
# Gráficos.
histogram(fit,
type = "density",
col.line = "orange",
col = "gray90",
panel = function(x, ...) {
panel.histogram(x, ...)
panel.densityplot(x, ...)
panel.rug(x)
panel.abline(v = mean(x), col = "red")
})
c(plot(fit), # Valores agragados.
xyplot(fit)) # Individual por fold.
# Sobrepondo os dois gráficos.
xyplot(fit, jitter.x = TRUE) +
latticeExtra::as.layer(plot(fit))
#--------------------------------------------
# Extração dos resultados em cada fold.
res <- fit$pred
str(res)
# Faz a agregração.
res$correct <- res$pred == res$obs
res <- aggregate(cbind(acc = correct) ~ k + Resample,
data = res,
FUN = mean)
# Gráfico.
xyplot(acc ~ k,
groups = Resample,
data = res,
lty = 2,
type = c("p", "a")) +
latticeExtra::as.layer({
xyplot(acc ~ k,
data = res,
type = c("a"), col = "black",
lwd = 2)
})
plot(fit) # Valores agragados.
xyplot(fit) # Individual por fold.
# O mesmo que `fit$results`.
aggregate(acc ~ k, data = res, FUN = mean)
# Gráficos com barras de 1 erro padrão para acurácia.
ggplot(data = fit$results,
mapping = aes(x = k, y = Accuracy)) +
geom_point() +
geom_line() +
geom_errorbar(mapping = aes(ymin = Accuracy - AccuracySD,
ymax = Accuracy + AccuracySD),
width = 0.25)
#--------------------------------------------
# Mais conteúdo.
fit$modelType
str(fit$trainingData)
names(fit$modelInfo)
# Índices das observações usadas para treino e teste.
# fit$control
sapply(fit$control$index, FUN = length)
sapply(fit$control$indexOut, FUN = length)
# Resultado do modelo aplicado.
summary(fit)
# summary(fit$finalModel)
# Importância relativa das variáveis.
varImp(fit)
# Medida de ajuste com todos os dados no melhor valor de hiperparâmetro.
RMSE(predict(fit), fit$trainingData$.outcome)
#--------------------------------------------
# Medidas de ajuste com todos os dados no melhor valor de hiperparâmetro.
# Tabela com classes preditas e observadas.
df <- data.frame(pred = predict(fit),
obs = fit$trainingData$.outcome)
# Matriz de confusão.
confusionMatrix(data = df$pred,
reference = df$obs)
defaultSummary(df)
cbind(multiClassSummary(df, lev = levels(iris$Species)))
#-----------------------------------------------------------------------
```
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment