Conjunto de dados no The UCI Machine Learning Repository, URL https://archive.ics.uci.edu/ml/about.html. 

wine=read.table(file = "http://archive.ics.uci.edu/ml/machine-learning-databases/wine/wine.data", sep=",")
head(wine)
##   V1    V2   V3   V4   V5  V6   V7   V8   V9  V10  V11  V12  V13  V14
## 1  1 14.23 1.71 2.43 15.6 127 2.80 3.06 0.28 2.29 5.64 1.04 3.92 1065
## 2  1 13.20 1.78 2.14 11.2 100 2.65 2.76 0.26 1.28 4.38 1.05 3.40 1050
## 3  1 13.16 2.36 2.67 18.6 101 2.80 3.24 0.30 2.81 5.68 1.03 3.17 1185
## 4  1 14.37 1.95 2.50 16.8 113 3.85 3.49 0.24 2.18 7.80 0.86 3.45 1480
## 5  1 13.24 2.59 2.87 21.0 118 2.80 2.69 0.39 1.82 4.32 1.04 2.93  735
## 6  1 14.20 1.76 2.45 15.2 112 3.27 3.39 0.34 1.97 6.75 1.05 2.85 1450

Informações do conjunto de dados:

Esses dados são resultados de uma análise química de vinhos cultivados na mesma região da Itália, mas derivados de três cultivares diferentes. A análise determinou as quantidades de 13 constituintes encontrados em cada um dos três tipos de vinhos.

Os atributos foram doados por Riccardo Leardi, A primeira variável V1 indica o cultivar de codigos 1, 2 e 3, as outras variáveis são todas contínuas registrando as seguuintes informações cada:

TAREFA: fazer um estudo descritivo e utilizar às componentes principais para depois ajustar um modelo adequado.

OBSERVAÇÃO: selecionar dados para treino e teste.

Selecionando dados para treino e teste: 

set.seed(2345)
indices = sample(1:nrow(wine), 0.7*nrow(wine))
wine1 = wine[indices,]
wine2 = wine[-indices,]

Mostrando as proporções nos arquivos dos diferentes cultivares: 

table(wine[,1])/sum(table(wine[,1]))
## 
##         1         2         3 
## 0.3314607 0.3988764 0.2696629
table(wine1[,1])/sum(table(wine1[,1]))
## 
##         1         2         3 
## 0.3306452 0.4112903 0.2580645
table(wine2[,1])/sum(table(wine2[,1]))
## 
##         1         2         3 
## 0.3333333 0.3703704 0.2962963
library(corrplot)
par(cex = 0.7)
corrplot(cor(wine1[,2:14]), method = "number", type = "upper")

Observam-se claramente variáveis com correlação linear muito baixas, assim decidimos desconsiderar da construção de componentes principais as variáveis V4, V5 e V6. 

pairs(wine1[,2:5])

pairs(wine1[,6:9])

pairs(wine1[,10:14])

wine1.scaled = scale(wine1[,-1])
wine1.prcomp = prcomp(wine1.scaled[,-c(3,4,5)])
summary(wine1.prcomp)
## Importance of components:
##                           PC1   PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.1141 1.510 0.9370 0.80423 0.77127 0.61940 0.50611
## Proportion of Variance 0.4469 0.228 0.0878 0.06468 0.05949 0.03837 0.02561
## Cumulative Proportion  0.4469 0.675 0.7628 0.82744 0.88692 0.92529 0.95090
##                            PC8    PC9    PC10
## Standard deviation     0.49607 0.3937 0.29977
## Proportion of Variance 0.02461 0.0155 0.00899
## Cumulative Proportion  0.97551 0.9910 1.00000
library(ggfortify)
pca.plot <- autoplot(wine1.prcomp, data = wine1, colour = wine1[,1])
pca.plot

Agora podemos utilizar estas combinações lineares e as variáveis desconsideradas para estudar a influência na resposta, os cultivares. Primeiro vamos construir a base de dados na qual trabalharemos. 

PC1 = wine1.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,1]
PC2 = wine1.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,2]
PC3 = wine1.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,3]
PC4 = wine1.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,4]
PC5 = wine1.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,5]
wine3 = data.frame(V1 = wine1[,1], wine1.scaled[,c(3,4,5)], PC1 = PC1, 
                   PC2 = PC2, PC3 = PC3, PC4 = PC4, PC5 = PC5)

Construída a base de dados, ajustamos o modelo Multinomial. 

library(nnet)
ajuste = multinom(factor(V1) ~ V4 + V5 + V6 + PC1, data = wine3, model = TRUE)
## # weights:  18 (10 variable)
## initial  value 136.227924 
## iter  10 value 22.759584
## iter  20 value 19.625076
## iter  30 value 19.568009
## iter  40 value 19.567640
## iter  40 value 19.567640
## iter  40 value 19.567640
## final  value 19.567640 
## converged
summary(ajuste)
## Call:
## multinom(formula = factor(V1) ~ V4 + V5 + V6 + PC1, data = wine3, 
##     model = TRUE)
## 
## Coefficients:
##   (Intercept)         V4       V5         V6       PC1
## 2    4.501350 -3.1607682 4.454958 -0.2706288 -2.388591
## 3   -9.056835 -0.9596712 5.410838  0.5112688 -8.922951
## 
## Std. Errors:
##   (Intercept)        V4       V5        V6       PC1
## 2    1.421956 0.9218499 1.388232 0.3630762 0.7719272
## 3    6.005331 1.7669300 1.885511 1.2063242 2.7555937
## 
## Residual Deviance: 39.13528 
## AIC: 59.13528

Predição na base de dados de teste 


wine2.scaled = scale(wine2[,-1])
PC12 = wine2.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,1]
PC22= wine2.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,2]
PC32= wine2.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,3]
PC42= wine2.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,4]
PC52= wine2.scaled[,-c(3,4,5)]%*%wine1.prcomp$rotation[,5]
wine4 = data.frame(V1 = wine2[,1], wine2.scaled[,c(3,4,5)], PC1 = PC12, 
                   PC2 = PC22, PC3 = PC32, PC4 = PC42, PC5 = PC52)
preditos = predict(ajuste, wine4)
preditos
##  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2
## [39] 2 3 3 3 3 3 3 3 3 3 3 3 2 3 3 3
## Levels: 1 2 3
table(preditos, wine4[,1])
##         
## preditos  1  2  3
##        1 17  1  0
##        2  1 19  2
##        3  0  0 14
mean(preditos != wine4[,1])
## [1] 0.07407407