Objetivo
Esta pequena apresentação tem como objetivo demonstrar o funcionamento de métodos de validação cruzada utilizando o algoritmo KNN.
Para isto usaremos o pacote caret que nos possibilita criar uma estrutura base para aplicação de algoritmos de aprendizado de máquinas.
Neste pacote, a modelagem ocorre em “camadas”, ou seja, configuramos uma camada de entrada de dados, outra camada para pré-processamento de dados e outra para a validação cruzada. É possível, também, realizar o afunilamento dos parâmetros a serem determinados, conseguindo maior precisão na determinação destes e no resultado final, porém não será o foco deste breve documento.
Nesta demonstração será utilizado os dados referentes a classificação do uso doméstico de água. Para tornar mais didático será utilizado, apenas, as categórias referentes ao uso de chuveiro, bacia e torneira interna.
Serão, também, simulados, a partir destes dados, três diferentes tipos de bancos de dados:
Neste primeiro, haverá uma amostra composta de mil unidades de cada uma das categorias;
Neste, a amostra é de 10 observações de cada uma destas;
No último, haverá 50 observações de chuveiro e bacia, porém, apenas 20 de torneira interna.
Queremos, por fim, comparar a performace dos métodos de validação cruzada para cada um destes. Os métodos utilizados serão o de Boostrap, k folds e Repeated k folds.
Por fim, será comparado o tempo de computação quando o método é o Repeated k folds versus Leave One Out.
# Bibliotecas
require(caret)## Loading required package: caret## Loading required package: lattice## Loading required package: ggplot2require(tidyverse)## Loading required package: tidyverse## -- Attaching packages --------------------------------------------------------------------- tidyverse 1.2.1 --## v tibble 2.0.1 v purrr 0.2.5
## v tidyr 0.8.2 v dplyr 0.7.8
## v readr 1.1.1 v stringr 1.3.1
## v tibble 2.0.1 v forcats 0.3.0## -- Conflicts ------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## x purrr::lift() masks caret::lift()require(profvis)## Loading required package: profvisrequire(gridExtra)## Loading required package: gridExtra##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combineCarregando dados
data <- load("data_041218_1138.RData")Exemplo A
Obtendo a amostragem desejada:
# Criando amostragem
set.seed(1)
dados <- features_atual %>%
filter(categoria %in% c("Bacia", "Chuveiro", "Torneira Interna")) %>%
filter(casa == "B")
dados$categoria <- fct_drop(dados$categoria) # Removendo as categórias não utilizadas
sample <- dados %>%
group_by(categoria) %>%
sample_n(1000) %>% # Escolhendo 1000 observações de cada
select(-c(10:18)) %>%
na.omit()
head(sample)## # A tibble: 6 x 9
## # Groups: categoria [1]
## categoria duracao nmoda volume inercia moda media pico mediana
## <fct> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Bacia 40 3 0.700 3 1.20 1.05 1.20 1.20
## 2 Bacia 110 10 5.30 10 3 2.89 3 3
## 3 Bacia 160 12 4.40 4.33 1.80 1.65 2.40 1.80
## 4 Bacia 60 3 7.80 2 8.60 7.80 9.20 8.60
## 5 Bacia 120 7 6.10 1.4 3.60 3.05 3.60 3.60
## 6 Bacia 140 5 9.90 0.556 4.80 4.24 4.80 4.20Criando o grupo de treino e de teste:
# Definindo Split
split=0.80
trainIndex <- createDataPartition(sample$categoria, p=split, list=FALSE)
# Separando
data_train <- sample[ trainIndex,]
data_test <- sample[-trainIndex,]Com Bootstrap
model <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method = "boot"))
model## k-Nearest Neighbors
##
## 2400 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 2400, 2400, 2400, 2400, 2400, 2400, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6335375 0.4504252
## 7 0.6402937 0.4605450
## 9 0.6445510 0.4670280
## 11 0.6473185 0.4712062
## 13 0.6490409 0.4737846
## 15 0.6506494 0.4762175
## 17 0.6487977 0.4734362
## 19 0.6490465 0.4738308
## 21 0.6501826 0.4755473
## 23 0.6516640 0.4777978
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 23.# Armazenando o número ótimo de vizinhos
k1 <- model$finalModel$kObtido, então, a melhor estimativa de vizinhos próximos com o bootstrap, será avaliada a acurácia deste modelo aplicado ao teste:
# Realizando a predição para o teste
predictions <- predict(model, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 145 22 84
## Torneira Interna 12 144 8
## Chuveiro 43 34 108
##
## Overall Statistics
##
## Accuracy : 0.6617
## 95% CI : (0.6222, 0.6995)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4925
## Mcnemar's Test P-Value : 4.585e-07
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7250 0.7200 0.5400
## Specificity 0.7350 0.9500 0.8075
## Pos Pred Value 0.5777 0.8780 0.5838
## Neg Pred Value 0.8424 0.8716 0.7783
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.2417 0.2400 0.1800
## Detection Prevalence 0.4183 0.2733 0.3083
## Balanced Accuracy 0.7300 0.8350 0.6738aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando para futuras comparações
acc1 <- aux$overall[1]k-fold
model2 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="cv", number=10))
model2## k-Nearest Neighbors
##
## 2400 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 2160, 2160, 2160, 2160, 2160, 2160, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6500000 0.475000
## 7 0.6570833 0.485625
## 9 0.6525000 0.478750
## 11 0.6529167 0.479375
## 13 0.6608333 0.491250
## 15 0.6650000 0.497500
## 17 0.6654167 0.498125
## 19 0.6633333 0.495000
## 21 0.6658333 0.498750
## 23 0.6687500 0.503125
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 23.# Armazenando o número ótimo de vizinhos
k2 <- model2$finalModel$kObservando, então, os resultados para o conjunto de dados do teste:
# Realizando a predição para os dados de teste
predictions <- predict(model2, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 148 22 83
## Torneira Interna 12 145 8
## Chuveiro 40 33 109
##
## Overall Statistics
##
## Accuracy : 0.67
## 95% CI : (0.6308, 0.7075)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.505
## Mcnemar's Test P-Value : 2.898e-07
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7400 0.7250 0.5450
## Specificity 0.7375 0.9500 0.8175
## Pos Pred Value 0.5850 0.8788 0.5989
## Neg Pred Value 0.8501 0.8736 0.7823
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.2467 0.2417 0.1817
## Detection Prevalence 0.4217 0.2750 0.3033
## Balanced Accuracy 0.7388 0.8375 0.6813aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando
acc2 <- aux$overall[1]Repeated k-fold Cross Validation
Repetiremos o mesmo feito para o “repeated k-fold”
model3 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))
model3## k-Nearest Neighbors
##
## 2400 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 2160, 2160, 2160, 2160, 2160, 2160, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6555833 0.483375
## 7 0.6570000 0.485500
## 9 0.6565833 0.484875
## 11 0.6595833 0.489375
## 13 0.6600000 0.490000
## 15 0.6612500 0.491875
## 17 0.6631667 0.494750
## 19 0.6650000 0.497500
## 21 0.6644167 0.496625
## 23 0.6624167 0.493625
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 19.k3 <- model3$finalModel$kObservando, então, os resultados para o grupo de testes:
# Predição
predictions <- predict(model3, data_test)
# Resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 152 18 80
## Torneira Interna 11 148 8
## Chuveiro 37 34 112
##
## Overall Statistics
##
## Accuracy : 0.6867
## 95% CI : (0.6479, 0.7236)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.53
## Mcnemar's Test P-Value : 2.42e-07
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7600 0.7400 0.5600
## Specificity 0.7550 0.9525 0.8225
## Pos Pred Value 0.6080 0.8862 0.6120
## Neg Pred Value 0.8629 0.8799 0.7890
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.2533 0.2467 0.1867
## Detection Prevalence 0.4167 0.2783 0.3050
## Balanced Accuracy 0.7575 0.8462 0.6913aux <- confusionMatrix(predictions, data_test$categoria)
acc3 <- aux$overall[1]Comparações
A primeira comparação, será aquela de vizinhos próximos:
metodos <- c("bootstrap", "k-folds", "rep. k-folds")
k <- cbind(k1,k2,k3)
colnames(k) <- metodos
k## bootstrap k-folds rep. k-folds
## [1,] 23 23 19Outra comparação, de grande importância, versa sobre a distribuição da acurácia (boxplot) de cada um dos métodos:
boxplot(model[["resample"]][["Accuracy"]], model2[["resample"]][["Accuracy"]], model3[["resample"]][["Accuracy"]])
Por fim, comparando a acurácia do teste:
acc <- cbind(acc1, acc2, acc3)
colnames(acc) <- metodos
acc## bootstrap k-folds rep. k-folds
## Accuracy 0.6616667 0.67 0.6866667É interessante observar que o modelo de repetidos k-folds possui melhores resultados quanto a acurácia do teste e tem o menor número ótimos de vizinhos, sendo um modelo mais simples quando comparado aos demais.
Pontua-se, também, que o bootstrap é o modelo com os piores valores de acurácia, quando se observa os conjuntos de validação cruzada, enquanto que os repetidos k-folds apresentam grande variabilidade, mas bom resultado mediano.
Exemplo B
Neste exemplo há menos dados, 10 de cada uma dos métodos, observaremos, como os métodos de validação cruzadas reagirão.
Ajustando a amostragem:
set.seed(1)
dados <- features_atual %>%
filter(categoria %in% c("Bacia", "Chuveiro", "Torneira Interna" )) %>%
filter(casa == "B")
dados$categoria <- fct_drop(dados$categoria)
sample <- dados %>%
group_by(categoria) %>%
sample_n(10) %>%
select(-c(10:18))
# Definindo Split
split=0.80
trainIndex <- createDataPartition(sample$categoria, p=split, list=FALSE)
data_train <- sample[ trainIndex,]
data_test <- sample[-trainIndex,]Com Bootstrap
model <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method = "boot"))
model## k-Nearest Neighbors
##
## 24 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 24, 24, 24, 24, 24, 24, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.4185960 0.1689475688
## 7 0.3981284 0.1694012245
## 9 0.3903478 0.1617269789
## 11 0.3464747 0.1032896027
## 13 0.3018687 0.0473766703
## 15 0.2991212 0.0621640749
## 17 0.2704214 0.0384434124
## 19 0.2320058 -0.0001058204
## 21 0.2308615 -0.0027628721
## 23 0.2176118 -0.0273536608
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.# Armazenando o número ótimo de vizinhos
k1 <- model$finalModel$kObtido, então, a melhor estimativa de vizinhos próximos com o bootstrap, para o exemplo B, será avaliada a acurácia deste modelo aplicado ao teste:
# Realizando a predição para o teste
predictions <- predict(model, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 1 0 2
## Torneira Interna 0 2 0
## Chuveiro 1 0 0
##
## Overall Statistics
##
## Accuracy : 0.5
## 95% CI : (0.1181, 0.8819)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : 0.3196
##
## Kappa : 0.25
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.5000 1.0000 0.0000
## Specificity 0.5000 1.0000 0.7500
## Pos Pred Value 0.3333 1.0000 0.0000
## Neg Pred Value 0.6667 1.0000 0.6000
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.1667 0.3333 0.0000
## Detection Prevalence 0.5000 0.3333 0.1667
## Balanced Accuracy 0.5000 1.0000 0.3750aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando para futuras comparações
acc1 <- aux$overall[1]k-fold
model2 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="cv", number=10))
model2## k-Nearest Neighbors
##
## 24 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 21, 23, 22, 21, 21, 22, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.5833333 0.25925926
## 7 0.4833333 0.14814815
## 9 0.4500000 0.09259259
## 11 0.4666667 0.14814815
## 13 0.3500000 -0.09259259
## 15 0.4166667 0.07407407
## 17 0.3666667 0.03703704
## 19 0.3666667 0.03703704
## 21 0.3833333 0.14814815
## 23 0.1333333 -0.05000000
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.# Armazenando o número ótimo de vizinhos
k2 <- model2$finalModel$kObservando, então, os resultados para o conjunto de dados do teste:
# Realizando a predição para os dados de teste
predictions <- predict(model2, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 1 0 2
## Torneira Interna 1 2 0
## Chuveiro 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5
## 95% CI : (0.1181, 0.8819)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : 0.3196
##
## Kappa : 0.25
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.5000 1.0000 0.0000
## Specificity 0.5000 0.7500 1.0000
## Pos Pred Value 0.3333 0.6667 NaN
## Neg Pred Value 0.6667 1.0000 0.6667
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.1667 0.3333 0.0000
## Detection Prevalence 0.5000 0.5000 0.0000
## Balanced Accuracy 0.5000 0.8750 0.5000aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando
acc2 <- aux$overall[1]Repeated k-fold Cross Validation
Repetiremos o mesmo feito para o “repeated k-fold”
model3 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))
model3## k-Nearest Neighbors
##
## 24 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 22, 21, 22, 22, 22, 22, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.5505051 0.310283688
## 7 0.5488215 0.289007092
## 9 0.3771044 0.088541667
## 11 0.3501684 0.064236111
## 13 0.3367003 0.032646048
## 15 0.3451178 0.036458333
## 17 0.3636364 0.064236111
## 19 0.2811448 -0.003401361
## 21 0.2659933 0.073129252
## 23 0.1784512 0.015151515
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.k3 <- model3$finalModel$kObservando, então, os resultados para o grupo de testes:
# Predição
predictions <- predict(model3, data_test)
# Resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 1 0 1
## Torneira Interna 0 2 0
## Chuveiro 1 0 1
##
## Overall Statistics
##
## Accuracy : 0.6667
## 95% CI : (0.2228, 0.9567)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : 0.1001
##
## Kappa : 0.5
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.5000 1.0000 0.5000
## Specificity 0.7500 1.0000 0.7500
## Pos Pred Value 0.5000 1.0000 0.5000
## Neg Pred Value 0.7500 1.0000 0.7500
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.1667 0.3333 0.1667
## Detection Prevalence 0.3333 0.3333 0.3333
## Balanced Accuracy 0.6250 1.0000 0.6250aux <- confusionMatrix(predictions, data_test$categoria)
acc3 <- aux$overall[1]Comparações
Comparando o “k” ótimo:
A primeira comparação, será aquela de vizinhos próximos:
metodos <- c("bootstrap", "k-folds", "rep. k-folds")
k <- cbind(k1,k2,k3)
colnames(k) <- metodos
k## bootstrap k-folds rep. k-folds
## [1,] 5 5 5Outra comparação, de grande importância, versa sobre a distribuição da acurácia (boxplot) de cada um dos métodos:
boxplot(model[["resample"]][["Accuracy"]], model2[["resample"]][["Accuracy"]], model3[["resample"]][["Accuracy"]])
Por fim, comparando a acurácia do teste:
acc <- cbind(acc1, acc2, acc3)
colnames(acc) <- metodos
acc## bootstrap k-folds rep. k-folds
## Accuracy 0.5 0.5 0.6666667Uma vez reduzido o número de observações, também são diminuido o número de vizinhos próximos considerados no knn. Outra questão visível diz respeito a distribuição da acurácia nos dados de treino que é igual para o k-fold e para os repetidos k-folds, consequência, também, da baixa quantidade de observações.
Porém, novamente, os repetidos k-folds demonstraram melhores resultados frente aos dados de treino. Enquanto que os resultados do boostrap e do k-folds são parecidos.
Exemplo C
Criando amostragem
set.seed(1)
dados <- features_atual %>%
filter(categoria %in% c("Bacia", "Chuveiro")) %>%
filter(casa == "B")
sample <- dados %>%
group_by(categoria) %>%
sample_n(50)
dados2 <- features_atual %>%
filter(categoria %in% c("Torneira Interna")) %>%
filter(casa == "B")
sample2 <- dados2 %>%
sample_n(10)
sample_final <- bind_rows(sample, sample2) %>%
select(-c(10:18))
sample_final$categoria <- fct_drop(sample_final$categoria)# Definindo Split
split=0.80
trainIndex <- createDataPartition(sample_final$categoria, p=split, list=FALSE)
data_train <- sample_final[trainIndex,]
data_test <- sample_final[-trainIndex,]Por Boostrap
model <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method = "boot"))
model## k-Nearest Neighbors
##
## 88 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 88, 88, 88, 88, 88, 88, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.5390613 0.18943653
## 7 0.5194965 0.14943477
## 9 0.5032134 0.11701582
## 11 0.4687869 0.05644428
## 13 0.4807345 0.07379152
## 15 0.4765920 0.06828667
## 17 0.4806196 0.07477825
## 19 0.4637459 0.04845997
## 21 0.4525194 0.02780356
## 23 0.4584021 0.03508098
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.# Armazenando o número ótimo de vizinhos
k1 <- model$finalModel$kObtido, então, a melhor estimativa de vizinhos próximos com o bootstrap, para o exemplo B, será avaliada a acurácia deste modelo aplicado ao teste:
# Realizando a predição para o teste
predictions <- predict(model, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 7 0 3
## Torneira Interna 0 0 0
## Chuveiro 3 2 7
##
## Overall Statistics
##
## Accuracy : 0.6364
## 95% CI : (0.4066, 0.828)
## No Information Rate : 0.4545
## P-Value [Acc > NIR] : 0.06715
##
## Kappa : 0.3333
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7000 0.00000 0.7000
## Specificity 0.7500 1.00000 0.5833
## Pos Pred Value 0.7000 NaN 0.5833
## Neg Pred Value 0.7500 0.90909 0.7000
## Prevalence 0.4545 0.09091 0.4545
## Detection Rate 0.3182 0.00000 0.3182
## Detection Prevalence 0.4545 0.00000 0.5455
## Balanced Accuracy 0.7250 0.50000 0.6417aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando para futuras comparações
acc1 <- aux$overall[1]k-fold
model2 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="cv", number=10))
model2## k-Nearest Neighbors
##
## 88 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 79, 79, 79, 79, 79, 79, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6263889 0.3317647
## 7 0.6388889 0.3412500
## 9 0.6055556 0.2862500
## 11 0.6027778 0.2700000
## 13 0.5680556 0.2050000
## 15 0.5805556 0.2300000
## 17 0.5819444 0.2350000
## 19 0.5625000 0.2050000
## 21 0.5625000 0.2050000
## 23 0.5263889 0.1350000
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 7.# Armazenando o número ótimo de vizinhos
k2 <- model2$finalModel$kObservando, então, os resultados para o conjunto de dados do teste:
# Realizando a predição para os dados de teste
predictions <- predict(model2, data_test)
# Observando os resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 6 0 6
## Torneira Interna 0 0 0
## Chuveiro 4 2 4
##
## Overall Statistics
##
## Accuracy : 0.4545
## 95% CI : (0.2439, 0.6779)
## No Information Rate : 0.4545
## P-Value [Acc > NIR] : 0.582
##
## Kappa : 0
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.6000 0.00000 0.4000
## Specificity 0.5000 1.00000 0.5000
## Pos Pred Value 0.5000 NaN 0.4000
## Neg Pred Value 0.6000 0.90909 0.5000
## Prevalence 0.4545 0.09091 0.4545
## Detection Rate 0.2727 0.00000 0.1818
## Detection Prevalence 0.5455 0.00000 0.4545
## Balanced Accuracy 0.5500 0.50000 0.4500aux <- confusionMatrix(predictions, data_test$categoria)
# Armazenando
acc2 <- aux$overall[1]Repeated k-fold Cross Validation
Repetiremos o mesmo feito para o “repeated k-fold”
model3 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))
model3## k-Nearest Neighbors
##
## 88 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 80, 79, 79, 79, 79, 80, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6254167 0.3216765
## 7 0.6026389 0.2721667
## 9 0.5993056 0.2670000
## 11 0.5625000 0.1961111
## 13 0.5752778 0.2190000
## 15 0.5694444 0.2080000
## 17 0.5486111 0.1710000
## 19 0.5256944 0.1285000
## 21 0.5245833 0.1265000
## 23 0.5162500 0.1105000
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 5.k3 <- model3$finalModel$kObservando, então, os resultados para o grupo de testes:
# Predição
predictions <- predict(model3, data_test)
# Resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 7 0 3
## Torneira Interna 0 0 0
## Chuveiro 3 2 7
##
## Overall Statistics
##
## Accuracy : 0.6364
## 95% CI : (0.4066, 0.828)
## No Information Rate : 0.4545
## P-Value [Acc > NIR] : 0.06715
##
## Kappa : 0.3333
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7000 0.00000 0.7000
## Specificity 0.7500 1.00000 0.5833
## Pos Pred Value 0.7000 NaN 0.5833
## Neg Pred Value 0.7500 0.90909 0.7000
## Prevalence 0.4545 0.09091 0.4545
## Detection Rate 0.3182 0.00000 0.3182
## Detection Prevalence 0.4545 0.00000 0.5455
## Balanced Accuracy 0.7250 0.50000 0.6417aux <- confusionMatrix(predictions, data_test$categoria)
acc3 <- aux$overall[1]Comparações
Comparando o “k” ótimo:
A primeira comparação, será aquela de vizinhos próximos:
metodos <- c("bootstrap", "k-folds", "rep. k-folds")
k <- cbind(k1,k2,k3)
colnames(k) <- metodos
k## bootstrap k-folds rep. k-folds
## [1,] 5 7 5Outra comparação, de grande importância, versa sobre a distribuição da acurácia (boxplot) de cada um dos métodos:
boxplot(model[["resample"]][["Accuracy"]], model2[["resample"]][["Accuracy"]], model3[["resample"]][["Accuracy"]])
Por fim, comparando a acurácia do teste:
acc <- cbind(acc1, acc2, acc3)
colnames(acc) <- metodos
acc## bootstrap k-folds rep. k-folds
## Accuracy 0.6363636 0.4545455 0.6363636Neste último caso, a despeito de uma boa diferença entre a distribuição das acurácias para os métodos de bootstrap e repetidos k-folds, se obteve o mesmo resultado para os dados de treino.
Comparando tempo de processamento
Nesta última etapa, será utilizado o pacote profvis para visualizar o tempo gasto para realizar a validação cruzada utilizando os métodos: repeated k-folds e Leave One Out.
Para isto, recriará-se a amostragem feita no exemplo A.
Obtendo a amostragem desejada:
# Criando amostragem
set.seed(1)
dados <- features_atual %>%
filter(categoria %in% c("Bacia", "Chuveiro", "Torneira Interna")) %>%
filter(casa == "B")
dados$categoria <- fct_drop(dados$categoria) # Removendo as categórias não utilizadas
sample <- dados %>%
group_by(categoria) %>%
sample_n(1000) %>% # Escolhendo 1000 observações de cada
select(-c(10:18)) %>%
na.omit()
head(sample)## # A tibble: 6 x 9
## # Groups: categoria [1]
## categoria duracao nmoda volume inercia moda media pico mediana
## <fct> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Bacia 40 3 0.700 3 1.20 1.05 1.20 1.20
## 2 Bacia 110 10 5.30 10 3 2.89 3 3
## 3 Bacia 160 12 4.40 4.33 1.80 1.65 2.40 1.80
## 4 Bacia 60 3 7.80 2 8.60 7.80 9.20 8.60
## 5 Bacia 120 7 6.10 1.4 3.60 3.05 3.60 3.60
## 6 Bacia 140 5 9.90 0.556 4.80 4.24 4.80 4.20Criando o grupo de treino e de teste:
# Definindo Split
split=0.80
trainIndex <- createDataPartition(sample$categoria, p=split, list=FALSE)
# Separando
data_train <- sample[ trainIndex,]
data_test <- sample[-trainIndex,]Rodando novamente o modelo :
Repetidos K-Folds:
model1 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))
model1## k-Nearest Neighbors
##
## 2400 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 2160, 2160, 2160, 2160, 2160, 2160, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6557917 0.4836875
## 7 0.6593750 0.4890625
## 9 0.6557083 0.4835625
## 11 0.6558750 0.4838125
## 13 0.6579583 0.4869375
## 15 0.6621667 0.4932500
## 17 0.6622500 0.4933750
## 19 0.6649583 0.4974375
## 21 0.6624583 0.4936875
## 23 0.6615417 0.4923125
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 19.# Testando os resultados obtidos
# Predição
predictions <- predict(model1, data_test)
# Resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 151 18 82
## Torneira Interna 11 148 7
## Chuveiro 38 34 111
##
## Overall Statistics
##
## Accuracy : 0.6833
## 95% CI : (0.6444, 0.7204)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.525
## Mcnemar's Test P-Value : 9.083e-08
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7550 0.7400 0.5550
## Specificity 0.7500 0.9550 0.8200
## Pos Pred Value 0.6016 0.8916 0.6066
## Neg Pred Value 0.8596 0.8802 0.7866
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.2517 0.2467 0.1850
## Detection Prevalence 0.4183 0.2767 0.3050
## Balanced Accuracy 0.7525 0.8475 0.6875# Testando o tempo de processamento
profvis({model1 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))})#### Leave one Out:
model2 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))
model2## k-Nearest Neighbors
##
## 2400 samples
## 8 predictor
## 3 classes: 'Bacia', 'Torneira Interna', 'Chuveiro'
##
## Pre-processing: centered (8), scaled (8)
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 2160, 2160, 2160, 2160, 2160, 2160, ...
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.6540833 0.4811250
## 7 0.6582500 0.4873750
## 9 0.6546250 0.4819375
## 11 0.6580417 0.4870625
## 13 0.6568333 0.4852500
## 15 0.6616667 0.4925000
## 17 0.6618333 0.4927500
## 19 0.6630833 0.4946250
## 21 0.6637500 0.4956250
## 23 0.6626250 0.4939375
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 21.# Testando os resultados obtidos
# Predição
predictions <- predict(model2, data_test)
# Resultados
confusionMatrix(predictions, data_test$categoria) ## Confusion Matrix and Statistics
##
## Reference
## Prediction Bacia Torneira Interna Chuveiro
## Bacia 152 20 80
## Torneira Interna 11 146 9
## Chuveiro 37 34 111
##
## Overall Statistics
##
## Accuracy : 0.6817
## 95% CI : (0.6427, 0.7188)
## No Information Rate : 0.3333
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5225
## Mcnemar's Test P-Value : 3.298e-07
##
## Statistics by Class:
##
## Class: Bacia Class: Torneira Interna Class: Chuveiro
## Sensitivity 0.7600 0.7300 0.5550
## Specificity 0.7500 0.9500 0.8225
## Pos Pred Value 0.6032 0.8795 0.6099
## Neg Pred Value 0.8621 0.8756 0.7871
## Prevalence 0.3333 0.3333 0.3333
## Detection Rate 0.2533 0.2433 0.1850
## Detection Prevalence 0.4200 0.2767 0.3033
## Balanced Accuracy 0.7550 0.8400 0.6887profvis({model2 <- train(categoria ~ .,
data = data_train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method="repeatedcv", number=10, repeats=10))})Interessante observar que ambos métodos levam a resultados semelhantes em tempo semelhantes.