1 Codificação de variáveis categóricas

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.

1.1 Variáveis dummy

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

2 Análise de componentes principais (ACP)

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

  1. Calcule a matriz de covariâncias \(\mathbf{S}\) de \(\mathbf{X}\).
  2. Calcule os autovetores e autovalores de \(\mathbf{S}\) (decomposição espectral de \(\mathbf{S}\)).
  3. Ordenar de maneira crescente os autovalores \(\lambda_1 \leq \cdots \leq \lambda_p\) de \(\mathbf{S}\).
  4. Construir a matriz de cargas \(\mathbf{U} = [\mathbf{u}^{(1)}, \cdots, \mathbf{u}^{(p)}]\), em que \(\mathbf{u}^{(j)}\) é o autovetor associado a \(\lambda_j\).
  5. Tranformar a matriz \(\mathbf{X}\) através \(\mathbf{Z} = \mathbf{U}\mathbf{X}\). A matriz \(\mathbf{Z}\), é comumente chamada de matriz de escores e pode ser vista como a projeção de \(\mathbf{X}\) no espaço gerado por \(\mathbf{U}\).

Observações

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

3 ACP com a função 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               
## 

4 ACP dentro da função 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               
##