rm(list=ls(all=T))
gc() used (Mb) gc trigger (Mb) max used (Mb)
Ncells 563724 30.2 1233504 65.9 644254 34.5
Vcells 1000438 7.7 8388608 64.0 1635074 12.5Exercício - Multivariada 2
Atividade prática
- O arquivo
banknote.datcontem informações de 6 variáveis medidas em 100 notas verdadeiras e 100 notas falsas. As variáveis são Y = classe (verdadeira ou falsa), \(X_1\) = tamanho (comprimento da nota), \(X_2\) = esquerda (altura da nota no lado esquerdo), \(X_3\) = direita (altura da nota no lado direito), \(X_4\) = inferior (borda inferior), \(X_5\) = superior (borda superior), \(X_6\) = diagonal (comprimento da diagonal)
Definindo o diretório
setwd("C:/Users/Pessoal/Desktop/ESTATÍSTICA/UFPB/8º PERÍODO/ANÁLISE MULTIVARIADA II/AULAS/EXERCÍCIO")dados <- read.table("banknote.dat", sep = "\t", header = T, col.names = c("classe", "comprimento", "altura - LE", "altura - LD", "inferior", "superior", "diagonal"))Fazendo algumas alterações
dados$classe <- factor(dados$classe, levels = c("V", "F"), labels = c("Verdadeira", "Falsa"))head(dados) classe comprimento altura...LE altura...LD inferior superior diagonal
1 Verdadeira 214.8 131.0 131.1 9.0 9.7 141.0
2 Verdadeira 214.6 129.7 129.7 8.1 9.5 141.7
3 Verdadeira 214.8 129.7 129.7 8.7 9.6 142.2
4 Verdadeira 214.8 129.7 129.6 7.5 10.4 142.0
5 Verdadeira 215.0 129.6 129.7 10.4 7.7 141.8
6 Verdadeira 215.7 130.8 130.5 9.0 10.1 141.4tail(dados) classe comprimento altura...LE altura...LD inferior superior diagonal
195 Falsa 214.9 130.3 130.5 11.6 10.6 139.8
196 Falsa 215.0 130.4 130.3 9.9 12.1 139.6
197 Falsa 215.1 130.3 129.9 10.3 11.5 139.7
198 Falsa 214.8 130.3 130.4 10.6 11.1 140.0
199 Falsa 214.7 130.7 130.8 11.2 11.2 139.4
200 Falsa 214.3 129.9 129.9 10.2 11.5 139.6Estatística Descritiva
skimr::skim(dados)| Name | dados |
| Number of rows | 200 |
| Number of columns | 7 |
| _______________________ | |
| Column type frequency: | |
| factor | 1 |
| numeric | 6 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| classe | 0 | 1 | FALSE | 2 | Ver: 100, Fal: 100 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| comprimento | 0 | 1 | 214.90 | 0.38 | 213.8 | 214.6 | 214.90 | 215.10 | 216.3 | ▁▇▇▂▁ |
| altura…LE | 0 | 1 | 130.12 | 0.36 | 129.0 | 129.9 | 130.20 | 130.40 | 131.0 | ▁▅▇▇▁ |
| altura…LD | 0 | 1 | 129.96 | 0.40 | 129.0 | 129.7 | 130.00 | 130.22 | 131.1 | ▃▆▇▅▁ |
| inferior | 0 | 1 | 9.42 | 1.44 | 7.2 | 8.2 | 9.10 | 10.60 | 12.7 | ▇▆▅▅▂ |
| superior | 0 | 1 | 10.65 | 0.80 | 7.7 | 10.1 | 10.60 | 11.20 | 12.3 | ▁▂▆▇▃ |
| diagonal | 0 | 1 | 140.48 | 1.15 | 137.8 | 139.5 | 140.45 | 141.50 | 142.4 | ▂▇▅▅▇ |
Novo banco
Vamos criar um novo banco para aplicar componentes principais nele e também análise fatorial.
dados1 <- dados[,-1]Covariância
cov(dados1) comprimento altura...LE altura...LD inferior superior
comprimento 0.14179296 0.03144322 0.02309146 -0.1032462 -0.0185407
altura...LE 0.03144322 0.13033945 0.10842739 0.2158028 0.1050394
altura...LD 0.02309146 0.10842739 0.16327412 0.2841319 0.1299967
inferior -0.10324623 0.21580276 0.28413191 2.0868781 0.1645389
superior -0.01854070 0.10503945 0.12999673 0.1645389 0.6447234
diagonal 0.08430553 -0.20934196 -0.24047010 -1.0369962 -0.5496148
diagonal
comprimento 0.08430553
altura...LE -0.20934196
altura...LD -0.24047010
inferior -1.03699623
superior -0.54961482
diagonal 1.32771633Correlação
correlação <- cor(dados1)
corrplot::corrplot(correlação, method = "number")
Podemos ver que diagonal basicamente permanece sozinha
Componentes principais
Como temos que duas variáveis tem escalas diferentes das demais, vamos padronizar para que a estrutura de componentes principais não seja afetada completamente pela escala das outras variáveis.
pca <- prcomp(dados1, center = TRUE, scale = TRUE)
summary(pca)Importance of components:
PC1 PC2 PC3 PC4 PC5 PC6
Standard deviation 1.7163 1.1305 0.9322 0.67065 0.51834 0.43460
Proportion of Variance 0.4909 0.2130 0.1448 0.07496 0.04478 0.03148
Cumulative Proportion 0.4909 0.7039 0.8488 0.92374 0.96852 1.00000De acordo com o resultado, poderemos optar por ficar apenas com três componentes principais e teremos cerca de 84.88 % de explicação da variabilidade dos dados com estes três componentes.
Scree Plot
factoextra::fviz_eig(pca) +
ggplot2::labs( y = "Porcentagem de Variância Explicada",
x = "Componentes Principais")
Conforme o gráfico de cotovelo, é observado que o ideal é utilizar três componentes principais, conforme já foi observado que juntas explicam cerca de 84.88% da variabilidade total dos dados.
Vamos agora inspecionar os coeficientes das componentes principais. Com relação à primeira componente principal, podemos observar um equilíbrio entre as magnitudes dos coeficientes das variáveis (padronizadas). A variável diagonal, que representa o tamanho da diagonal, foi a que apresentou o maior coeficiente (em valor absoluto). Observando os sinais, concluímos que a primeira componente principal se constitui em um índice comparativo com os coeficientes das variáveis altura - LE, altura - LD, inferior e superior com sinal negativo e os coeficientes das demais variáveis com sinal positivo.
Com relação à segunda componente principal, podemos observar um equilíbrio entre as magnitudes dos coeficientes das variáveis (padronizadas). A variável comprimento, que representa o comprimento da nota, foi a que apresentou o maior coeficiente (em valor absoluto). Observando os sinais, concluímos que a segunda componente principal se constitui em um índice comparativo com os coeficientes das variáveis comprimento, altura - LE, altura - LD e diagonal com sinal negativo e os coeficientes das demais variáveis com sinal positivo.
Com relação à terceira componente principal, podemos observar um equilíbrio entre as magnitudes dos coeficientes das variáveis (padronizadas). A variável superior, que representa o comprimento da borda superior, foi a que apresentou o maior coeficiente (em valor absoluto). Observando os sinais, concluímos que a terceira componente principal se constitui em um índice comparativo com os coeficientes das variáveis altura - LE, altura - LD, inferior e diagonal com sinal negativo e os coeficientes das demais variáveis com sinal positivo.
summary(pca)$rotation PC1 PC2 PC3 PC4 PC5
comprimento 0.006987029 -0.81549497 0.01768066 0.5746173 -0.0587961
altura...LE -0.467758161 -0.34196711 -0.10338286 -0.3949225 0.6394961
altura...LD -0.486678705 -0.25245860 -0.12347472 -0.4302783 -0.6140972
inferior -0.406758327 0.26622878 -0.58353831 0.4036735 -0.2154756
superior -0.367891118 0.09148667 0.78757147 0.1102267 -0.2198494
diagonal 0.493458317 -0.27394074 -0.11387536 -0.3919305 -0.3401601
PC6
comprimento 0.03105698
altura...LE -0.29774768
altura...LD 0.34915294
inferior -0.46235361
superior -0.41896754
diagonal -0.63179849Escores
escores <- summary(pca)$x
head(escores) PC1 PC2 PC3 PC4 PC5 PC6
[1,] -1.7430272 -1.64669605 -1.4201973 -2.7479691 0.003293759 0.60202200
[2,] 2.2686248 0.53744461 -0.5313151 -0.6573558 -0.158171742 0.45654268
[3,] 2.2717009 0.10740754 -0.7156191 -0.3408384 -0.453880889 -0.04532905
[4,] 2.2778385 0.08743490 0.6041176 -0.3918255 -0.282913485 -0.05543875
[5,] 2.6255397 -0.03909779 -3.1883837 0.4240168 -0.277502895 0.72026433
[6,] -0.7565089 -3.08101359 -0.7845117 -0.5980322 0.192757017 -0.10529393No gráfico a seguir, podemos observar a distribuição das observações de acordo com as duas primeiras componentes principais. Esse gráfico permite a identificação de grupos. A intensidade da cor indica o quão bem representadas as observações estão de acordo com os seus escores.
factoextra::fviz_pca_ind(pca,
col.ind = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
legend.title = "Representation"
)
- Verificaremos a medida de contribuição das variáveis para os dois fatores
factoextra::fviz_pca_var(pca,
col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
legend.title = "Contribution"
)
Conforme o gráfico podemos ver a extrema contribuição de comprimento para o segundo fator.
O gráfico a seguir, conhecido por biplot, reune informações acerca da distribuição das observações de acordo com os escores das componentes principais e informações sobre a contribuição das variáveis para as componentes principais.
factoextra::fviz_pca_biplot(pca,
repel = TRUE,
col.var = "#2E9FDF",
col.ind = "#696969"
)
factoextra::fviz_pca_ind(pca,
col.ind = dados$classe,
palette = c("#00AFBB", "#FC4E07"),
addEllipses = TRUE,
ellipse.type = "confidence",
legend.title = "classe",
repel = TRUE
)
Com este gráfico vamos enxergar quais variáveis contribuem mais para a classificação dos grupos
factoextra::fviz_pca_biplot(pca,
repel = TRUE,
col.var = "black",
col.ind = as.factor(dados$classe),
addEllipses = TRUE,
legend.title = "Classe"
)
Análise fatorial
Análise da utilização de Análise Fatorial
Consideraremos a medida de Kaiser, Meyer & Olkin de adequaçao da amostra para analise fatorial. Um limiar comumente adotado para esta medida é igual a 60%.
psych::KMO(correlação)Kaiser-Meyer-Olkin factor adequacy
Call: psych::KMO(r = correlação)
Overall MSA = 0.65
MSA for each item =
comprimento altura...LE altura...LD inferior superior diagonal
0.50 0.72 0.73 0.59 0.55 0.65 Como, podemos observar que o resultado do geral foi igual a 0.65, podemos neste caso utilizar a análise fatorial para resumir o conjunto de variáveis.
Consideraremos também o teste de esfericidade de Bartlett sobre a matriz de correlações amostrais, que testa a hipótese nula de que a matriz de correlações é igual a uma matriz identidade. Valores pequenos do p-valor indicam que uma análise fatorial pode ser útil aos dados.
psych::cortest.bartlett(correlação, n = nrow(dados1))$chisq
[1] 508.9791
$p.value
[1] 7.120272e-99
$df
[1] 15Tivemos como resultado do p-valor \(7.12 \times 10^{-103}\), sendo menor do que o meu nível de significância adotado que foi de 5% rejeitamos a hipótese nula de que a aplicação da análise fatorial não é adequada.
Investigando o número de fatores
eigv <- eigen(correlação)
eigv <- data.frame(nfact = 1:ncol(dados1), eigval = eigv$values)
ggplot2::ggplot(data = eigv, mapping = ggplot2::aes(nfact, eigval)) +
ggplot2::geom_col(fill = "#4d4dff", colour = "black" ) +
ggplot2::geom_line() +
ggplot2::geom_point() +
ggplot2::geom_abline(slope = 0, intercept = 1, color = "red") +
ggplot2::labs(x = "Número de fatores",
y = "Autovalor",
title = "Scree plot") +
ggplot2::theme_minimal()
De acordo com a análise gráfica acima temos o número de dois fatores como um bom número para explicar boa parte da variabilidade dos dados.
Obtendo o modelo fatorial ortogonal
Inicialmente, vamos obter o modelo fatorial ortogonal sem considerar rotação de fatores. Observe que o p-valor do teste de hipótese sobre o número de fatores não corrobora com a informação de que 2 fatores são suficientes para explicar a estrutura de covariância do conjunto de dados, embora tenhamos que aproximadamente 58,0% da variação total é explicada por 2 fatores. O primeiro fator parece ser um contraste entre diagonal e comprimento, contra altura - LD, altura - LE, inferior e superior. Enquanto o segundo fator parece ser uma soma ponderada de comprimento, altura - LD, altura - LE e inferior. Vemos que o peso maior é atribuido a diagonal no fator 1.
mfo1 <- factanal(dados1, 2, rotation = "none")
mfo1
Call:
factanal(x = dados1, factors = 2, rotation = "none")
Uniquenesses:
comprimento altura...LE altura...LD inferior superior diagonal
0.787 0.190 0.309 0.589 0.638 0.005
Loadings:
Factor1 Factor2
comprimento -0.189 0.422
altura...LE 0.516 0.737
altura...LD 0.529 0.642
inferior 0.626 0.136
superior 0.596
diagonal -0.997
Factor1 Factor2
SS loadings 2.324 1.159
Proportion Var 0.387 0.193
Cumulative Var 0.387 0.580
Test of the hypothesis that 2 factors are sufficient.
The chi square statistic is 51.41 on 4 degrees of freedom.
The p-value is 1.83e-10 psych::fa.diagram(mfo1$loadings, digits = 3)
Conforme resultado da análise fatorial, com dois fatores não foi obtida uma explicação significativa da variabilidade dos dados, pois, o resultado do percentual de variância acumulada que é explicada é de 58.0%, sendo assim vamos utilizar um novo modelo com 3 fatores, e rotação varimax, que ajudará na interpretação dos fatores.
L <- mfo1$loadings
plot(L, type = "n", xlab = "Fator 1", ylab = "Fator 2", xlim = c(-1,1),ylim = c(-1,1))+
text(L, names(dados1), cex = 0.7)
integer(0)Novo modelo com 3 fatores e rotação varimax
mfo2 <- factanal(dados1, 3, scores = "regression", rotation = "varimax")
mfo2
Call:
factanal(x = dados1, factors = 3, scores = "regression", rotation = "varimax")
Uniquenesses:
comprimento altura...LE altura...LD inferior superior diagonal
0.716 0.205 0.292 0.005 0.402 0.164
Loadings:
Factor1 Factor2 Factor3
comprimento -0.180 -0.132 0.484
altura...LE 0.351 0.410 0.710
altura...LD 0.427 0.406 0.601
inferior 0.987 0.142
superior 0.769
diagonal -0.523 -0.750
Factor1 Factor2 Factor3
SS loadings 1.587 1.524 1.106
Proportion Var 0.265 0.254 0.184
Cumulative Var 0.265 0.519 0.703
The degrees of freedom for the model is 0 and the fit was 0.0189 Preferível a utilização desse modelo, onde temos que cerca de 70.30% da variabilidade total está sendo explicada por três fatores.
O primeiro fator parece ser um contraste entre diagonal e comprimento, contra altura - LD, altura - LE e inferior. Enquanto o segundo fator parece ser um contraste entre diagonal e comprimento, contra altura - LD, altura - LE ,inferior e superior. Enquanto o terceiro fator é uma média ponderada entre comprimento, altura - LD e altura - LE. Vemos que o peso maior é atribuido a inferior no fator 1, superior no fator 2 e altura - LE no fator 3.
psych::fa.diagram(mfo2$loadings, digits = 3)
L1 <- mfo2$loadings
f1 <- L1[,1]
f2 <- L1[,2]
f3 <- L1[,3]
plot(f1,f2 , type = "n", xlab = "Fator 1", ylab = "Fator 2", xlim = c(-1,1),ylim = c(-1,1))+
text(L1[,c(1,2)], names(dados1), cex = 0.7)
integer(0)plot(f1,f3 , type = "n", xlab = "Fator 1", ylab = "Fator 3", xlim = c(-1,1),ylim = c(-1,1))+
text(L1[,c(1,3)], names(dados1), cex = 0.7)
integer(0)plot(f2,f3 , type = "n", xlab = "Fator 2", ylab = "Fator 3", xlim = c(-1,1),ylim = c(-1,1))+
text(L1[,c(2,3)], names(dados1), cex = 0.7)
integer(0)Comunalidades
O objetivo das comunalidades é resumir o percentual de explicação do modelo obtido para as variáveis descritas no banco.
comunalidades <- rowSums(mfo2$loadings^2)
comunalidadescomprimento altura...LE altura...LD inferior superior diagonal
0.2839374 0.7951870 0.7084637 0.9950005 0.5983678 0.8361768 Segue abaixo uma tabela com o percentual da explicação da variabilidade das variáveis com o uso dos três fatores:
| Nome da Variável | Percentual (%) |
|---|---|
| Comprimento da nota | 28.39 |
| altura do lado esquerdo | 79.52 |
| altura do lado direito | 70.85 |
| borda inferior | 99.5 |
| borda superior | 59.84 |
| comprimento da diagonal | 83.62 |
Matriz Residual
rho_til <- mfo2$loadings%*%t(mfo2$loadings)+diag(mfo2$uniquenesses)
U <- correlação - rho_til
round(U, 4) comprimento altura...LE altura...LD inferior superior diagonal
comprimento 0.0000 0.0050 -0.0092 1e-04 0.0088 0.0035
altura...LE 0.0050 0.0000 0.0002 -1e-04 -0.0188 -0.0088
altura...LD -0.0092 0.0002 0.0000 2e-04 0.0288 0.0137
inferior 0.0001 -0.0001 0.0002 0e+00 0.0000 0.0000
superior 0.0088 -0.0188 0.0288 0e+00 0.0000 -0.0001
diagonal 0.0035 -0.0088 0.0137 0e+00 -0.0001 0.0000De acordo com a matriz residual, é observado que o modelo com três fatores está bem adequado, pois é esperado uma matriz bem próximo da matriz nula.
Escores Fatoriais
Imprimindo algumas linhas dos escores fatoriais que foram estimados via método de regressão
head(mfo2$scores) Factor1 Factor2 Factor3
[1,] -0.2829557 -0.2362549 2.9629805
[2,] -0.7782451 -0.9210892 -0.4958697
[3,] -0.2953534 -1.4282570 -0.3736576
[4,] -1.2472737 -0.6128655 -0.4405175
[5,] 1.0572744 -2.5408608 -0.5988885
[6,] -0.2311578 -0.6429776 2.4866194Imprimindo as últimas linhas
tail(mfo2$scores) Factor1 Factor2 Factor3
[195,] 1.5363104 -0.1305263 0.34914501
[196,] 0.1702829 1.1123120 0.40593685
[197,] 0.5306476 0.5725986 -0.07305353
[198,] 0.7827642 0.2595843 0.35038033
[199,] 1.1375422 0.6637066 1.15969426
[200,] 0.4527587 0.7545159 -1.17433869Métodos de Classificação
Análise Discriminante
GGally::ggpairs(dados, mapping = ggplot2::aes(colour = classe))Registered S3 method overwritten by 'GGally':
method from
+.gg ggplot2`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Análise Discriminante clássica linear
O objetivo da análise discriminante é que posssamos através das variáveis categorizar as observações, então através das variáveis quantitativas vamos agrupar as notas em verdadeira ou falsa.
fit_linear <- MASS::lda(classe~., data = dados)
fit_linearCall:
lda(classe ~ ., data = dados)
Prior probabilities of groups:
Verdadeira Falsa
0.5 0.5
Group means:
comprimento altura...LE altura...LD inferior superior diagonal
Verdadeira 214.969 129.943 129.720 8.305 10.168 141.517
Falsa 214.823 130.300 130.193 10.530 11.133 139.450
Coefficients of linear discriminants:
LD1
comprimento -0.005011113
altura...LE -0.832432523
altura...LD 0.848993093
inferior 1.117335597
superior 1.178884468
diagonal -1.556520967valores_preditos <- predict(fit_linear)$class
knitr::kable(table(valores_preditos, dados$classe))| Verdadeira | Falsa | |
|---|---|---|
| Verdadeira | 99 | 0 |
| Falsa | 1 | 100 |
Podemos ver que o modelo foi bem acertivo, errando apenas por uma cédula, entre 200.
Análise Discriminante clássica Quadrática
fit_quad <- MASS::qda(classe~., data = dados)
fit_quadCall:
qda(classe ~ ., data = dados)
Prior probabilities of groups:
Verdadeira Falsa
0.5 0.5
Group means:
comprimento altura...LE altura...LD inferior superior diagonal
Verdadeira 214.969 129.943 129.720 8.305 10.168 141.517
Falsa 214.823 130.300 130.193 10.530 11.133 139.450valores_preditos1 <- predict(fit_quad)$class
knitr::kable(table(valores_preditos1, dados$classe))| Verdadeira | Falsa | |
|---|---|---|
| Verdadeira | 99 | 0 |
| Falsa | 1 | 100 |
É observado que o modelo quadrático também obteve o mesmo desempenho do modelo linear, o que já era esperado devido a separação dos grupos.
K-NN para Classificação
Ajuste Básico
Para o ajuste do modelo básico de K-NN, podemos usar a função knn3 da biblioteca caret. Precisamos passar apenas dois argumentos, a equação e o conjunto de dados.
fit <- caret::knn3(classe~., data = dados)
fit5-nearest neighbor model
Training set outcome distribution:
Verdadeira Falsa
100 100 Treinando o modelo com a biblioteca caret
Podemos utilizar a função train da biblioteca caret para treinar o modelo de K-NN.
set.seed(2023)
fit2 <- caret::train(classe~.,
data = dados,
method = "knn")Carregando pacotes exigidos: ggplot2Carregando pacotes exigidos: latticefit2k-Nearest Neighbors
200 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Bootstrapped (25 reps)
Summary of sample sizes: 200, 200, 200, 200, 200, 200, ...
Resampling results across tuning parameters:
k Accuracy Kappa
5 0.9952831 0.9905288
7 0.9968387 0.9936504
9 0.9963237 0.9926127
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was k = 7.plot(fit2)
De acordo com a análise gráfica e com o ajuste, vemos que com esses valores de k testados, o melhor valor foi o de k = 9.
Pré-processamento
Também em problemas de classificação precisamos proceder o pré-processamento dos dados antes de treinar os modelos. Vamos, inicialmente, remover os efeitos de locação e escala.
set.seed(2023)
fit3 <- caret::train(classe~.,
data = dados,
method = "knn",
preProcess = c("center","scale"))
fit3k-Nearest Neighbors
200 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
Pre-processing: centered (6), scaled (6)
Resampling: Bootstrapped (25 reps)
Summary of sample sizes: 200, 200, 200, 200, 200, 200, ...
Resampling results across tuning parameters:
k Accuracy Kappa
5 0.9888262 0.9774832
7 0.9871473 0.9741163
9 0.9861700 0.9720915
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was k = 5.É observado que sem o pré-processamento padronizando as variáveis temos resultados melhores, daqui por diante usaremos sem padroniza-lás.
plot(fit3)
Avaliando o modelo com holdout
Vamos dividir nosso conjunto de dados em um conjunto de treinamento, onde os modelos serão ajustados, e um conjunto de teste, que será utilizado para avaliar o modelo. Utilizaremos novamente a função createDataPartition para a divisão do conjunto de dados.
set.seed(2023)
in.treino <- caret::createDataPartition(dados$classe, p = 0.80, list = FALSE)
treino <- dados[in.treino,]
teste <- dados[-in.treino,]Depois de criada a partição vamos continuar com o ajuste holdout
set.seed(2023)
fit4 <- caret::train(classe~.,
data = treino,
method = "knn")
fit4k-Nearest Neighbors
160 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Bootstrapped (25 reps)
Summary of sample sizes: 160, 160, 160, 160, 160, 160, ...
Resampling results across tuning parameters:
k Accuracy Kappa
5 0.9916497 0.9831957
7 0.9971155 0.9942032
9 0.9957120 0.9913883
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was k = 7.plot(fit4)
Agora, queremos avaliar nosso modelo no conjunto de teste. Precisamos remover a variável resposta do conjunto de teste antes.
teste.features <- subset(teste, select = -c(classe))
teste.target <- subset(teste, select = classe)[,1]
predições <- predict(fit4, newdata = teste.features)- Observando a matriz de confusão para analisar a acertividade do ajuste
caret::confusionMatrix(predições, teste.target)Confusion Matrix and Statistics
Reference
Prediction Verdadeira Falsa
Verdadeira 20 0
Falsa 0 20
Accuracy : 1
95% CI : (0.9119, 1)
No Information Rate : 0.5
P-Value [Acc > NIR] : 9.095e-13
Kappa : 1
Mcnemar's Test P-Value : NA
Sensitivity : 1.0
Specificity : 1.0
Pos Pred Value : 1.0
Neg Pred Value : 1.0
Prevalence : 0.5
Detection Rate : 0.5
Detection Prevalence : 0.5
Balanced Accuracy : 1.0
'Positive' Class : Verdadeira
Podemos ver que aos meus dados se ajustou muito bem, tendo uma precisão de 1.
Avaliando o modelo com validação cruzada
Novamente, vamos utilizar a função trainControl para definir parâmetros de treinamento para uma estratégia de 10-fold cross-validation.
set.seed(2023)
controle <- caret::trainControl(method = "cv",
number = 10)set.seed(2023)
fit5 <- caret::train(classe~.,
data = treino,
method = "knn",
trControl = controle)
fit5k-Nearest Neighbors
160 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 144, 144, 144, 144, 144, 144, ...
Resampling results across tuning parameters:
k Accuracy Kappa
5 0.99375 0.9875
7 0.99375 0.9875
9 0.99375 0.9875
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was k = 9.plot(fit5)
Agora, queremos avaliar nosso modelo no conjunto de teste.
predições2 <- predict(fit5, newdata = teste.features)Calculamos a matriz de confusão e medidas de avaliação:
caret::confusionMatrix(predições2, teste.target)Confusion Matrix and Statistics
Reference
Prediction Verdadeira Falsa
Verdadeira 20 0
Falsa 0 20
Accuracy : 1
95% CI : (0.9119, 1)
No Information Rate : 0.5
P-Value [Acc > NIR] : 9.095e-13
Kappa : 1
Mcnemar's Test P-Value : NA
Sensitivity : 1.0
Specificity : 1.0
Pos Pred Value : 1.0
Neg Pred Value : 1.0
Prevalence : 0.5
Detection Rate : 0.5
Detection Prevalence : 0.5
Balanced Accuracy : 1.0
'Positive' Class : Verdadeira
Podemos ver que nesses dois casos já se tem um ajuste excelente, sem a necessidade de proceder com um tunning no número de vizinhos.
Árvores para classificação
Modelo básico
fit6 <- rpart::rpart(classe~.,
data = dados)
fit6n= 200
node), split, n, loss, yval, (yprob)
* denotes terminal node
1) root 200 100 Verdadeira (0.50000000 0.50000000)
2) diagonal>=140.65 98 0 Verdadeira (1.00000000 0.00000000) *
3) diagonal< 140.65 102 2 Falsa (0.01960784 0.98039216) *plot(fit6)+
text(fit6, cex = 1.25)Error in plot(fit6) + text(fit6, cex = 1.25): argumento não-numérico para operador binário
Treinando o modelo com a biblioteca caret
Podemos utilizar a função train da biblioteca caret para treinar o modelo de árvore de classificação.
set.seed(2023)
fit7 <- caret::train(classe~.,
data = dados,
method = "rpart")
fit7CART
200 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Bootstrapped (25 reps)
Summary of sample sizes: 200, 200, 200, 200, 200, 200, ...
Resampling results across tuning parameters:
cp Accuracy Kappa
0.00 0.9903455 0.9805593
0.49 0.9903455 0.9805593
0.98 0.6302126 0.3071613
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.49.plot(fit7)
Avaliando o modelo com holdout
fit8 <- caret::train(classe~.,
data = treino,
method = "rpart")
fit8CART
160 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Bootstrapped (25 reps)
Summary of sample sizes: 160, 160, 160, 160, 160, 160, ...
Resampling results across tuning parameters:
cp Accuracy Kappa
0.00000 0.9945984 0.9891673
0.49375 0.9945984 0.9891673
0.98750 0.6299476 0.3091673
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.49375.plot(fit8)
Calculamos a matriz de confusão e medidas de avaliação:
predições3 <- predict(fit8, newdata = teste.features)
caret::confusionMatrix(predições3, teste.target)Confusion Matrix and Statistics
Reference
Prediction Verdadeira Falsa
Verdadeira 20 1
Falsa 0 19
Accuracy : 0.975
95% CI : (0.8684, 0.9994)
No Information Rate : 0.5
P-Value [Acc > NIR] : 3.729e-11
Kappa : 0.95
Mcnemar's Test P-Value : 1
Sensitivity : 1.0000
Specificity : 0.9500
Pos Pred Value : 0.9524
Neg Pred Value : 1.0000
Prevalence : 0.5000
Detection Rate : 0.5000
Detection Prevalence : 0.5250
Balanced Accuracy : 0.9750
'Positive' Class : Verdadeira
Conforme o observado já vemos que entre o método de avaliação com holdout da árvore de decisão e o da validação cruzada através do K-NN, o utilizando os vizinhos mais próximos se mostrou mais eficiente.
Avaliando o modelo com validação cruzada
Novamente, vamos utilizar a função trainControl para definir parâmetros de treinamento para uma estratégia de 10-fold cross-validation.
set.seed(2023)
controle2 <- caret::trainControl(method = "cv",
number = 10)set.seed(2023)
fit9 <- caret::train(classe~.,
data = treino,
method = "rpart",
trControl = controle2)
fit9CART
160 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 144, 144, 144, 144, 144, 144, ...
Resampling results across tuning parameters:
cp Accuracy Kappa
0.00000 0.99375 0.9875
0.49375 0.99375 0.9875
0.98750 0.54375 0.0875
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.49375.plot(fit9)
Calculamos a matriz de confusão e medidas de avaliação:
predições4 <- predict(fit9, newdata = teste.features)
caret::confusionMatrix(predições4, teste.target)Confusion Matrix and Statistics
Reference
Prediction Verdadeira Falsa
Verdadeira 20 1
Falsa 0 19
Accuracy : 0.975
95% CI : (0.8684, 0.9994)
No Information Rate : 0.5
P-Value [Acc > NIR] : 3.729e-11
Kappa : 0.95
Mcnemar's Test P-Value : 1
Sensitivity : 1.0000
Specificity : 0.9500
Pos Pred Value : 0.9524
Neg Pred Value : 1.0000
Prevalence : 0.5000
Detection Rate : 0.5000
Detection Prevalence : 0.5250
Balanced Accuracy : 0.9750
'Positive' Class : Verdadeira
Tunning no parâmetro de complexidade
tunegrid <- expand.grid(cp = seq(0,1, by = 0.01))fit10 <- caret::train(classe~.,
data = treino,
method = "rpart",
trControl = controle2,
tuneGrid = tunegrid)
fit10CART
160 samples
6 predictor
2 classes: 'Verdadeira', 'Falsa'
No pre-processing
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 144, 144, 144, 144, 144, 144, ...
Resampling results across tuning parameters:
cp Accuracy Kappa
0.00 0.99375 0.9875
0.01 0.99375 0.9875
0.02 0.99375 0.9875
0.03 0.99375 0.9875
0.04 0.99375 0.9875
0.05 0.99375 0.9875
0.06 0.99375 0.9875
0.07 0.99375 0.9875
0.08 0.99375 0.9875
0.09 0.99375 0.9875
0.10 0.99375 0.9875
0.11 0.99375 0.9875
0.12 0.99375 0.9875
0.13 0.99375 0.9875
0.14 0.99375 0.9875
0.15 0.99375 0.9875
0.16 0.99375 0.9875
0.17 0.99375 0.9875
0.18 0.99375 0.9875
0.19 0.99375 0.9875
0.20 0.99375 0.9875
0.21 0.99375 0.9875
0.22 0.99375 0.9875
0.23 0.99375 0.9875
0.24 0.99375 0.9875
0.25 0.99375 0.9875
0.26 0.99375 0.9875
0.27 0.99375 0.9875
0.28 0.99375 0.9875
0.29 0.99375 0.9875
0.30 0.99375 0.9875
0.31 0.99375 0.9875
0.32 0.99375 0.9875
0.33 0.99375 0.9875
0.34 0.99375 0.9875
0.35 0.99375 0.9875
0.36 0.99375 0.9875
0.37 0.99375 0.9875
0.38 0.99375 0.9875
0.39 0.99375 0.9875
0.40 0.99375 0.9875
0.41 0.99375 0.9875
0.42 0.99375 0.9875
0.43 0.99375 0.9875
0.44 0.99375 0.9875
0.45 0.99375 0.9875
0.46 0.99375 0.9875
0.47 0.99375 0.9875
0.48 0.99375 0.9875
0.49 0.99375 0.9875
0.50 0.99375 0.9875
0.51 0.99375 0.9875
0.52 0.99375 0.9875
0.53 0.99375 0.9875
0.54 0.99375 0.9875
0.55 0.99375 0.9875
0.56 0.99375 0.9875
0.57 0.99375 0.9875
0.58 0.99375 0.9875
0.59 0.99375 0.9875
0.60 0.99375 0.9875
0.61 0.99375 0.9875
0.62 0.99375 0.9875
0.63 0.99375 0.9875
0.64 0.99375 0.9875
0.65 0.99375 0.9875
0.66 0.99375 0.9875
0.67 0.99375 0.9875
0.68 0.99375 0.9875
0.69 0.99375 0.9875
0.70 0.99375 0.9875
0.71 0.99375 0.9875
0.72 0.99375 0.9875
0.73 0.99375 0.9875
0.74 0.99375 0.9875
0.75 0.99375 0.9875
0.76 0.99375 0.9875
0.77 0.99375 0.9875
0.78 0.99375 0.9875
0.79 0.99375 0.9875
0.80 0.99375 0.9875
0.81 0.99375 0.9875
0.82 0.99375 0.9875
0.83 0.99375 0.9875
0.84 0.99375 0.9875
0.85 0.99375 0.9875
0.86 0.99375 0.9875
0.87 0.99375 0.9875
0.88 0.99375 0.9875
0.89 0.99375 0.9875
0.90 0.99375 0.9875
0.91 0.99375 0.9875
0.92 0.99375 0.9875
0.93 0.99375 0.9875
0.94 0.99375 0.9875
0.95 0.99375 0.9875
0.96 0.99375 0.9875
0.97 0.99375 0.9875
0.98 0.99375 0.9875
0.99 0.54375 0.0875
1.00 0.50000 0.0000
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.98.plot(fit10)
Calculamos a matriz de confusão e medidas de avaliação:
predições5 <- predict(fit10, newdata = teste.features)
caret::confusionMatrix(predições5, teste.target)Confusion Matrix and Statistics
Reference
Prediction Verdadeira Falsa
Verdadeira 20 1
Falsa 0 19
Accuracy : 0.975
95% CI : (0.8684, 0.9994)
No Information Rate : 0.5
P-Value [Acc > NIR] : 3.729e-11
Kappa : 0.95
Mcnemar's Test P-Value : 1
Sensitivity : 1.0000
Specificity : 0.9500
Pos Pred Value : 0.9524
Neg Pred Value : 1.0000
Prevalence : 0.5000
Detection Rate : 0.5000
Detection Prevalence : 0.5250
Balanced Accuracy : 0.9750
'Positive' Class : Verdadeira
Conclusão da redução de dimensionalidade
Conforme os resultados obtidos, é preferível a utilização de diminuir as dimensões através de componentes principais, houve um bom poder explicativo do ajuste com a mesma dimensão que foi utilizada na análise fatorial, e por obtermos resultados mais interpretáveis em componentes principais, ficou-se com a utilização de ACP.
Conclusão dos métodos de classifcação
Depois de observados os métodos que foram ajustados ao conjunto de teste e de treino que foi o mesmo, o melhor ajuste foi com cross-validation baseado em K-NN, onde conseguiu uma acurácia de 1, e classificar os valores em suas classes de maneira correta.