Fish Prediction
Lucas L. Oliveira
06/02/2021
Introdução
Neste relatório iremos trabalhar com uma base de dados com características de peixes. Segundo https://pt.wikipedia.org/wiki/Peixe e https://www.biologianet.com/, os peixes são animais vertebrados, aquáticos, tipicamente ectotérmicos, ou seja, não produzem calor suficiente para a termorregulação, assim, ajustam suas temperaturas corporais por meio de mecanismos comportamentais. Além disso, possuem o corpo fusiforme (mais espesso ao centro e atenuando-se em direção às extremidades), os membros transformados em barbatanas ou nadadeiras (ausentes em alguns grupos) sustentadas por raios ósseos ou cartilaginosos, guelras ou brânquias com que respiram o oxigénio dissolvido na água (embora os dipnóicos usem pulmões) e, na sua maior parte, o corpo coberto de escamas.
Aqui temos como objetivo predizer o peso (regressão) e espécie (classificação). A base de dados é composta pelas seguintes variáveis:
Species: Determina as características de um determinado grupo de peixes.
Weigth: Peso do peixe (em gramas).
Length1, Length2 e Length3: Variáveis relacionadas ao comprimento do peixe (em centímetros).
Height: Altura do peixe (em centímetros).
Width: Largura do peixe (em centímetros).
Importação e análise da base de dados
Iremos iniciar importando a base de dados, verificando como estão nomeadas as variáveis, a existência de dados faltantes e entendendo quais é a classe de cada uma das variáveis que estamos trabalhando:
library(tidyverse)
library(patchwork)
library(knitr)
library(Metrics)
library(parallel)
library(lasso2)
library(randomForest)
library(MASS)# Importando os dados
dados <- read.csv("Fish.csv")
# Nomes das variáveis
names(dados)## [1] "ï..Species" "Weight" "Length1" "Length2" "Length3"
## [6] "Height" "Width"# Renomeando a variável sobre espécies
dados <- dados %>%
rename(Species = ï..Species)
# Verificando as variáveis novamente
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"# Verificação de dados faltantes na base de dados
table(is.na(dados))##
## FALSE
## 1113# Classes de cada variável
str(dados)## 'data.frame': 159 obs. of 7 variables:
## $ Species: chr "Bream" "Bream" "Bream" "Bream" ...
## $ Weight : num 242 290 340 363 430 450 500 390 450 500 ...
## $ Length1: num 23.2 24 23.9 26.3 26.5 26.8 26.8 27.6 27.6 28.5 ...
## $ Length2: num 25.4 26.3 26.5 29 29 29.7 29.7 30 30 30.7 ...
## $ Length3: num 30 31.2 31.1 33.5 34 34.7 34.5 35 35.1 36.2 ...
## $ Height : num 11.5 12.5 12.4 12.7 12.4 ...
## $ Width : num 4.02 4.31 4.7 4.46 5.13 ...# Tornando cada variável em um vetor para facilitar o código
attach(dados)Análise exploratória
A partir de agora iremos fazer uma análise exploratória. Abaixo veremos alguns histogramas para entendermos a distribuição das variáveis numéricas, as quais estão presentes na base de dados em análise.
p1 <- ggplot(dados, aes(Weight)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
p2 <- ggplot(dados, aes(Length1)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
p3 <- ggplot(dados, aes(Length2)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
p4 <- ggplot(dados, aes(Length3)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
p5 <- ggplot(dados, aes(Height)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
p6 <- ggplot(dados, aes(Width)) + geom_histogram(fill = "#1B9E77", color = "grey", bins = 30)
(p1 | p2) / (p3 | p4) / (p5 | p6) # juntando gráficos dos objetos p1,...,p6
Podemos ver que a variável Weight pode ter a presença de uma observação de um peixe com 0 gramas, o que não faz sentido. Para verificar se realmente temos esse zero iremos utilizar o seguinte comando:
table(dados$Weight==0) # verificando se existe alguma observação em Weight igual a 0##
## FALSE TRUE
## 158 1order(dados$Weight, decreasing = FALSE)[1] # encontrando a linha do 0## [1] 41dados <- dados[-41,] # excluindo a linha com a observação Weight igual a 0
table(dados$Weight==0) # verificando novamente##
## FALSE
## 158Agora, para entender também o comportamente da variável categorica Species, iremos criar uma tabela que nos mostre o quanto cada uma das espécies representam em relação ao todo.
# Gerando tabela de frequencia relativa das espécies
kable(table(Species)/length(Species), col.names = c("Species", "Freq. Relativa"), format = "html")| Species | Freq. Relativa |
|---|---|
| Bream | 0.2215190 |
| Parkki | 0.0696203 |
| Perch | 0.3544304 |
| Pike | 0.1075949 |
| Roach | 0.1202532 |
| Smelt | 0.0886076 |
| Whitefish | 0.0379747 |
Iremos predizer primeiramente a variável Weigth e para isso vamos dar uma olhada em qual é o comportamento das demais variáveis quando a temos como variável resposta. Para as variáveis númericas utilizaremos gráficos de dispersão e para a categórica um boxplot.
p7 <- ggplot(dados, aes(x = Length1, y = Weight)) + geom_point(aes(color = Species))+ scale_color_brewer(palette = "Dark2")
p8 <- ggplot(dados, aes(x = Length2, y = Weight)) + geom_point(aes(color = Species))+ scale_color_brewer(palette = "Dark2")
p9 <- ggplot(dados, aes(x = Length3, y = Weight)) + geom_point(aes(color = Species))+ scale_color_brewer(palette = "Dark2")
p10 <- ggplot(dados, aes(x = Height, y = Weight)) + geom_point(aes(color = Species)) + scale_color_brewer(palette = "Dark2")
p11 <- ggplot(dados, aes(x = Width, y = Weight)) + geom_point(aes(color = Species))+ scale_color_brewer(palette = "Dark2")
p12 <- ggplot(dados, aes(x = Species, y = Weight)) + geom_boxplot(aes(fill=Species)) + scale_fill_brewer(palette = "Dark2")
combined <- (p7 | p8) / (p9 | p10) / (p11|p12) & theme(legend.position = "bottom")
combined + plot_layout(guides = "collect") #juntando gráficos dos objetos p7,...,p12
Com a imagem acima podemos perceber que as variáveis númericas tem uma relação positiva com a variável resposta Weight. Podemos citar também que nas variáveis de comprimento Length1, Length2 e Length3 temos um leve deslocamento para a direita devido ao que cada uma dessas variáveis representa e temos um destaque para a espécie Pike tem os peixes mais compridos e é muito fácil de distinguir-la do restante das espécies quando analisamos as variáveis de comprimento. Além disso, podemos ver também que a variável Height relacionada com Weight distingue muito bem cada uma das espécies dos peixes e pode ser de suma importância para a predição das espécies.
Por fim, quando analisado o boxplot podemos ver de forma clara que os peixes mais pesados pertencem a espécie Pike, os mais leves a Smelt, a maior mediana de peso pertence à espécie Bream e é também a que tem maior concentração em um peso elevado se comparado ao restante. Importante ressaltar também que Roach é a única espécie com outliers (2).
Criação de novas variáveis
Iremos criar algumas novas variáveis que podem ser úteis para a predição. Como estamos querendo obter a predição da variável Weight, a primeira nova variável a ser adicionada na base de dados será a seguinte:
\[ \mbox{area} = \mbox{Height*Length1} \]
dados <- dados %>%
mutate(area = Height*Length1)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area"Uma outra variável que iremos criar é uma que nos dê uma informação um de algo relacionado ao volume:
\[ \mbox{vol} = \mbox{area*Width} \]
dados <- dados %>%
mutate(vol = area*Width)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol"Uma mais voltada para uma proporção tamanho do peixe inteiro (incluso rabo) em relação ao comprimento do “corpo” dos peixes:
\[ \mbox{rabo} = \frac{\mbox{Length3}}{Length1} \]
dados <- dados %>%
mutate(rabo = Length3/Length1)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol" "rabo"Aqui a ideia será a criação de algo como um Índice de Massa Corporal:
\[ \mbox{i_massa} = \frac{\mbox{Weight}}{Height} \]
dados <- dados %>%
mutate(i_massa = Weight/Height)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol" "rabo" "i_massa"Vamos criar uma medida da “quadratura” do peixe:
\[ \mbox{h_l1} = \frac{\mbox{Height}}{Length1} \]
dados <- dados %>%
mutate(h_l1 = Height/Length1)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol" "rabo" "i_massa" "h_l1"Agora agora criar uma que nos permite entender se o peixe é mais inchado e coisas do tipo a partir de:
\[ \mbox{h_width} = \frac{\mbox{Height}}{Width} \]
dados <- dados %>%
mutate(h_width = Height/Width)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol" "rabo" "i_massa" "h_l1" "h_width"Iremos criar uma medida sobre características do rabo do peixe:
\[ \mbox{l3_l2} = \frac{\mbox{Length3}}{Length2} \]
dados <- dados %>%
mutate(l3_l2 = Length3/Length2)
names(dados)## [1] "Species" "Weight" "Length1" "Length2" "Length3" "Height" "Width"
## [8] "area" "vol" "rabo" "i_massa" "h_l1" "h_width" "l3_l2"Por fim, podemos observar que as variáveis foram adicionadas uma por uma em nossa base de dados. Essas são algumas variáveis que podem vir contribuir com as predições. Iremos separar a base de dados em duas amostras aleatórias, sendo uma com 80% das observações para treinamento e 20% para a aplicação do modelo de predição.
# Separando as observações de treino e de aplicação do modelo de predição
set.seed(1) #semente
treino <- dados[sample(1:nrow(dados), round(0.8 * nrow(dados), 0),
replace = F), ] #objeto com base de dados para treino
aplicacao <- dados[sample(1:nrow(dados), round(0.2 * nrow(dados), 0),
replace = F), ]#objeto com base de dados para aplicação do modelo
head(treino) # 10 primeiras observações da base de treino ## Species Weight Length1 Length2 Length3 Height Width area vol
## 68 Parkki 145 19.8 21.5 24.1 9.7364 3.1571 192.7807 608.6280
## 129 Pike 300 31.7 34.0 37.8 5.7078 4.1580 180.9373 752.3371
## 43 Roach 150 20.4 22.0 24.7 5.8045 3.7544 118.4118 444.5653
## 14 Bream 340 29.5 32.0 37.3 13.9129 5.0728 410.4306 2082.0321
## 51 Roach 180 23.6 25.2 27.9 7.0866 3.9060 167.2438 653.2541
## 85 Perch 130 19.3 21.3 22.8 6.3840 3.5340 123.2112 435.4284
## rabo i_massa h_l1 h_width l3_l2
## 68 1.217172 14.89257 0.4917374 3.083969 1.120930
## 129 1.192429 52.55966 0.1800568 1.372727 1.111765
## 43 1.210784 25.84202 0.2845343 1.546053 1.122727
## 14 1.264407 24.43775 0.4716237 2.742647 1.165625
## 51 1.182203 25.40005 0.3002797 1.814286 1.107143
## 85 1.181347 20.36341 0.3307772 1.806452 1.070423head(aplicacao) # 10 primeiras observações da base de aplicação## Species Weight Length1 Length2 Length3 Height Width area vol
## 44 Roach 145 20.5 22.0 24.3 6.6339 3.5478 135.99495 482.4829
## 103 Perch 260 25.4 27.5 28.9 7.1672 4.3350 182.04688 789.1732
## 105 Perch 250 25.4 27.5 28.9 7.2828 4.5662 184.98312 844.6699
## 124 Perch 1000 39.8 43.0 45.2 11.9328 7.2772 474.92544 3456.1274
## 77 Perch 100 16.2 18.0 19.2 5.2224 3.3216 84.60288 281.0169
## 98 Perch 188 22.6 24.6 26.2 6.7334 4.1658 152.17484 633.9299
## rabo i_massa h_l1 h_width l3_l2
## 44 1.185366 21.85743 0.3236049 1.869863 1.104545
## 103 1.137795 36.27637 0.2821732 1.653333 1.050909
## 105 1.137795 34.32746 0.2867244 1.594937 1.050909
## 124 1.135678 83.80263 0.2998191 1.639752 1.051163
## 77 1.185185 19.14828 0.3223704 1.572254 1.066667
## 98 1.159292 27.92052 0.2979381 1.616352 1.065041Com isso feito, já podemos começar a pensar em nosso modelo de predição.
Predição da variável Weight
Modelo - regressão linear
Finalmente, criaremos o nosso primeiro modelo partindo de uma regrassão linear. A regressão linear encontra a linha que melhor representa as variáveis de entrada com a variável de saída, ou variável resposta.Por esse motivo, é uma possível método para termos uma boa predição dos dados, lembrando sempre que trata-se de um modelo probabilístico e estamos sempre lidando com um erro aleatório. Iniciaremos com um modelo básico com todas as covariáveis, exceto a variável i_massa, e veremos como ele desempenha.
fit1 <- lm(Weight ~ Species + Length1 + Length2 + Length3 + Height + Width+ area + vol + rabo + h_l1 + h_width + l3_l2,
data = treino) # definindo modelo de regressão
summary(fit1) # informações sobre o modelo criado##
## Call:
## lm(formula = Weight ~ Species + Length1 + Length2 + Length3 +
## Height + Width + area + vol + rabo + h_l1 + h_width + l3_l2,
## data = treino)
##
## Residuals:
## Min 1Q Median 3Q Max
## -174.874 -25.850 -3.285 22.965 165.591
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.072e+03 1.084e+03 -0.989 0.32502
## SpeciesParkki 6.912e+01 5.501e+01 1.257 0.21163
## SpeciesPerch 2.807e+02 9.912e+01 2.832 0.00552 **
## SpeciesPike 1.533e+02 1.230e+02 1.247 0.21521
## SpeciesRoach 1.905e+02 7.965e+01 2.392 0.01848 *
## SpeciesSmelt 4.008e+02 1.203e+02 3.332 0.00118 **
## SpeciesWhitefish 2.594e+02 7.898e+01 3.285 0.00138 **
## Length1 -7.554e+01 6.707e+01 -1.126 0.26255
## Length2 3.172e+01 6.614e+01 0.480 0.63249
## Length3 4.693e+01 3.847e+01 1.220 0.22516
## Height -2.136e+02 3.646e+01 -5.858 5.13e-08 ***
## Width 9.068e+01 5.526e+01 1.641 0.10371
## area 5.498e+00 1.344e+00 4.090 8.33e-05 ***
## vol -1.335e-01 9.839e-02 -1.357 0.17757
## rabo -1.460e+03 1.399e+03 -1.044 0.29900
## h_l1 2.984e+03 5.672e+02 5.262 7.29e-07 ***
## h_width 3.954e+01 8.997e+01 0.440 0.66117
## l3_l2 1.642e+03 1.428e+03 1.149 0.25297
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 54.26 on 108 degrees of freedom
## Multiple R-squared: 0.9808, Adjusted R-squared: 0.9778
## F-statistic: 324.9 on 17 and 108 DF, p-value: < 2.2e-16prediction1 <- predict(fit1, aplicacao) # salvando predições no objeto prediction1
df1 <- cbind(aplicacao, prediction = prediction1) # fazendo uma junção das predições com a base de dados para aplicação do modelo
rmse(aplicacao$Weight, predict(fit1, aplicacao)) # ROOT MEAN SQUARE DEVIATION## [1] 49.95565mae(aplicacao$Weight, predict(fit1, aplicacao)) # MEAN ABSOLUT PERCENT ERROR## [1] 32.8559ggplot(df1) + geom_point(aes(x = Weight, y = prediction, color = Species)) +
geom_line(aes(x = Weight, y = Weight)) + scale_color_brewer(palette = "Dark2") + theme(legend.position = "bottom") # gráico com valores verdadeiros no eixo x, valores preditos na variável resposta e também uma reta verdade
Modelo - LASSO
LASSO (Least Absolute Shrinkage and Selection Operator) nos permite fazer a regularização como a inserção de bias em um modelo. Ou em outras palavras, essa técnica desencoraja o ajuste excessivo dos dados, afim de diminuir a sua variância. Dentro da equação nos utilizaremos o LASSO para regularizar o modelo a partir de “penalidade”, nós alteramos os fatores de forma a priorizar ou não certas parcelas da equação e, assim, evitamos ‘overfitting’ (sobreajuste) e melhoramos a qualidade de predição.
fit_lasso <- lasso2::l1ce(Weight~Length1+Length2+Length3+Height+Width+area+vol+ rabo+h_l1+h_width+l3_l2,
data = treino,
sweep.out = NULL,
standardize = FALSE
) # LASSO com todas as variáveis colocadas sob restrição
summary(fit_lasso) # informações do modelo## $call
## lasso2::l1ce(formula = Weight ~ Length1 + Length2 + Length3 +
## Height + Width + area + vol + rabo + h_l1 + h_width + l3_l2,
## data = treino, sweep.out = NULL, standardize = FALSE)
##
## $terms
## Weight ~ Length1 + Length2 + Length3 + Height + Width + area +
## vol + rabo + h_l1 + h_width + l3_l2
## attr(,"variables")
## list(Weight, Length1, Length2, Length3, Height, Width, area,
## vol, rabo, h_l1, h_width, l3_l2)
## attr(,"factors")
## Length1 Length2 Length3 Height Width area vol rabo h_l1 h_width l3_l2
## Weight 0 0 0 0 0 0 0 0 0 0 0
## Length1 1 0 0 0 0 0 0 0 0 0 0
## Length2 0 1 0 0 0 0 0 0 0 0 0
## Length3 0 0 1 0 0 0 0 0 0 0 0
## Height 0 0 0 1 0 0 0 0 0 0 0
## Width 0 0 0 0 1 0 0 0 0 0 0
## area 0 0 0 0 0 1 0 0 0 0 0
## vol 0 0 0 0 0 0 1 0 0 0 0
## rabo 0 0 0 0 0 0 0 1 0 0 0
## h_l1 0 0 0 0 0 0 0 0 1 0 0
## h_width 0 0 0 0 0 0 0 0 0 1 0
## l3_l2 0 0 0 0 0 0 0 0 0 0 1
## attr(,"term.labels")
## [1] "Length1" "Length2" "Length3" "Height" "Width" "area" "vol"
## [8] "rabo" "h_l1" "h_width" "l3_l2"
## attr(,"order")
## [1] 1 1 1 1 1 1 1 1 1 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 1
## attr(,".Environment")
## <environment: R_GlobalEnv>
##
## $bound
## [1] 5060.412
##
## $relative.bound
## [1] 0.5
##
## $Lagrangian
## [1] 2.025343
##
## $residuals
## [1] -5.573904e+00 7.136561e+00 -9.120172e+00 -1.865303e+02 -7.693285e+00
## [6] 4.155466e-03 -6.560690e+01 3.707250e+00 -2.343239e+00 7.273019e+01
## [11] -5.880138e+00 -4.781125e+00 -1.753180e+01 -1.981020e+01 -5.631297e+01
## [16] -1.197240e+02 1.761686e+01 -8.581393e+01 6.683036e+00 -8.306691e+01
## [21] -1.933844e+01 4.600149e+01 2.776697e+01 1.132785e+00 8.357215e+01
## [26] 4.201495e+01 1.380813e+01 1.105230e+02 -7.644857e+00 -1.030293e+02
## [31] -3.631267e+01 -1.096190e+01 -2.159073e+01 -6.978736e+00 -2.442932e+01
## [36] 2.091778e+01 2.637600e+01 -1.851376e+01 4.734562e+01 1.677639e+01
## [41] 2.703088e+01 -1.742219e+01 2.044900e+01 1.406601e+01 -4.201843e+00
## [46] -1.726637e+01 1.105057e+02 3.147659e+01 -6.220297e+00 -2.601745e+01
## [51] 2.334387e+01 2.028255e+01 -3.043854e+00 -3.600336e+01 2.200800e+02
## [56] 1.444852e+01 5.758570e-01 3.471986e+01 -1.965445e+01 -4.405020e+00
## [61] -6.656313e+01 -8.997482e+01 -2.418156e+01 -1.793948e+01 -4.947097e+01
## [66] -1.144050e+02 8.345177e+01 2.463528e+01 -6.310246e+01 -4.849653e+01
## [71] 6.678126e+01 -1.649635e+00 2.022692e+01 5.695024e+00 -1.405638e+01
## [76] 1.142626e+02 6.848028e+00 1.010929e+00 -1.904447e-01 1.428798e+02
## [81] 1.374041e+02 1.700800e+02 2.351441e+01 -1.858121e+01 4.791643e+01
## [86] 8.681488e+01 1.719980e+01 6.226392e+01 -9.137637e+00 9.796364e+00
## [91] -9.139756e+01 5.106995e+00 1.783912e+01 1.756873e+01 3.778395e+01
## [96] -4.003507e+01 1.894607e+01 -7.128958e+01 -1.447888e+01 1.157212e+00
## [101] -1.366538e+01 -7.056027e+01 -1.439235e+02 -1.006829e+02 -6.764274e+00
## [106] 2.615148e+01 4.730949e+00 -9.377607e+01 -3.180652e+01 -6.728269e+01
## [111] -1.335428e+01 1.665279e-04 2.107454e+01 3.515091e+01 -5.766266e+01
## [116] 1.241467e+01 1.668775e+01 2.007445e+01 1.304813e+01 3.363875e+01
## [121] -1.066234e+01 8.965007e+00 5.805329e+01 1.584396e+01 1.467215e+01
## [126] -6.489263e+01
##
## $coefficients
## Value Std. Error Z score Pr(>|Z|)
## (Intercept) -776.5456684 1.050649e+03 -0.739110111 4.598401e-01
## Length1 -96.3043574 5.195241e+01 -1.853703330 6.378162e-02
## Length2 74.1614499 4.242227e+01 1.748172393 8.043418e-02
## Length3 0.2499556 3.798750e+01 0.006579944 9.947500e-01
## Height -261.3269143 3.597801e+01 -7.263518525 3.772538e-13
## Width 228.1238421 5.065257e+01 4.503697112 6.678137e-06
## area 7.5332289 1.215149e+00 6.199425999 5.666945e-10
## vol -0.2524026 8.976788e-02 -2.811725662 4.927651e-03
## rabo -789.7620029 1.052141e+03 -0.750623656 4.528792e-01
## h_l1 1390.8582409 4.132950e+02 3.365291629 7.646280e-04
## h_width 217.7527821 8.927638e+01 2.439086187 1.472446e-02
## l3_l2 1217.5409148 7.053538e+02 1.726142119 8.432185e-02
##
## $sigma
## [1] 60.29727
##
## $sigma.provided
## [1] FALSE
##
## $df
## [1] 11.50111 114.49889
##
## $cov.unscaled
## (Intercept) Length1 Length2 Length3
## (Intercept) 3.036130e+02 -7.9541584192 -3.5338011983 1.048964e+01
## Length1 -7.954158e+00 0.7423625695 -0.3671504845 -2.892366e-01
## Length2 -3.533801e+00 -0.3671504845 0.4949855941 -1.505849e-01
## Length3 1.048964e+01 -0.2892365877 -0.1505848768 3.969045e-01
## Height -2.966629e+00 0.2281592268 -0.0065685419 -1.467053e-01
## Width 2.271924e+00 -0.2978828933 0.0339244954 1.567019e-01
## area -1.386982e-02 -0.0041180129 0.0016547048 2.363719e-04
## vol 1.780994e-03 0.0003064647 -0.0001587548 1.471716e-05
## rabo -2.398484e+02 11.7633273454 -2.5809647631 -8.118428e+00
## h_l1 5.148414e+01 -0.4454150891 -0.9987644397 1.539211e+00
## h_width 4.156118e+00 -0.5258539785 0.1063160447 2.680771e-01
## l3_l2 -4.045808e+01 -4.5091730308 6.1011561119 -1.694599e+00
## Height Width area vol
## (Intercept) -2.9666287980 2.271923604 -1.386982e-02 1.780994e-03
## Length1 0.2281592268 -0.297882893 -4.118013e-03 3.064647e-04
## Length2 -0.0065685419 0.033924495 1.654705e-03 -1.587548e-04
## Length3 -0.1467052527 0.156701948 2.363719e-04 1.471716e-05
## Height 0.3560236387 -0.448311098 -1.066833e-02 7.436815e-04
## Width -0.4483110977 0.705679750 1.367008e-02 -1.007491e-03
## area -0.0106683344 0.013670080 4.061290e-04 -2.952016e-05
## vol 0.0007436815 -0.001007491 -2.952016e-05 2.216392e-06
## rabo 2.6040282801 -1.539272492 5.241925e-03 -6.287763e-04
## h_l1 -0.5494096628 -1.595353071 9.302399e-04 6.940567e-04
## h_width -0.5483596155 1.055813616 1.367089e-02 -1.025868e-03
## l3_l2 0.4142804892 -1.179041878 4.023724e-03 -7.625331e-04
## rabo h_l1 h_width l3_l2
## (Intercept) -2.398484e+02 5.148414e+01 4.156117750 -4.045808e+01
## Length1 1.176333e+01 -4.454151e-01 -0.525853978 -4.509173e+00
## Length2 -2.580965e+00 -9.987644e-01 0.106316045 6.101156e+00
## Length3 -8.118428e+00 1.539211e+00 0.268077074 -1.694599e+00
## Height 2.604028e+00 -5.494097e-01 -0.548359616 4.142805e-01
## Width -1.539272e+00 -1.595353e+00 1.055813616 -1.179042e+00
## area 5.241925e-03 9.302399e-04 0.013670891 4.023724e-03
## vol -6.287763e-04 6.940567e-04 -0.001025868 -7.625331e-04
## rabo 3.044757e+02 -5.600273e+01 -1.740370701 -9.021232e+01
## h_l1 -5.600273e+01 4.698129e+01 -5.708744434 1.222443e+01
## h_width -1.740371e+00 -5.708744e+00 2.192187929 -3.634312e+00
## l3_l2 -9.021232e+01 1.222443e+01 -3.634312136 1.368418e+02
##
## $correlation
## (Intercept) Length1 Length2 Length3 Height
## (Intercept) 1.00000000 -0.52981716 -0.28826084 0.95555900 -0.28534062
## Length1 -0.52981716 1.00000000 -0.60567520 -0.53284655 0.44380336
## Length2 -0.28826084 -0.60567520 1.00000000 -0.33973637 -0.01564708
## Length3 0.95555900 -0.53284655 -0.33973637 1.00000000 -0.39026824
## Height -0.28534062 0.44380336 -0.01564708 -0.39026824 1.00000000
## Width 0.15521358 -0.41156052 0.05740018 0.29609259 -0.89440917
## area -0.03949833 -0.23716339 0.11670575 0.01861748 -0.88720747
## vol 0.06865609 0.23891817 -0.15156796 0.01569126 0.83719048
## rabo -0.78886086 0.78243062 -0.21023716 -0.73850353 0.25010937
## h_l1 0.43107297 -0.07542137 -0.20711154 0.35644513 -0.13433661
## h_width 0.16109749 -0.41220973 0.10206190 0.28739403 -0.62070773
## l3_l2 -0.19848869 -0.44738305 0.74132137 -0.22994008 0.05935342
## Width area vol rabo h_l1
## (Intercept) 0.15521358 -0.039498333 0.06865609 -0.78886086 0.431072974
## Length1 -0.41156052 -0.237163393 0.23891817 0.78243062 -0.075421368
## Length2 0.05740018 0.116705749 -0.15156796 -0.21023716 -0.207111543
## Length3 0.29609259 0.018617479 0.01569126 -0.73850353 0.356445133
## Height -0.89440917 -0.887207475 0.83719048 0.25010937 -0.134336611
## Width 1.00000000 0.807486409 -0.80558965 -0.10501114 -0.277070633
## area 0.80748641 1.000000000 -0.98392822 0.01490673 0.006734424
## vol -0.80558965 -0.983928221 1.00000000 -0.02420452 0.068015702
## rabo -0.10501114 0.014906734 -0.02420452 1.00000000 -0.468242007
## h_l1 -0.27707063 0.006734424 0.06801570 -0.46824201 1.000000000
## h_width 0.84887656 0.458169239 -0.46540320 -0.06736380 -0.562521624
## l3_l2 -0.11998199 0.017068165 -0.04378507 -0.44195717 0.152460257
## h_width l3_l2
## (Intercept) 0.1610975 -0.19848869
## Length1 -0.4122097 -0.44738305
## Length2 0.1020619 0.74132137
## Length3 0.2873940 -0.22994008
## Height -0.6207077 0.05935342
## Width 0.8488766 -0.11998199
## area 0.4581692 0.01706817
## vol -0.4654032 -0.04378507
## rabo -0.0673638 -0.44195717
## h_l1 -0.5625216 0.15246026
## h_width 1.0000000 -0.20983310
## l3_l2 -0.2098331 1.00000000
##
## attr(,"class")
## [1] "summary.l1ce"prediction2 <- predict(fit_lasso, aplicacao) # salvando predições no objeto prediction2
df2 <- cbind(aplicacao, prediction = prediction2)# fazendo uma junção das predições com a base de dados para aplicação do modelo
rmse(aplicacao$Weight, predict(fit_lasso, aplicacao)) # ROOT MEAN SQUARE DEVIATION## [1] 53.03882mae(aplicacao$Weight, predict(fit_lasso, aplicacao)) # MEAN ABSOLUT PERCENT ERROR## [1] 33.94291ggplot(df2) + geom_point(aes(x = Weight, y = prediction, color = Species)) +
geom_line(aes(x = Weight, y = Weight)) + scale_color_brewer(palette = "Dark2") + theme(legend.position = "bottom") # gráico com valores verdadeiros no eixo x, valores preditos na variável resposta e também uma reta verdade
Random Forest
Random Forest é um algoritmo que irá criar muitas árvores de decisão, de maneira aleatória, formando o que podemos enxergar como uma floresta, onde cada árvore será utilizada na escolha do resultado final. As Árvores de Decisão, ou Decision Trees, estabelecem regras para tomada de decisão. O algoritmo criará uma estrutura similar a um fluxograma, com “nós” onde uma condição é verificada, e se atendida o fluxo segue por um ramo, caso contrário, por outro, sempre levando ao próximo “nó”, até a finalização da árvore. Com os dados de treino, o algoritmo busca as melhores condições, e onde inserir cada uma dentro do fluxo.
fit_rf <-
randomForest(
Weight ~ Species+Length1+Length2+Length3+Height+Width+area+vol+ rabo+h_l1+h_width+l3_l2,
data = treino,
importance = TRUE
) # Random Forest
summary(fit_rf) # informações geradas pela aplicação do método## Length Class Mode
## call 4 -none- call
## type 1 -none- character
## predicted 126 -none- numeric
## mse 500 -none- numeric
## rsq 500 -none- numeric
## oob.times 126 -none- numeric
## importance 24 -none- numeric
## importanceSD 12 -none- numeric
## localImportance 0 -none- NULL
## proximity 0 -none- NULL
## ntree 1 -none- numeric
## mtry 1 -none- numeric
## forest 11 -none- list
## coefs 0 -none- NULL
## y 126 -none- numeric
## test 0 -none- NULL
## inbag 0 -none- NULL
## terms 3 terms callprediction3 <-
predict(fit_rf, aplicacao) # salvando predições no objeto prediction3
df3 <-
cbind(aplicacao, prediction = prediction3)# fazendo uma junção das predições com a base de dados para aplicação do modelo
rmse(aplicacao$Weight, predict(fit_rf, aplicacao)) # ROOT MEAN SQUARE DEVIATION## [1] 25.83664mae(aplicacao$Weight, predict(fit_rf, aplicacao)) # MEAN ABSOLUT PERCENT ERROR## [1] 13.02426ggplot(df3) + geom_point(aes(x = Weight, y = prediction, color = Species)) +
geom_line(aes(x = Weight, y = Weight)) + scale_color_brewer(palette = "Dark2") + theme(legend.position = "bottom")# gráico com valores verdadeiros no eixo x, valores preditos na variável resposta e também uma reta verdade
Importância de cada variável
Durante o desenvolvimento de Random Forest, cada árvore usa apenas um subconjunto das variáveis de entrada. Se em uma árvore subsequente, a exclusão de recursos usados anteriormente resulta em uma classificação inferior, esses recursos, por sua vez, teriam um aumento % maior no MSE(Mean Square Error). Portanto, logicamente, as variáveis de entrada que geram %IncMSE maior quando excluídas têm uma importância de recurso maior.
importance(fit_rf, type = 1)## %IncMSE
## Species 2.448690
## Length1 12.424589
## Length2 13.127369
## Length3 14.059062
## Height 8.546022
## Width 14.207847
## area 14.767174
## vol 17.457193
## rabo 1.865045
## h_l1 5.846283
## h_width 4.491742
## l3_l2 2.596086importance <- data.frame(importance(fit_rf, type = 1))[, 1]
names <-c("Species",
"Length1",
"Length2",
"Length3",
"Height",
"Width",
"area",
"vol",
"rabo",
"h_l1",
"h_width",
"l3_l2")
feature_importance <- data.frame(variable = names, IncMSE = importance)
ggplot(feature_importance) + geom_col(aes(
x = reorder(variable, IncMSE),
y = IncMSE/sum(IncMSE)
), show.legend = F, fill = "#1B9E77", color = "grey") + coord_flip() + labs(y = "%IncMSE", x = "Variável") + theme(aspect.ratio = .7)
Predição da variável “Species”
Como vimos anteriormente, o algorítimo Random Forest foi o método que teve o melhor desempenho para predição da variável Weight. Além disso, dado que por Random Forest montamos árvores de decisão, pode ser que ele sirva muito bem para predizer variáveis categóricas, como é o caso da variável Species. Veremos a seguir a predição com este método e analisaremos como ele desempenha.
Random Forest
treino$Species <- as.factor(treino$Species)
aplicacao$Species <- as.factor(aplicacao$Species)
fit_rf <- randomForest(Species ~ .,
data = treino,
importance = TRUE
) # Random Forest
pred <- predict(fit_rf, newdata=aplicacao[-1])
cm <- table(aplicacao[,1], pred)
cm## pred
## Bream Parkki Perch Pike Roach Smelt Whitefish
## Bream 7 0 0 0 0 0 0
## Parkki 0 1 0 0 0 0 0
## Perch 0 0 15 0 0 0 0
## Pike 0 0 0 2 0 0 0
## Roach 0 0 0 0 4 0 0
## Smelt 0 0 0 0 0 3 0Como este é um problema de classificação, usamos uma matriz de confusão para avaliar o desempenho de nosso modelo. Lembrando que os valores na diagonal correspondem a verdadeiros positivos e verdadeiros negativos (previsões corretas), enquanto os outros correspondem a falsos positivos e falsos negativos. Sabendo disso, podemos concluir que o resultado é bastante satisfatório e por isso não imagino ser necessário a aplicação de qualquer outro método para esse problema. Para compreendermos melhor, abaixo iremos analisar as variáveis de maior importância na predição da variável Species.
importance(fit_rf, type = 1)## MeanDecreaseAccuracy
## Weight 11.46595
## Length1 12.67321
## Length2 11.79294
## Length3 11.45048
## Height 17.77870
## Width 11.90339
## area 12.80231
## vol 11.25257
## rabo 20.98471
## i_massa 13.69355
## h_l1 27.54277
## h_width 15.03239
## l3_l2 28.60484importance <- data.frame(importance(fit_rf, type = 1))[, 1]
names <-c("Weight",
"Length1",
"Length2",
"Length3",
"Height",
"Width",
"area",
"vol",
"rabo",
"i_massa",
"h_l1",
"h_width",
"l3_l2")
feature_importance <- data.frame(variable = names, IncMSE = importance)
ggplot(feature_importance) + geom_col(aes(
x = reorder(variable, IncMSE),
y = IncMSE/sum(IncMSE)
), show.legend = F, fill = "#1B9E77", color = "grey") + coord_flip() + labs(y = "%IncMSE", x = "Variável") + theme(aspect.ratio = .7)
Podemos ver que agora as variáveis criadas que dizem respeito a aspectos físicos do peixe tiveram grande destaque. Vamos gerar alguns gráficos que relacionam as 3 primeiras mais importantes variáveis para a predição.
1° e 2° mais importantes
ggplot(dados) + geom_point(aes(x = l3_l2, y=h_l1, color = Species)) + scale_color_brewer(palette = "Dark2")+ theme(legend.position = "bottom")
1° e 3° mais importantes
ggplot(dados) + geom_point(aes(x = l3_l2, y=rabo, color = Species)) + scale_color_brewer(palette = "Dark2")+ theme(legend.position = "bottom")
2° e 3° mais importantes
ggplot(dados) + geom_point(aes(x = h_l1, y=rabo, color = Species)) + scale_color_brewer(palette = "Dark2") + theme(legend.position = "bottom")
Portanto, podemos ver que elas nos permitem separar as espécies de maneira bastante interessante, algumas espécies podem ser mais bem definidas relacionando duas dessas variáveis a outras e assim é construída a resposta sobre qual espécie se encaixa melhor para peixes com determinadas caracteríticas.