Caso a variável seja categórica ordinal, podemos simplesmente
atribuir um número inteiro a cada possível reposta, mantendo a ordem das
respostas. Por exemplo, se consideramos a variável
grau de escolaridade com três possíveis respostas:
fundamental, médio, e superior,
podemos codificá-la com os inteiros, 1, 2 e 3, respectivamente.
Caso a variável seja categórica nominal, devemos tomar maior cuidado pois não existe uma ordem de “importância” nas respostas. Neste caso, introduziremos uma codificação diferente chamada de variável dummy ou one-hot-encoder, como é chamada comumente entre os praticantes de AM.
Para ilustrar como funciona essa codificação, considere a variável
região e suponha que assume os seguintes três valores:
sul, norte e nordeste.
A ideia é criar uma nova variável fictícia para cada possível
resposta da variável categórica, em nosso exemplo criaremos três novas
variáveis: sul, norte e nordeste.
O valor da variável será 1 se o indivíduo possui a característica e 0 se
não a possui. Assim, um indivíduo da região sul terá o valor
[1,0,0].
df <- data.frame(
salario = c(1,5.5,6,7.2),
regiao = c("sul","sul","norte","nordeste"),
escolaridade = c("fundamental", "superior", "medio","superior"),
idade = c(25,40,51,30),
stringsAsFactors = TRUE
)
df
## salario regiao escolaridade idade
## 1 1.0 sul fundamental 25
## 2 5.5 sul superior 40
## 3 6.0 norte medio 51
## 4 7.2 nordeste superior 30
library(caret)
# Criando as variáveis dummies
preDummiesVar <- dummyVars(salario~escolaridade + regiao, data = df)
# Aplicando as dummies
DummiesVar <- predict(preDummiesVar, df)
DummiesVar
## escolaridade.fundamental escolaridade.medio escolaridade.superior
## 1 1 0 0
## 2 0 0 1
## 3 0 1 0
## 4 0 0 1
## regiao.nordeste regiao.norte regiao.sul
## 1 0 0 1
## 2 0 0 1
## 3 0 1 0
## 4 1 0 0
# data frame completo
df_dummies <- cbind(df,DummiesVar)
df_dummies <- df_dummies[,-c(2,3)]
df_dummies
## salario idade escolaridade.fundamental escolaridade.medio
## 1 1.0 25 1 0
## 2 5.5 40 0 0
## 3 6.0 51 0 1
## 4 7.2 30 0 0
## escolaridade.superior regiao.nordeste regiao.norte regiao.sul
## 1 0 0 0 1
## 2 1 0 0 1
## 3 0 0 1 0
## 4 1 1 0 0
Vale a pena notar que a matriz de preditoras não é de posto completo,
pois uma vez conhecido os valores de, por exemplo,
escolaridade.fundamental e
escolaradidade.medio saberemos os valores de
escolariadade.superior.
Adicionando, o argumento fullRank = TRUE na função
dummyVars podemos remover as variáveis linearmente
dependentes, como é mostrado a seguir:
# Criando as variáveis dummies não colineares
preDummiesVar <- dummyVars(salario~escolaridade + regiao, data = df, fullRank = TRUE)
# Aplicando as dummies
DummiesVar <- predict(preDummiesVar, df)
# data frame final completo
df_dummies_final <- cbind(df,DummiesVar)
df_dummies_final <- df_dummies[,-c(2,3)]
df_dummies_final
## salario escolaridade.medio escolaridade.superior regiao.nordeste regiao.norte
## 1 1.0 0 0 0 0
## 2 5.5 0 1 0 0
## 3 6.0 1 0 0 1
## 4 7.2 0 1 1 0
## regiao.sul
## 1 1
## 2 1
## 3 0
## 4 0
A análise de componentes principais é um método não supervisionado que visa construir um novo conjunto de variáveis não correlacionadas a partir de um conjunto de variáveis de entrada e que preservam a variabilidade contida nos dados originais, chamadas de componentes principais. Cada componente principal é construido como uma combinação linear das variáveis de entrada, de modo que o primeiro componente principal preserva maior variabilidade nos dados, o segundo a segunda maior variabilidade, e assim sucessivamente.
A técnica pode ser usada para reduzir a dimensionalidade original dos dados, retendo um número menor de componentes que a dimensão original dos dados de entrada.
Mais precisamente, aplicamos uma transformação ortogonal \(\mathbf{U} = [\mathbf{u}^{(1)}, \ldots, \mathbf{u}^{(p)}]\) à matriz de variáveis preditoras \(\mathbf{X} = [\mathbf{x}^{(1)}, \ldots, \mathbf{x}^{(p)}]\), em que \(\mathbf{u}^{(1)}, \cdots, \mathbf{u}^{(p)}\) são os autovetores associados aos autovalores \(\lambda_1 \leq \cdots \leq \lambda_p\) da matriz de covariâncias \(\mathbf{S}\) de \(\mathbf{X}\).
Passos para realizar uma ACP
Observações
Para redução de dimensionalidade selecionamos um número \(k < p\) de componentes principais. Em geral, \(k=2,3\) é o desejado, especialmente para visualização.
Em alguns casos, podemos realizar uma ACP com os dados padronizados, neste caso a ACP é equivalente a relizar a decomposição espectral da matriz de correlações \(\mathbf{R}\) de \(\mathbf{X}\).
library(Stat2Data)
library(dplyr)
data("BlueJays")
dados <- BlueJays[,3:9]
dados$Sex <- as.factor(dados$Sex)
glimpse(dados)
## Rows: 123
## Columns: 7
## $ BillDepth <dbl> 8.26, 8.54, 8.39, 7.78, 8.71, 7.28, 8.74, 8.72, 8.20, 7.67,…
## $ BillWidth <dbl> 9.21, 8.76, 8.78, 9.30, 9.84, 9.30, 9.28, 9.94, 9.01, 9.31,…
## $ BillLength <dbl> 25.92, 24.99, 26.07, 23.48, 25.47, 22.25, 25.35, 30.00, 22.…
## $ Head <dbl> 56.58, 56.36, 57.32, 53.77, 57.32, 52.25, 57.12, 60.67, 52.…
## $ Mass <dbl> 73.30, 75.10, 70.25, 65.50, 74.90, 63.90, 75.10, 78.10, 64.…
## $ Skull <dbl> 30.66, 31.38, 31.25, 30.29, 31.85, 30.00, 31.77, 30.67, 30.…
## $ Sex <fct> 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1, 1,…
ggplot(dados, aes(x = Head, y = BillLength, fill = Sex)) +
geom_point(shape = 21, size = 5, color = "black", alpha = 0.3) +
scale_fill_manual(values = c("1" = "blue", "0" = "orange")) +
theme_minimal()
# matriz de preditoras
X2 <- dados[,c(3,4)]
# Aplicando um PCA a X2
pcaBlueJays <- prcomp(X2)
# Matriz de rotação
U <- pcaBlueJays$rotation
U
## PC1 PC2
## BillLength -0.5751366 0.8180574
## Head -0.8180574 -0.5751366
Logo, o primeiro e segundo componente principal são dados por:
\[\begin{align}\texttt{Z1} &= -0.575 \;\texttt{BillLength} - 0.8180 \; \texttt{Head}\\ \texttt{Z2} &= 0.8180 \;\texttt{BillLength} - 0.5751 \; \texttt{Head}\end{align}\]
# Escores
Z <- pcaBlueJays$x
Sex <- as.factor(dados$Sex)
dfZ <- data.frame(Z,Sex)
# Projeção dos dados em PC2 vs PC1
ggplot(dfZ, aes(x = PC1, y = PC2, fill = Sex)) +
geom_point(shape = 21, size = 5, color = "black", alpha = 0.3) +
scale_fill_manual(values = c("1" = "blue", "0" = "orange")) +
theme_minimal()
# ACP com todas as variáveis
X <- dados[,-7]
pcaBlueJaysFull <- prcomp(X)
# Matriz de rotação
U <- pcaBlueJaysFull$rotation
U
## PC1 PC2 PC3 PC4 PC5
## BillDepth -0.03961552 0.08989552 -0.06763782 -0.05770882 -0.99118308
## BillWidth -0.03362384 0.08147503 0.01955653 -0.99377559 0.06525873
## BillLength -0.11159588 0.61166243 -0.51854443 0.05004609 0.09273888
## Head -0.21992974 0.72883067 0.28050368 0.07582643 0.05100298
## Mass -0.96162735 -0.25741373 -0.09198285 0.01098280 0.02072545
## Skull -0.10839813 0.11702017 0.79938175 0.02654960 -0.04081731
## PC6
## BillDepth -5.705440e-04
## BillWidth -4.087104e-04
## BillLength -5.774270e-01
## Head 5.774110e-01
## Mass 5.583775e-05
## Skull -5.772123e-01
sqrtautovalores <- pcaBlueJaysFull$sdev
# desvio padrão de cada componente
sqrtautovalores
## [1] 4.939546742 1.514055169 0.902867115 0.494105157 0.304159865 0.001671874
preProcess()library(caret)
set.seed(12345)
index_train <- createDataPartition(y = dados$Sex, p = 0.8, list = FALSE)
training <- dados[index_train,]
testing <- dados[-index_train,]
# Criar método acp nos dados (retendo o primeiro componente)
preProcPCA <- preProcess(training, method = "pca", pcaComp = 5)
# Aplicar acp nos dados de treino
trainingPCA <- predict(preProcPCA, training)
# Aplicar acp nos dados de teste
testingPCA <- predict(preProcPCA, testing)
# CV com 10 folds
ctrl <- trainControl(method = "cv", number = 10)
# Treinando uma regressão logistica com todaas as variáveis
set.seed(12345)
model_glm_raw <- train(Sex~.,
data = training,
method = "glm",
trControl = ctrl)
model_glm_raw
## Generalized Linear Model
##
## 99 samples
## 6 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 89, 89, 89, 90, 89, 89, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8175758 0.6327364
# Avaliando o desempenho do modelo no conjunto teste
predictions_raw <- predict(model_glm_raw, testing)
confusionMatrix(predictions_raw, testing$Sex)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 8 2
## 1 4 10
##
## Accuracy : 0.75
## 95% CI : (0.5329, 0.9023)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : 0.01133
##
## Kappa : 0.5
##
## Mcnemar's Test P-Value : 0.68309
##
## Sensitivity : 0.6667
## Specificity : 0.8333
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.7143
## Prevalence : 0.5000
## Detection Rate : 0.3333
## Detection Prevalence : 0.4167
## Balanced Accuracy : 0.7500
##
## 'Positive' Class : 0
##
Agora, treinaremos o modelo usando como variáveis preditoras os componentes principais:
# Treinando uma regressão logistica usando o primeiro componente
set.seed(12345)
model_glm_pca <- train(Sex~.,
data = trainingPCA,
method = "glm",
trControl = ctrl)
summary(model_glm_pca)
##
## Call:
## NULL
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.00707 0.32263 -0.022 0.98252
## PC1 -1.58888 0.31196 -5.093 3.52e-07 ***
## PC2 0.24132 0.34557 0.698 0.48497
## PC3 0.39994 0.38181 1.047 0.29487
## PC4 0.47931 0.46731 1.026 0.30504
## PC5 -1.64998 0.63425 -2.601 0.00928 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 137.152 on 98 degrees of freedom
## Residual deviance: 63.994 on 93 degrees of freedom
## AIC: 75.994
##
## Number of Fisher Scoring iterations: 6
predictions_PCA <- predict(model_glm_pca, testingPCA)
confusionMatrix(predictions_PCA, testingPCA$Sex)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 8 2
## 1 4 10
##
## Accuracy : 0.75
## 95% CI : (0.5329, 0.9023)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : 0.01133
##
## Kappa : 0.5
##
## Mcnemar's Test P-Value : 0.68309
##
## Sensitivity : 0.6667
## Specificity : 0.8333
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.7143
## Prevalence : 0.5000
## Detection Rate : 0.3333
## Detection Prevalence : 0.4167
## Balanced Accuracy : 0.7500
##
## 'Positive' Class : 0
##
train()ctrl2 <- trainControl(method = "cv", number = 10, preProcOptions = list(pcaComp = 5))
set.seed(12345)
modelo_glm_pca2 <- train(Sex~.,
data = training,
method = "glm",
preProcess = "pca",
trControl = ctrl2)
summary(modelo_glm_pca2)
##
## Call:
## NULL
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.00707 0.32263 -0.022 0.98252
## PC1 -1.58888 0.31196 -5.093 3.52e-07 ***
## PC2 0.24132 0.34557 0.698 0.48497
## PC3 0.39994 0.38181 1.047 0.29487
## PC4 0.47931 0.46731 1.026 0.30504
## PC5 -1.64998 0.63425 -2.601 0.00928 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 137.152 on 98 degrees of freedom
## Residual deviance: 63.994 on 93 degrees of freedom
## AIC: 75.994
##
## Number of Fisher Scoring iterations: 6
predictions_PCA2 <- predict(modelo_glm_pca2, testing)
confusionMatrix(predictions_PCA2, testingPCA$Sex)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 8 2
## 1 4 10
##
## Accuracy : 0.75
## 95% CI : (0.5329, 0.9023)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : 0.01133
##
## Kappa : 0.5
##
## Mcnemar's Test P-Value : 0.68309
##
## Sensitivity : 0.6667
## Specificity : 0.8333
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.7143
## Prevalence : 0.5000
## Detection Rate : 0.3333
## Detection Prevalence : 0.4167
## Balanced Accuracy : 0.7500
##
## 'Positive' Class : 0
##