Modelos Multiclasse - Classificação de Vidros para Análise Forense
APRESENTAÇÃO
Universidade Federal da Bahia - UFBA
Escola Politécnica
Programa de Pós-Graduação em Engenharia Industrial - PEI/UFBA
Departamento de Engenharia Química - DEQ
ENG436 - Tópicos Especiais em Engenharia
O presente trabalho foi desenvolvido como parte de avaliação para a disciplina Tópicos Especiais em Engenharia, ministrada pela docente Karla Esquerre da Escola Politécnica da UFBA.
O código completo deste arquivo .Rmd pode ser acessado através deste link.
DESENVOLVIMENTO
Vestígios deixados na cena de um crime podem ser de extrema importância para a resolução do mesmo. Utilizando dos conhecimentos que envolvem o aprendizado de máquina, é possível construir modelos preditivos que deem suporte as análises e obter importantes informações sobre padrões de banco de dados criminológicos.
Diferentes estudos utilizam algoritmos de aprendizado de máquina para tarefas de classificação, procurando otimizar os modelos com variadas técnicas. No presente trabalho fora proposto um modelo preditivo de classificação de vidro multiclasse, utilizando do algoritmo de Random Forest para diferentes cenários de variáveis e técnicas de balanceamento de classes.
DATASET E CODE
O presente dataset em análise é um conjunto de objetos de identificação de vidro da UC Irvine Machine Learning Repository, disponível no Kaggle, contendo 10 atributos, sendo a resposta o tipo do vidro (label / rótulo).
Os atributos em análise são:
01- RI: Índice de Refração;
02- Na: Sódio (medição unitária: porcentagem em peso no óxido correspondente, como são os atributos 03-09);
03- Mg: Magnésio;
04- Al: Alumínio;
05- Si: Silício;
06- K: Potássio;
07- Ca: Cálcio;
08- Ba: Bário;
09- Fe: Ferro;
10- Tipo de Vidro;
X1 - Vidro float de construções;
X2 - Vidro “não” float de construções;
X3 - Vidro float de veículos;
X5 - Vidro de contêineres;
X6 - Utensílios de mesa (prato, xícara, etc);
X7 - headlamps.
Abaixo, iniciamos o código indicando o caminho da pasta de trabalho, carregando os pacotes demandados e o dataset a ser analisado. O uso do pacote pacman foi idealizado em facilitar a reprodutibilidade, dinamicidade de instalação e carregamento de pacotes. Especificamente o pacote gg3D demanda que o download seja realizado diretamente do git, e para tal, utilizamos o pacote remotes.
# setwd("D:/PEI/Doc/Disciplinas/Topicos/topicos_eng436")
# setwd("C:/Users/MARCELLO/Desktop/ENG436/topicos_eng436")
{
if (!require("pacman")) install.packages("pacman")
pacman::p_load(dplyr, readxl, ggplot2, GGally, skimr,
plotly, knitr, tidyr, shiny, caret, randomForest,
reshape2, tibble, rmdformats, cowplot,
car, bestNormalize, forcats, ggQC, scales, lemon)
if (!require("gg3D")) remotes::install_github("AckerDWM/gg3D")
library(gg3D)
}
# Tema
tema <- theme_bw() +
theme(axis.title = element_text(color = "black", size = 18, face = "bold"),
axis.text.x = element_text(color = "black", size = 16, face = "bold"),
axis.text.y = element_text(color = "black", size = 16, face = "bold"),
legend.text = element_text(color = "black", size = 12, face = "bold"),
legend.title = element_text(color = "black", size = 14, face = "bold"),
plot.title = element_text(color = "black", size = 18, face = "bold"))
set.seed(42)
dataset <- readxl::read_excel("glass.xlsx")
O primeiro passo para qualquer estruturação ou análise, é o conhecimento acerca da estrutura inicial dos dados. Para tanto, utilizaremos a função glimpse do pacote dplyr.
Observations: 214
Variables: 10
$ RI <dbl> 152101, 151761, 151618, 151766, 151742, 151596, 151743, 151756...
$ Na <chr> "13.64", "13.89", "13.53", "13.21", "13.27", "12.79", "13.3", ...
$ Mg <chr> "4.49", "3.6", "3.55", "3.69", "3.62", "3.61", "3.6", "3.61", ...
$ Al <chr> "1.1", "1.36", "1.54", "1.29", "1.24", "1.62", "1.14", "1.05",...
$ Si <chr> "71.78", "72.73", "72.99", "72.61", "73.08", "72.97", "73.09",...
$ K <chr> "0.06", "0.48", "0.39", "0.57", "0.55", "0.64", "0.58", "0.57"...
$ Ca <chr> "8.75", "7.83", "7.78", "8.22", "8.07", "8.07", "8.17", "8.24"...
$ Ba <chr> "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0...
$ Fe <chr> "0", "0", "0", "0", "0", "0.26", "0", "0", "0", "0.11", "0.24"...
$ Type <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
Podemos observar que apenas a variável preditora RI está como dbl (double). Deste modo, transformaremos as chr (character) para números, tendo em vista a necessidade para exploração descritiva e construção de modelos. A variável Type é o label (rótulo) de nossas classes de vidro, e essas deverão passar a ser fatores, sendo renomeada para Tipo.
A variável RI será dividida por \(10^5\) para adequação de escala real.
df <- dataset %>%
dplyr::mutate_if(is.character, as.numeric) %>%
dplyr::mutate(Tipo = as.factor(Type),
RI = RI/(10^5)) %>%
dplyr::select(-Type)
df_x <- df
levels(df$Tipo) <- make.names(levels(factor(df$Tipo)))
dplyr::glimpse(df)Observations: 214
Variables: 10
$ RI <dbl> 1.52101, 1.51761, 1.51618, 1.51766, 1.51742, 1.51596, 1.51743,...
$ Na <dbl> 13.64, 13.89, 13.53, 13.21, 13.27, 12.79, 13.30, 13.15, 14.04,...
$ Mg <dbl> 4.49, 3.60, 3.55, 3.69, 3.62, 3.61, 3.60, 3.61, 3.58, 3.60, 3....
$ Al <dbl> 1.10, 1.36, 1.54, 1.29, 1.24, 1.62, 1.14, 1.05, 1.37, 1.36, 1....
$ Si <dbl> 71.78, 72.73, 72.99, 72.61, 73.08, 72.97, 73.09, 73.24, 72.08,...
$ K <dbl> 0.06, 0.48, 0.39, 0.57, 0.55, 0.64, 0.58, 0.57, 0.56, 0.57, 0....
$ Ca <dbl> 8.75, 7.83, 7.78, 8.22, 8.07, 8.07, 8.17, 8.24, 8.30, 8.40, 8....
$ Ba <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,...
$ Fe <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.26, 0.00, 0.00, 0.00, 0.11, 0....
$ Tipo <fct> X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1...
Com o ajuste inicial do nosso df, foi modificado a classe das variáveis nos objetos e ajustado os fatores / classes / labels / rótulos dos vidros, sendo estes renomeadas para \({X1,\;X2,\;X3,\;X5, X6\;e\;X7}\), para posterior uso na construção de modelo preditivo.
Agora vamos analisar se há NA ou NaN nos nossos dados, e, vamos aproveitar para calcular as estatísticas de tendência central e realizar de modo simultâneo um histograma de nossas variáveis de interesse.
Abaixo, utilizaremos as abas Análise 1 e Análise 2 para expor nossas informações descritas até aqui. Sendo que a aba Análise 2, servirá para nos aprofundarmos na análise descritiva com as variáveis de interesse de acordo com o label.
Análise 1.1
df %>%
dplyr::select(-c("Tipo")) %>%
skimr::skim() %>%
dplyr::rename("Tipo da Variável" = skim_type, "Variável" = skim_variable, "nº NA" = n_missing,
"Média" = numeric.mean, "DP" = numeric.sd,
"p0" = numeric.p0, "p25" = numeric.p25, "p50" = numeric.p50,
"p75" = numeric.p75,"p100" = numeric.p100,
"Histograma" = numeric.hist) %>%
dplyr::select(-c("complete_rate")) %>%
knitr::kable()| Tipo da Variável | Variável | nº NA | Média | DP | p0 | p25 | p50 | p75 | p100 | Histograma |
|---|---|---|---|---|---|---|---|---|---|---|
| numeric | RI | 0 | 1.3759749 | 0.4219572 | 0.01518 | 1.51618 | 1.51755 | 1.519033 | 1.53393 | ▁▁▁▁▇ |
| numeric | Na | 0 | 13.4078505 | 0.8166036 | 10.73000 | 12.90750 | 13.30000 | 13.825000 | 17.38000 | ▁▇▆▁▁ |
| numeric | Mg | 0 | 2.6845327 | 1.4424078 | 0.00000 | 2.11500 | 3.48000 | 3.600000 | 4.49000 | ▃▁▁▇▅ |
| numeric | Al | 0 | 1.4449065 | 0.4992696 | 0.29000 | 1.19000 | 1.36000 | 1.630000 | 3.50000 | ▂▇▃▁▁ |
| numeric | Si | 0 | 72.6509346 | 0.7745458 | 69.81000 | 72.28000 | 72.79000 | 73.087500 | 75.41000 | ▁▂▇▂▁ |
| numeric | K | 0 | 0.4970561 | 0.6521918 | 0.00000 | 0.12250 | 0.55500 | 0.610000 | 6.21000 | ▇▁▁▁▁ |
| numeric | Ca | 0 | 8.9569626 | 1.4231535 | 5.43000 | 8.24000 | 8.60000 | 9.172500 | 16.19000 | ▁▇▁▁▁ |
| numeric | Ba | 0 | 0.1750467 | 0.4972193 | 0.00000 | 0.00000 | 0.00000 | 0.000000 | 3.15000 | ▇▁▁▁▁ |
| numeric | Fe | 0 | 0.0570093 | 0.0974387 | 0.00000 | 0.00000 | 0.00000 | 0.100000 | 0.51000 | ▇▁▁▁▁ |
plotx <- df %>%
dplyr::mutate_at(1:9, funs(scale)) %>%
tidyr::gather("Var", "Valor",-Tipo) %>%
ggplot2::ggplot() +
geom_jitter(aes(x = Var, y = Valor, col = Tipo), alpha = 0.6, width = 0.15) +
guides(colour = guide_legend(override.aes = list(size = 5))) +
xlab("Variáveis") +
ylab("z-score") +
theme_bw() +
tema +
theme(legend.position = "bottom")
plotx1 <- df %>%
dplyr::mutate_at(1:9, funs(scale)) %>%
tidyr::gather("Var", "Valor",-Tipo) %>%
ggplot2::ggplot() +
geom_boxplot(aes(x = Var, y = Valor),
alpha = 0.9, show.legend = F, width = 0.4) +
xlab("Variáveis") +
ylab("z-score") +
theme_bw() +
tema
plotx8 <- cowplot::plot_grid(plotx, plotx1, align = "hv", axis = "bt", labels = c("(A)", "(B)"))
ggsave(file = "plotx8.png", plotx8, width = 13, height = 9, dpi = 700)
plotx8
#
#
plotx <- df %>%
dplyr::mutate_at(1:9, funs(scale)) %>%
tidyr::gather("Var", "Valor",-Tipo) %>%
ggplot2::ggplot(aes(x = Var, y = Valor)) +
stat_boxplot(geom ='errorbar', width = 0.6, size = 0.8) +
geom_jitter(aes(fill = Tipo), alpha = 0.3, width = 0.2, shape = 21, size = 3) +
facet_wrap(~Tipo) +
scale_fill_manual(values = scales::hue_pal()(6)) +
guides(fill = guide_legend(override.aes = list(size = 5, alpha = 1))) +
xlab("Variáveis") +
ylab("z-score") +
theme_bw() +
tema +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 90))
cores <- c(scales::hue_pal()(6)[2],
scales::hue_pal()(6)[1],
scales::hue_pal()(6)[6],
scales::hue_pal()(6)[3],
scales::hue_pal()(6)[4],
scales::hue_pal()(6)[5])
plotx1 <- df %>%
dplyr::count(Tipo) %>%
ggplot2::ggplot(aes(x = Tipo, y = n)) +
ggQC::stat_pareto(point.color = "red",
point.size = 3,
line.color = "black",
bars.fill = cores) +
ggplot2::scale_y_continuous(sec.axis = ggplot2::sec_axis(~./(max(.)*.95)*100,
name = "% Acumulado de Objetos")) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) +
xlab("Tipo") +
ylab("Quantidade de Objetos") +
theme_bw() +
tema
plotx8 <- cowplot::plot_grid(plotx, plotx1, align = "hv", axis = "bt", labels = c("(A)", "(B)"))
ggsave(file = "plotx8_2.png", plotx8, width = 13, height = 9, dpi = 700)
plotx8
Análise 1.2
# df %>%
# dplyr::filter(Tipo == "X6") %>%
# dplyr::select(Fe, Ba)
df %>%
dplyr::group_by(Tipo) %>%
skimr::skim() %>%
dplyr::rename("Variável" = skim_variable, "Classe" = Tipo,
"Média" = numeric.mean, "DP" = numeric.sd,
"p0" = numeric.p0, "p25" = numeric.p25, "p50" = numeric.p50,
"p75" = numeric.p75,"p100" = numeric.p100,
"Histograma" = numeric.hist) %>%
dplyr::select(-c("skim_type", "complete_rate", "n_missing")) %>%
knitr::kable()| Variável | Classe | Média | DP | p0 | p25 | p50 | p75 | p100 | Histograma |
|---|---|---|---|---|---|---|---|---|---|
| RI | X1 | 1.3975243 | 0.3986370 | 0.01519 | 1.517473 | 1.51772 | 1.519105 | 1.52667 | ▁▁▁▁▇ |
| RI | X2 | 1.3011288 | 0.5061894 | 0.01518 | 1.515937 | 1.51674 | 1.518445 | 1.53393 | ▂▁▁▁▇ |
| RI | X3 | 1.2771394 | 0.5370472 | 0.15161 | 1.516460 | 1.51769 | 1.518320 | 1.52211 | ▂▁▁▁▇ |
| RI | X5 | 1.5189277 | 0.0033454 | 1.51316 | 1.516660 | 1.51994 | 1.521190 | 1.52369 | ▃▁▁▇▂ |
| RI | X6 | 1.5174556 | 0.0031158 | 1.51115 | 1.518290 | 1.51888 | 1.519160 | 1.51969 | ▁▁▁▁▇ |
| RI | X7 | 1.4700555 | 0.2535801 | 0.15164 | 1.516020 | 1.51651 | 1.517270 | 1.52365 | ▁▁▁▁▇ |
| Na | X1 | 13.2422857 | 0.4993015 | 12.45000 | 12.825000 | 13.19500 | 13.525000 | 14.77000 | ▇▇▅▂▁ |
| Na | X2 | 13.1117105 | 0.6641594 | 10.73000 | 12.885000 | 13.15500 | 13.432500 | 14.86000 | ▁▁▇▇▁ |
| Na | X3 | 13.4370588 | 0.5068871 | 12.16000 | 13.240000 | 13.42000 | 13.640000 | 14.32000 | ▁▁▇▆▃ |
| Na | X5 | 12.8276923 | 0.7770366 | 11.03000 | 12.730000 | 12.97000 | 13.270000 | 14.01000 | ▂▁▂▇▂ |
| Na | X6 | 14.6466667 | 1.0840203 | 13.79000 | 14.090000 | 14.40000 | 14.560000 | 17.38000 | ▇▂▁▁▁ |
| Na | X7 | 14.4420690 | 0.6863588 | 11.95000 | 14.200000 | 14.39000 | 14.860000 | 15.79000 | ▁▁▃▇▁ |
| Mg | X1 | 3.5524286 | 0.2470430 | 2.71000 | 3.480000 | 3.56500 | 3.657500 | 4.49000 | ▁▁▇▁▁ |
| Mg | X2 | 3.0021053 | 1.2156615 | 0.00000 | 3.057500 | 3.52000 | 3.622500 | 3.98000 | ▁▁▁▁▇ |
| Mg | X3 | 3.5435294 | 0.1627859 | 3.34000 | 3.400000 | 3.53000 | 3.650000 | 3.90000 | ▇▃▅▂▁ |
| Mg | X5 | 0.7738462 | 0.9991458 | 0.00000 | 0.000000 | 0.00000 | 1.710000 | 2.68000 | ▇▁▁▃▁ |
| Mg | X6 | 1.3055556 | 1.0971339 | 0.00000 | 0.000000 | 1.74000 | 2.240000 | 2.41000 | ▆▂▁▂▇ |
| Mg | X7 | 0.5382759 | 1.1176828 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 3.34000 | ▇▁▁▁▁ |
| Al | X1 | 1.1638571 | 0.2731581 | 0.29000 | 1.112500 | 1.23000 | 1.327500 | 1.69000 | ▁▁▂▇▁ |
| Al | X2 | 1.4081579 | 0.3183403 | 0.56000 | 1.247500 | 1.46000 | 1.570000 | 2.12000 | ▂▃▇▆▂ |
| Al | X3 | 1.2011765 | 0.3474889 | 0.58000 | 0.910000 | 1.28000 | 1.380000 | 1.76000 | ▅▃▆▇▅ |
| Al | X5 | 2.0338462 | 0.6939205 | 1.40000 | 1.560000 | 1.76000 | 2.170000 | 3.50000 | ▇▃▁▂▁ |
| Al | X6 | 1.3666667 | 0.5718610 | 0.34000 | 1.190000 | 1.56000 | 1.660000 | 2.09000 | ▃▁▂▇▂ |
| Al | X7 | 2.1227586 | 0.4427261 | 1.19000 | 1.870000 | 2.06000 | 2.420000 | 2.88000 | ▂▃▇▇▅ |
| Si | X1 | 72.6191429 | 0.5694842 | 71.35000 | 72.080000 | 72.81500 | 73.017500 | 73.70000 | ▃▃▃▇▂ |
| Si | X2 | 72.5980263 | 0.7245726 | 69.81000 | 72.330000 | 72.73500 | 73.062500 | 74.45000 | ▁▁▆▇▁ |
| Si | X3 | 72.4047059 | 0.5122758 | 71.36000 | 72.040000 | 72.64000 | 72.700000 | 73.01000 | ▂▂▂▇▇ |
| Si | X5 | 72.3661538 | 1.2823191 | 69.89000 | 72.180000 | 72.69000 | 73.390000 | 73.88000 | ▃▂▆▆▇ |
| Si | X6 | 73.2066667 | 1.0794675 | 72.37000 | 72.500000 | 72.74000 | 73.480000 | 75.41000 | ▇▁▁▁▁ |
| Si | X7 | 72.9658621 | 0.9402337 | 70.26000 | 72.860000 | 73.11000 | 73.360000 | 75.18000 | ▁▁▇▇▁ |
| K | X1 | 0.4474286 | 0.2148790 | 0.00000 | 0.200000 | 0.56000 | 0.590000 | 0.69000 | ▂▂▁▂▇ |
| K | X2 | 0.5210526 | 0.2137262 | 0.00000 | 0.480000 | 0.58000 | 0.650000 | 1.10000 | ▂▁▇▂▁ |
| K | X3 | 0.4064706 | 0.2298897 | 0.00000 | 0.160000 | 0.56000 | 0.570000 | 0.61000 | ▃▂▁▁▇ |
| K | X5 | 1.4700000 | 2.1386951 | 0.13000 | 0.380000 | 0.58000 | 0.970000 | 6.21000 | ▇▁▁▁▂ |
| K | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| K | X7 | 0.3251724 | 0.6684931 | 0.00000 | 0.000000 | 0.00000 | 0.140000 | 2.70000 | ▇▁▁▁▁ |
| Ca | X1 | 8.7972857 | 0.5748066 | 7.78000 | 8.430000 | 8.67500 | 9.052500 | 10.17000 | ▃▇▅▂▂ |
| Ca | X2 | 9.0736842 | 1.9216353 | 7.08000 | 8.037500 | 8.27500 | 8.915000 | 16.19000 | ▇▁▁▁▁ |
| Ca | X3 | 8.7829412 | 0.3801112 | 8.32000 | 8.530000 | 8.79000 | 8.930000 | 9.65000 | ▇▇▃▁▂ |
| Ca | X5 | 10.1238462 | 2.1837908 | 5.87000 | 9.700000 | 11.27000 | 11.530000 | 12.50000 | ▃▁▁▂▇ |
| Ca | X6 | 9.3566667 | 1.4499483 | 6.65000 | 9.260000 | 9.57000 | 9.950000 | 11.22000 | ▂▂▅▇▅ |
| Ca | X7 | 8.4913793 | 0.9735052 | 5.43000 | 8.440000 | 8.67000 | 8.950000 | 9.76000 | ▁▁▁▇▅ |
| Ba | X1 | 0.0127143 | 0.0838377 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.69000 | ▇▁▁▁▁ |
| Ba | X2 | 0.0502632 | 0.3623404 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 3.15000 | ▇▁▁▁▁ |
| Ba | X3 | 0.0088235 | 0.0363803 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.15000 | ▇▁▁▁▁ |
| Ba | X5 | 0.1876923 | 0.6082510 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 2.20000 | ▇▁▁▁▁ |
| Ba | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| Ba | X7 | 1.0400000 | 0.6653409 | 0.00000 | 0.610000 | 0.81000 | 1.590000 | 2.88000 | ▅▆▇▁▁ |
| Fe | X1 | 0.0570000 | 0.0890750 | 0.00000 | 0.000000 | 0.00000 | 0.110000 | 0.31000 | ▇▂▁▁▁ |
| Fe | X2 | 0.0797368 | 0.1064327 | 0.00000 | 0.000000 | 0.00000 | 0.155000 | 0.35000 | ▇▂▂▁▁ |
| Fe | X3 | 0.0570588 | 0.1078636 | 0.00000 | 0.000000 | 0.00000 | 0.090000 | 0.37000 | ▇▁▁▁▁ |
| Fe | X5 | 0.0607692 | 0.1555882 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.51000 | ▇▁▁▁▁ |
| Fe | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| Fe | X7 | 0.0134483 | 0.0297940 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.09000 | ▇▁▁▁▁ |
Como pode-se perceber não temos NA ou NaN no nosso df. Logo, não temos a necessidade de inputar dados faltantes.
Nossas variáveis não apresentam distribuições claramente semelhantes. Do ponto de vista descritivo, comparando classes numa mesma variável, a classe X3 apresenta menor valor médio de RI, e X5 e X6 apresentam os maiores valores. E, de modo inverso, X5 e X6 apresentam os menores valores de desvio padrão (DP), e X3 apresenta o maior valor.
Da variável Na os maiores valores de média e DP são referentes a X6, e para X1 e X3 os valores de média e DP estão próximos. Os valores de DP de X1 e X3 para Mg, estão muito abaixo que para as outras classes, e os valores de média estão próximos.
X1 e X2 apresentam baixos valores de DP em Al. Em K, X6 apresenta média e DP iguais a zero, e X5 apresenta elevado DP. Em Ca, as médias de X1 e X3 são muito próximas, e ambas as classes tem baixo valor de DP. E, para Ba e Fe, a média e o DP de X6 são iguais a zero.
Contudo é interessante frisar a semelhança entre os dados das classes X1 e X3, apresentando uma leve divergência apenas para RI e Ba.
plotx <- df %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
# https://stackoverflow.com/a/34743555/9699371
for(i in 1:plotx$nrow) {
for(j in 1:plotx$ncol){
plotx[i,j] <- plotx[i,j] +
scale_fill_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3]))
}
}
shiny::div(plotly::ggplotly(plotx), align = "center")
Aparentemente não é possível visualizar um padrão claro entre as classes, e através da nossa matriz de dispersão, não conseguimos identificar situação de colinearidade entre as variáveis.
A homogeneidade entre os objetos pode, desde já, nos nortear quanto a dificuldade de construção de modelo preditivo com bons valores de sensibilidade e especificidade. E se focarmos nos grupos X1 e X3, que é este, que desde a estatística básica apresenta homogeneidade, poderemos notar o quão similares os grupos são.
Verificando Especificidades em X1 e X3
Os conjuntos de objetos pertencentes a X1 e X3 apresentam comportamento muito semelhante, e, em algum casos, com apresentando comportamento similar a uma situação bimodal, e para essas, realizaremos nosso ggpairs de formas separadas, dada as devidas condições anunciadas nas abas, e também utilizaremos o recurso de representação em 3D, a fim de tentar melhorar a perspectiva visual.
RI > 1
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
RI > 1) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
for(i in 1:plotx$nrow) {
for(j in 1:plotx$ncol){
plotx[i,j] <- plotx[i,j] +
scale_fill_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3]))
}
}
shiny::div(plotly::ggplotly(plotx), align = "center")RI < 1
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
RI < 1) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
for(i in 1:plotx$nrow) {
for(j in 1:plotx$ncol){
plotx[i,j] <- plotx[i,j] +
scale_fill_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3]))
}
}
shiny::div(plotly::ggplotly(plotx), align = "center")K > 0.4
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K > 0.4) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
for(i in 1:plotx$nrow) {
for(j in 1:plotx$ncol){
plotx[i,j] <- plotx[i,j] +
scale_fill_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3]))
}
}
shiny::div(plotly::ggplotly(plotx), align = "center")K < 0.4
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
for(i in 1:plotx$nrow) {
for(j in 1:plotx$ncol){
plotx[i,j] <- plotx[i,j] +
scale_fill_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3]))
}
}
shiny::div(plotly::ggplotly(plotx), align = "center")Ca versus Mg, Na
plot_b <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
ggplot2::ggplot() +
geom_point(aes(x = Ca, y = Na, col = Tipo), size = 7, alpha = 0.5) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
theme_bw() +
tema +
theme(legend.position = "bottom")
plot_b1 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
ggplot2::ggplot() +
geom_point(aes(x = Ca, y = Mg, col = Tipo), size = 7, alpha = 0.5) +
scale_color_manual(values = c(scales::hue_pal()(6)[1],
scales::hue_pal()(6)[3])) +
theme_bw() +
tema +
theme(legend.position = "bottom")
plotb <- cowplot::plot_grid(plot_b, plot_b1, align = "hv")
ggsave(file = "plotb.png", plotb, width = 11, height = 7, dpi = 700)
plotb
3D
plot1 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 0) +
stat_3D(theta = 0)
plot2 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 90) +
stat_3D(theta = 90)
plot3 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 180) +
stat_3D(theta = 180)
plot4 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 270) +
stat_3D(theta = 270)
plotx7 <- cowplot::plot_grid(plot1, plot2, plot3, plot4, align = "hv",
labels = c('0°', '90°', '180°', '270°'))
ggsave(file = "plotx7.png", plotx7, width = 13, height = 9, dpi = 700)
plotx7
3D interactive
cores <- c("royalblue1", "darkcyan", "green1", "black", "goldenrod3", "red2")
df %>%
plotly::plot_ly(x = ~RI, y = ~Ca, z = ~Fe, color = ~Tipo,
colors = cores, opacity = 0.4, stroke = "black") %>%
add_markers() %>%
layout(scene = list(xaxis = list(title = 'RI'),
yaxis = list(title = 'Ca'),
zaxis = list(title = 'Fe')))3D interactive para X1 e X3
Através da análise visual dos gráficos de dispersão é notável que alguns pontos mais distantes da massa de dados. E, apesar do problema em análise abordar variáveis com baixa incerteza de medição e elucidarem grandezas físico-química, realizaremos análise visual para discriminação de potenciais valores aberrantes (outliers).
Tal fato será importante, também, para tentar minimizar o possível bias gerado futuramento no modelo preditor, pois, é nítido que as classes (labels) estão desbalanceados, como pode ser visualizado abaixo, onde, de 214 objetos, apenas 4.21% representam a classe X6.
Contudo, a priori, procederemos com cautela pois X3 e X5 também apresentam baixos percentuais de representação no conjunto de objetos em análise, como pode ser visualizado no chunk abaixo. E, no próximo tópico, tentaremos refinar o nosso df identificando possíveis outliers.
X1 X2 X3 X5 X6 X7
70 76 17 13 9 29 Outliers
Para iniciar o processo de identificação de possíveis outliers, criaremos uma coluna de ID no nosso df para poder facilitar o processo de manipulação de dados.
Novamente, com o auxílio do gráfico de dispersão, iniciaremos a prospecção dos possíveis objetos enquadrados como outliers. E, utilizaremos a ferramenta de gráfico interativo para poder identificar as informações de variáveis e de ID.
df_out <- df %>%
tibble::rowid_to_column()
plotx6 <- df_out %>%
GGally::ggpairs(columns = 2:10,
mapping = aes(color = Tipo, alpha = 0.5, ),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
ggsave(file = "plotx6.png", plotx6, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(plotx6),
align = "center")
Foi notado que os objetos \(107,\;108,\;164,\;173\;e\;175\) estão muito afastados da massa central de dados. Como pode ser evidenciado abaixo. Sendo \(107\;e\;108\) pertencentes a classe X2 e \(164,\;173\;e\;175\) a classe X5.
A fim de tornar ainda mais evidente a informação, apresentaremos os gráficos de dispersão em maior tamanho e em escala z-score.
df_out2 <- df_out %>%
dplyr::mutate(rowid = as.factor(rowid),
Out = ifelse(rowid == "107" | rowid == "108" | rowid == "164" |
rowid == "173" | rowid == "175", "out", "ok")) %>%
dplyr::mutate_at(vars(2:10), funs(scale)) %>% # scale()
tidyr::gather(key = "Variaveis", value = "valor", 2:10)
plotx5 <- df_out2 %>%
dplyr::mutate(rowid = as.numeric(as.character(rowid))) %>%
ggplot2::ggplot() +
ggplot2::geom_jitter(aes(x = Variaveis, y = valor, fill = Out,
shape = Out),
alpha = 0.5, size = 3,
show.legend = F) +
facet_wrap(~Tipo, scales = "free") +
scale_shape_manual(values = c(20, 21)) +
theme_bw()
ggsave(file = "plotx5.png", plotx5, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(plotx5),
align = "center")df_out2xx <- df_out2 %>%
dplyr::mutate(Out = as.factor(Out))
levels(df_out2xx$Out) <- c('"Normal"', '"Outlier"')
plotx4 <- df_out2xx %>%
dplyr::filter(Variaveis == "Na") %>%
ggplot2::ggplot() +
stat_boxplot(aes(x = Tipo, y = valor),
geom = "errorbar", width = 0.5) +
geom_boxplot(aes(x = Tipo, y = valor),
color = "black", show.legend = F, outlier.shape = NA) +
geom_point(aes(x = Tipo, y = valor,
shape = Out, fill = Out, alpha = Out),
size = 5, width = 0.2,
position = position_jitter(w = 0.1, h = 0)) +
scale_shape_manual(values = c(24, 21)) +
scale_alpha_manual(values = c(0.2, 0.7)) +
scale_y_continuous(limits = c(min(df_out2$valor), max(df_out2$valor))) +
xlab(label = "Tipo do Vidro") + ylab("Z-Score") +
theme_bw() +
tema + theme(legend.position = "bottom")
plotx4
ggsave(file = "plotx4.png", plotx4, width = 11, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plotx4),
align = "center")
Contudo, ao plotar os pontos e box-plot em função da variável Na, podemos notar que os objetos \(173\;e\;175\) não apresentam comportamento incomum ou valor aberrante para o parâmetro, logo, manteremos como outliers apenas os objetos \(107,\;108\;e\;164\).
CONSTRUINDO MODELOS PREDITIVOS PARA CLASSIFICAÇÃO DE VIDRO
No presente trabalho utilizaremos o algoritmo de Random Forest, através do pacote caret, para poder proceder com a classificação multiclasse dos vidros. Adotaremos um número padrão de árvores (ntree = 1500), e todos os modelos gerados serão “cross-validados” através da técnica k-fold, onde \(k=10\). Como nesse problema existe desbalanceamento de classes, utilizaremos também técnicas de compensação como undersampling e oversampling.
Deste modo, utilizando o conjunto de dados sem promover modificações (apenas removendo outliers), construiremos 03 modelos de classificação:
Modelo com dados originais;
Modelo com under;
Modelo com over.
Logo, para proceder com a construção dos nossos modelos de classificação, manipularemos os dados para removermos os outliers, separaremos nosso banco de dados em treino (train_data) e teste (test_data), na proporção de 70-30%, e criaremos o objeto control_Cv para poder proceder com a cross-validation.
df_pred <- df_out %>%
dplyr::filter(!rowid %in% c("107","108","164")) %>%
dplyr::select(-rowid)
df_pred_tst <- df_pred
{
set.seed(42)
index <- caret::createDataPartition(df_pred$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred[index, ]
test_data <- df_pred[-index, ]
control_Cv_orig <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE)
control_Cv_up <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE,
sampling = "up")
control_Cv_down <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE,
sampling = "down")
}
arvores <- 1500
Com o df devidamente ajustado, partiremos então para a construção dos modelos:
MODELO RF SEM REAMOSTRAGEM
- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m1 <- caret::confusionMatrix(predict(model_rf_m1, test_data),
test_data$Tipo)
cm_original_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 4 4 0 0 1
X2 3 18 0 0 0 0
X3 1 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 2
X7 0 0 0 0 0 5
Overall Statistics
Accuracy : 0.7541
95% CI : (0.6271, 0.8554)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 4.418e-10
Kappa : 0.6542
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8182 0.20000 1.00000 1.00000
Specificity 0.7750 0.9231 0.98214 1.00000 0.96610
Pos Pred Value 0.6538 0.8571 0.50000 1.00000 0.50000
Neg Pred Value 0.8857 0.9000 0.93220 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.2951 0.01639 0.04918 0.03279
Detection Prevalence 0.4262 0.3443 0.03279 0.04918 0.06557
Balanced Accuracy 0.7923 0.8706 0.59107 1.00000 0.98305
Class: X7
Sensitivity 0.62500
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.94643
Prevalence 0.13115
Detection Rate 0.08197
Detection Prevalence 0.08197
Balanced Accuracy 0.81250MODELO RF COM OVERSAMPLING
- Random Forest com oversampling
set.seed(42)
model_rf_up_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m1 <- caret::confusionMatrix(predict(model_rf_up_m1, test_data),
test_data$Tipo)
cm_over_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 4 3 0 0 1
X2 3 18 0 0 0 1
X3 0 0 2 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.8033
95% CI : (0.6816, 0.894)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.86e-12
Kappa : 0.7206
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.8182 0.40000 1.00000 1.00000
Specificity 0.8000 0.8974 1.00000 1.00000 1.00000
Pos Pred Value 0.6923 0.8182 1.00000 1.00000 1.00000
Neg Pred Value 0.9143 0.8974 0.94915 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2951 0.03279 0.04918 0.03279
Detection Prevalence 0.4262 0.3607 0.03279 0.04918 0.03279
Balanced Accuracy 0.8286 0.8578 0.70000 1.00000 1.00000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500MODELO RF COM UNDERSAMPLING
- Random Forest com undersampling
set.seed(42)
model_rf_down_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m1 <- caret::confusionMatrix(predict(model_rf_down_m1, test_data),
test_data$Tipo)
cm_down_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 13 4 1 0 0 0
X2 4 12 2 0 0 1
X3 4 4 2 0 0 0
X5 0 1 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.623
95% CI : (0.4896, 0.7439)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 2.787e-05
Kappa : 0.4989
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6190 0.5455 0.40000 1.00000 1.00000
Specificity 0.8750 0.8205 0.85714 0.96552 1.00000
Pos Pred Value 0.7222 0.6316 0.20000 0.60000 1.00000
Neg Pred Value 0.8140 0.7619 0.94118 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2131 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.2951 0.3115 0.16393 0.08197 0.03279
Balanced Accuracy 0.7470 0.6830 0.62857 0.98276 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557TRANSFORMANDO DADOS
Apesar da robustez do algoritmo de RF e dos resultados satisfatórios removendo alguns objetos considerados como aberrantes, é notório que as distribuições de nossas variáveis preditoras K, Mg e RI apresentam elevada assimetria, e isto pode impactar negativamente o desempenho do modelo proposto.
Deste modo, iremos proceder com manutenção dos objetos considerados inicialmente como outliers e realizaremos a transformação das variáveis supracitadas através da técnica de transoformação de Yeo–Johnson. Tal fato se dá pela homogeneização da escolha do método de transformação pois algumas de nosss variáveis apresentam valor igual a 0 (zero), logo não poderemos utiliar técnica como transformação Box-Cox para todas as variáveis.
Abaixo, podemos visualizar que as variáveis mencionadas não apresentam visualmente padrão de distribuição normal.
shiny::div(plotly::ggplotly(df %>%
dplyr::select(RI, K, Mg, Tipo) %>%
tidyr::gather(key = "Variavel",
value = "valor", c(RI, K, Mg)) %>%
ggplot2::ggplot() +
geom_density(aes(valor, fill = Tipo), alpha = 0.5) +
facet_wrap(~Variavel, scales = "free") +
ylab("Densidade") +
theme_minimal_hgrid(12),
align = "center"))shiny::div(plotly::ggplotly(df %>%
dplyr::select(RI, K, Mg) %>%
tidyr::gather(key = "Variavel", value = "valor") %>%
ggplot2::ggplot() +
geom_density(aes(valor, fill = Variavel), alpha = 0.5) +
facet_wrap(~Variavel, scales = "free") +
ylab("Densidade") +
theme_minimal_hgrid(12),
align = "center"))CONSTRUINDO NOVOS MODELOS
Apesar dos bons valores de Acurácia, a classe X3 não apresenta bom score de Verdaadeiros Positivos, logo, novos modelos serão propostos para cenários similares, tendo em vista o melhor ajuste para o modelo preditor.
Cenário A
Para construir os novos modelos, precisaremos reajustar nosso df.
df_pred2 <- df %>%
dplyr::mutate(RI_tr = car::yjPower(df$RI, BN_RI$other_transforms$yeojohnson$lambda),
K_tr = car::yjPower(df$K, BN_K$other_transforms$yeojohnson$lambda),
Mg_tr = car::yjPower(df$Mg, BN_Mg$other_transforms$yeojohnson$lambda)) %>%
dplyr::select(-c(RI, K, Mg))
Para poder incrementar performance aos modelos propostos criaremos uma relação não linear entre os preditores e a resposta executando a regressão usando transformações dos preditores (James et al., 2013), onde iremos incluir variáveis \(X^2\) no nosso modelo.
E, para implementar tal estratéfia, as variáveis Fe e Ca serão elevadas a potência 2, baseado na análise exploratória e o feedback dos modelos construídos no moemnto anterior.
Poderiamos pensar em algo similar para a variável Ba, contudo, a explicação para semelhança de medidas de tendência central em X1 e X3 para Ba se dá pela elevada quantidade de objetos com valor 0 (zero) para esta variável preditora.
Nossos novos modelos propostos terão configuração análoga ao primeiros modelos, com dados “originais”, undersampling e oversampling.
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2aori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2aori <- caret::confusionMatrix(predict(model_rf_m2aori, test_data),
test_data$Tipo)
cm_original_m2aoriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 3 4 0 0 1
X2 4 19 0 0 0 0
X3 0 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 1
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.7869
95% CI : (0.6632, 0.8814)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.263e-11
Kappa : 0.6976
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8636 0.20000 1.00000 1.00000
Specificity 0.8000 0.8974 1.00000 1.00000 0.98305
Pos Pred Value 0.6800 0.8261 1.00000 1.00000 0.66667
Neg Pred Value 0.8889 0.9211 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.3115 0.01639 0.04918 0.03279
Detection Prevalence 0.4098 0.3770 0.01639 0.04918 0.04918
Balanced Accuracy 0.8048 0.8805 0.60000 1.00000 0.99153
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2aup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2aup <- caret::confusionMatrix(predict(model_rf_up_m2aup, test_data),
test_data$Tipo)
cm_over_m2aupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 2 0 0 1
X2 5 17 2 1 1 0
X3 2 0 1 0 0 0
X5 0 0 0 2 0 1
X6 0 0 0 0 1 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.6721
95% CI : (0.54, 0.7869)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 7.628e-07
Kappa : 0.5331
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.7727 0.20000 0.66667 0.50000
Specificity 0.8000 0.7692 0.96429 0.98276 1.00000
Pos Pred Value 0.6364 0.6538 0.33333 0.66667 1.00000
Neg Pred Value 0.8205 0.8571 0.93103 0.98276 0.98333
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.2787 0.01639 0.03279 0.01639
Detection Prevalence 0.3607 0.4262 0.04918 0.04918 0.01639
Balanced Accuracy 0.7333 0.7710 0.58214 0.82471 0.75000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2aunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2aunder <- caret::confusionMatrix(predict(model_rf_down_m2aunder, test_data),
test_data$Tipo)
cm_down_m2aunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 1 0 0 1
X2 2 12 2 0 0 0
X3 5 2 2 0 0 0
X5 0 2 0 3 0 0
X6 0 0 0 0 2 1
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6393
95% CI : (0.5063, 0.7584)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 8.991e-06
Kappa : 0.5217
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.5455 0.40000 1.00000 1.00000
Specificity 0.8250 0.8974 0.87500 0.96552 0.98305
Pos Pred Value 0.6667 0.7500 0.22222 0.60000 0.66667
Neg Pred Value 0.8250 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.08197 0.04918
Balanced Accuracy 0.7458 0.7214 0.63750 0.98276 0.99153
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557Cenário B
De maneira similar ao Cenário A, das “novas” variáveis, manteremos apenas a abordagem considerando as variáveis transformadas atráves do método Yeo-Johnson.
df_pred2 <- df %>%
dplyr::mutate(RI_tr = car::yjPower(df$RI, BN_RI$other_transforms$yeojohnson$lambda),
K_tr = car::yjPower(df$K, BN_K$other_transforms$yeojohnson$lambda),
Mg_tr = car::yjPower(df$Mg, BN_Mg$other_transforms$yeojohnson$lambda)) %>%
dplyr::select(-c(RI, K, Mg))
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2bori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
tree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2bori <- caret::confusionMatrix(predict(model_rf_m2bori, test_data),
test_data$Tipo)
cm_original_m2boriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 2 4 0 0 1
X2 4 20 0 0 0 1
X3 0 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.8033
95% CI : (0.6816, 0.894)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.86e-12
Kappa : 0.7186
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.9091 0.20000 1.00000 1.00000
Specificity 0.8250 0.8718 1.00000 1.00000 1.00000
Pos Pred Value 0.7083 0.8000 1.00000 1.00000 1.00000
Neg Pred Value 0.8919 0.9444 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.3279 0.01639 0.04918 0.03279
Detection Prevalence 0.3934 0.4098 0.01639 0.04918 0.03279
Balanced Accuracy 0.8173 0.8904 0.60000 1.00000 1.00000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2bup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2bup <- caret::confusionMatrix(predict(model_rf_up_m2bup, test_data),
test_data$Tipo)
cm_over_m2bupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 3 4 0 0 1
X2 3 18 0 0 0 0
X3 0 0 1 0 0 0
X5 0 0 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.7869
95% CI : (0.6632, 0.8814)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.263e-11
Kappa : 0.6992
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.8182 0.20000 1.00000 1.00000
Specificity 0.8000 0.9231 1.00000 0.98276 1.00000
Pos Pred Value 0.6923 0.8571 1.00000 0.75000 1.00000
Neg Pred Value 0.9143 0.9000 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2951 0.01639 0.04918 0.03279
Detection Prevalence 0.4262 0.3443 0.01639 0.06557 0.03279
Balanced Accuracy 0.8286 0.8706 0.60000 0.99138 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2bunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2bunder <- caret::confusionMatrix(predict(model_rf_down_m2bunder, test_data),
test_data$Tipo)
cm_down_m2bunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 15 4 1 0 0 1
X2 2 12 2 0 0 0
X3 4 3 2 0 0 0
X5 0 2 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6557
95% CI : (0.5231, 0.7727)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 2.711e-06
Kappa : 0.5433
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.7143 0.5455 0.40000 1.00000 1.00000
Specificity 0.8500 0.8974 0.87500 0.94828 1.00000
Pos Pred Value 0.7143 0.7500 0.22222 0.50000 1.00000
Neg Pred Value 0.8500 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2459 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.09836 0.03279
Balanced Accuracy 0.7821 0.7214 0.63750 0.97414 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557Cenário C
De maneira similar ao Cenário A, das “novas” variáveis, manteremos apenas a abordagem considerando as variáveis transformadas como \(X^2\).
df_pred2 <- df %>%
dplyr::mutate(Fe_2 = Fe^2,
Ca_2 = Ca^2)
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2cori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2cori <- caret::confusionMatrix(predict(model_rf_m2cori, test_data),
test_data$Tipo)
cm_original_m2coriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 4 4 0 0 2
X2 4 18 0 1 1 0
X3 0 0 1 0 0 0
X5 0 0 0 2 0 0
X6 0 0 0 0 1 1
X7 0 0 0 0 0 5
Overall Statistics
Accuracy : 0.7213
95% CI : (0.5917, 0.8285)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.099e-08
Kappa : 0.5967
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8182 0.20000 0.66667 0.50000
Specificity 0.7500 0.8462 1.00000 1.00000 0.98305
Pos Pred Value 0.6296 0.7500 1.00000 1.00000 0.50000
Neg Pred Value 0.8824 0.8919 0.93333 0.98305 0.98305
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.2951 0.01639 0.03279 0.01639
Detection Prevalence 0.4426 0.3934 0.01639 0.03279 0.03279
Balanced Accuracy 0.7798 0.8322 0.60000 0.83333 0.74153
Class: X7
Sensitivity 0.62500
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.94643
Prevalence 0.13115
Detection Rate 0.08197
Detection Prevalence 0.08197
Balanced Accuracy 0.81250
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2cup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2cup <- caret::confusionMatrix(predict(model_rf_up_m2cup, test_data),
test_data$Tipo)
cm_over_m2cupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 3 5 0 0 1
X2 3 17 0 0 0 0
X3 0 1 0 0 0 0
X5 0 0 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.7541
95% CI : (0.6271, 0.8554)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 4.418e-10
Kappa : 0.653
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.7727 0.00000 1.00000 1.00000
Specificity 0.7750 0.9231 0.98214 0.98276 1.00000
Pos Pred Value 0.6667 0.8500 0.00000 0.75000 1.00000
Neg Pred Value 0.9118 0.8780 0.91667 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2787 0.00000 0.04918 0.03279
Detection Prevalence 0.4426 0.3279 0.01639 0.06557 0.03279
Balanced Accuracy 0.8161 0.8479 0.49107 0.99138 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2cunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2cunder <- caret::confusionMatrix(predict(model_rf_down_m2cunder, test_data),
test_data$Tipo)
cm_down_m2cunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 1 0 0 1
X2 2 12 2 0 0 0
X3 5 2 2 0 0 0
X5 0 2 0 3 0 0
X6 0 0 0 0 2 1
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6393
95% CI : (0.5063, 0.7584)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 8.991e-06
Kappa : 0.5217
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.5455 0.40000 1.00000 1.00000
Specificity 0.8250 0.8974 0.87500 0.96552 0.98305
Pos Pred Value 0.6667 0.7500 0.22222 0.60000 0.66667
Neg Pred Value 0.8250 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.08197 0.04918
Balanced Accuracy 0.7458 0.7214 0.63750 0.98276 0.99153
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557ANÁLISE DE PERFORMANCE
models <- list(original_inicial = model_rf_m1,
original_2a = model_rf_m2aori,
original_2b = model_rf_m2bori,
original_3c = model_rf_m2cori,
over_inicial = model_rf_up_m1,
over_2a = model_rf_up_m2aup,
over_2b = model_rf_m2bori,
over_2c = model_rf_up_m2cup,
under_inicial = model_rf_down_m1,
under_2a = model_rf_down_m2aunder,
under_2b = model_rf_down_m2bunder,
under_2c = model_rf_down_m2cunder)
comparacao <- data.frame(Modelo = names(models),
Kappa = rep(NA, length(models)),
Acuracia = rep(NA, length(models)))
comparacao <- comparacao %>%
dplyr::mutate(Acuracia = c(cm_original_m1$overall[1],
cm_original_m2aori$overall[1],
cm_original_m2bori$overall[1],
cm_original_m2cori$overall[1],
cm_over_m1$overall[1],
cm_over_m2aup$overall[1],
cm_over_m2bup$overall[1],
cm_over_m2cup$overall[1],
cm_down_m1$overall[1],
cm_down_m2aunder$overall[1],
cm_down_m2bunder$overall[1],
cm_down_m2cunder$overall[1]),
Kappa = c(cm_original_m1$overall[2],
cm_original_m2aori$overall[2],
cm_original_m2bori$overall[2],
cm_original_m2cori$overall[2],
cm_over_m1$overall[2],
cm_over_m2aup$overall[2],
cm_over_m2bup$overall[2],
cm_over_m2cup$overall[2],
cm_down_m1$overall[2],
cm_down_m2aunder$overall[2],
cm_down_m2bunder$overall[2],
cm_down_m2cunder$overall[2]
)) %>%
reshape2::melt(id.vars = c("Modelo"))
levels(comparacao$variable) <- c("Kappa", "Acurácia")
plot_x3 <- ggplot(comparacao) +
geom_jitter(aes(x = variable,
y = value,
fill = Modelo),
width = 0.2, alpha = 0.7, size = 7, shape = 24) +
facet_grid(.~variable, scales = "free") +
# scale_y_continuous(limits = c(0, 1)) +
labs(title = "",
x = "Índice",
y = "Score",
color = "Legenda") +
theme_bw() +
tema +
theme(strip.background = element_blank(),
strip.text = element_blank())
ggsave(file = "plot_x3.png", plot_x3, width = 11, height = 7, dpi = 700)
plot_x3
comparacao <- comparacao %>%
dplyr::filter(Modelo %in% c("over_inicial", "original_2a", "original_2b", "over_2b"))
plot_x2 <- ggplot2::ggplot(comparacao,
(aes(x = variable,
y = value,
fill = Modelo))) +
geom_jitter(width = 0.2, alpha = 0.7, size = 7, shape = 24) +
scale_fill_manual(values = c(scales::hue_pal()(12)[1],
scales::hue_pal()(12)[2],
scales::hue_pal()(12)[5],
scales::hue_pal()(12)[8])) +
facet_wrap(~variable, scales = "free") +
labs(title = " ",
x = "Índice",
y = "Score",
color = "Legenda") +
theme_bw() +
tema +
theme(strip.background = element_blank(),
strip.text = element_blank())
ggsave(file = "plot_x2.png", plot_x2, width = 13, height = 9, dpi = 700)
plot_x2
df1 <- data.frame(cm_over_m1[["byClass"]], modelo = "cm_over_m1")
df3 <- data.frame(cm_original_m2bori[["byClass"]], modelo = "cm_original_m2bori")
plot_x1 <- df1 %>%
rbind(df3) %>%
cbind(classe = rep(paste0(rep('X', 6), setdiff(1:7, 4)), 2)) %>%
dplyr::select(1, 2, 7, 12, 13) %>%
tidyr::gather("Metrica", "Valor", -modelo, -classe) %>%
dplyr::mutate(Metrica = as.factor(Metrica),
Metrica = forcats::fct_recode(Metrica, "Sensibilidade" = "Sensitivity"),
Metrica = forcats::fct_recode(Metrica, "Especificidade" = "Specificity"),
modelo = forcats::fct_recode(modelo, "Overs. Cenário Inic." = "cm_over_m1"),
modelo = forcats::fct_recode(modelo, "Orig. Cenário 2 - B" = "cm_original_m2bori")) %>%
dplyr::rename(Modelo = "modelo") %>%
ggplot2::ggplot() +
geom_jitter(aes(x = Metrica, y = Valor, fill = Modelo),
alpha = 0.7, size = 7, shape = 24) +
facet_wrap(~classe, ncol = 6) +
scale_fill_manual(values = c(scales::hue_pal()(12)[8],
scales::hue_pal()(12)[2])) +
ylab("Score") + xlab("Métrica") +
theme_bw() +
tema +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
ggsave(file = "plot_x1.png", plot_x1, width = 13, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plot_x1),
align = "center")
Construído os modelos, foram plotados em gráficos as métricas dos doze modelos, para a comparação e seleção do de maior performance.
Analisando o gráfico da Figura 4, é perceptível que entre os doze modelos, quatro tiveram destaque nas métricas indicadas: original do cenário 2A, original do cenário 2B, o oversampling incial e o oversampling do cenário 2B. Sendo assim, a partir dessa análise visual, podemos selecionar apenas os quatro modelos de melhor performance para proceder com a análise. Podemos então projetar os quatro modelos selecionados entre os doze, para melhor avaliação.
Visualmente, é perceptível que, entre os quatro modelos, dois se destacaram: o oversampling inicial e o original de cenário 2B, possuindo valores de acurácia e Kappa bastante próximos. Logo, não é trivial selecionar o modelo de melhor performance avaliando essas duas métricas.
A fim de propor apenas um modelo preditivo, foi gerado o gráfico da Figura 6, onde a luz da exposição das métricas de sensibilidade, especificidade e F-Score, por classe, para os dois modelos, é possível ter mais propriedade acerca dos modelos construídos.
Os modelos obtiveram o mesmo desempenho para as três métricas nas classes X5, X6 e X7. Contudo, na classe X3, o modelo de oversampling inicial obteve maiores valores de sensibilidade, especificidade e F-Score.
Considerando que a classe X3, no geral, apresentou dificuldade em ser predita corretamente (verdadeiro positivo), o modelo escolhido para o de maior performance foi o de oversampling inicial, já que para as classes X1 e X2, temos um trade-off entre os modelos.
Tal situação contempla a perspectiva inicial de difícil segregação das classes X1 e X3, como constatado na análise exploratória. É notório, também, que a abordagem com múltiplos cenários possibilita melhor compreensão sobre desempenho dos modelos para determinadas situações. Sendo assim, feita toda a análise de métricas, o modelo de melhor performance foi o de reamostragem utilizando a técnica de oversampling, sem nenhuma potencialização ou transformação de variáveis, Cenário 1, com matriz de confusão do teste.
É notável o elevado número de acertos das classes X1 e X2, quando comparada as outras, justamente devido ao desbalanceamento de classes. Fica perceptível também, a dificuldade em acertar a classe X3, por ser facilmente confundida com a X1. As classes X5, X6 e X7 possuíram elevada taxa de acerto (100% para as X5 e X6).
Procurando otimizar o modelo preditivo escolhido, buscou-se reduzir o número de árvores da Random Forest com o objetivo pontual de reduzir o custo computacional.
É perceptível que o erro do OOB se torna estável na média a partir da 500ª árvore de decisão, apesar de certa instabilidade das classes X1 e X2, representando que não há muito ganho para o modelo a partir daí.
Sendo assim, foi modificado o número de árvores para 750 (representando metade do valor inicial), valor esse escolhido arbitrariamente com o objetivo de reduzir o custo computacional e não interferir negativamente no resultado, e o tempo de processamento para construção do modelo reduziu em 50%.
Comparando os resultados com a bibliografia consultada, mais precisamente o modelo construído por Aldayel (2012), o qual obteve uma acurácia de 80,37% através de um algoritmo que combinou a decisão de dois classificadores, técnica ensemble, K-Nearest Neighbor (KNN) e Hidden Naive Bayes (HNB), o modelo construído no presente trabalho, a partir do algoritmo de Random Forest e sua posterior otimização, demonstra resultado semelhante, sendo tão potente quanto o de dois classificadores.
# Importancia de variaveis por Ínice Gini
gini <- varImp(model_rf_up_m1)$importance %>%
as.data.frame() %>%
tibble::rownames_to_column() %>%
dplyr::arrange(Overall) %>%
dplyr::mutate(rowname = forcats::fct_inorder(rowname)) %>%
ggplot2::ggplot() +
geom_col(aes(x = rowname,
y = Overall,
fill = rowname),
col = "black", show.legend = F) +
coord_flip() +
scale_fill_grey() +
ggtitle("Random Forest - Oversampling - Cenário Inicial") +
xlab("Variável") + ylab("Overall") +
theme_bw() +
tema
ggsave(file = "gini.png", gini, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(gini), align = "center")# OOB
plot_oo1 <- model_rf_up_m1$finalModel[["err.rate"]] %>%
as.data.frame() %>%
dplyr::mutate(Arvores = 1:arvores) %>%
tidyr::gather("Var", "Erro", -Arvores) %>%
dplyr::filter(Var %in% c("OOB", "X1", "X2")) %>%
ggplot2::ggplot() +
geom_line(aes(x = Arvores, y = Erro, col = Var),
size = 1) +
scale_color_manual(values = c("black",
scales::hue_pal()(6)[1],
scales::hue_pal()(6)[2])) +
xlab("N° Árvores") + ylab("Erro") +
theme_minimal_hgrid(12) +
theme(legend.position = "bottom") + tema
shiny::div(plotly::ggplotly(plot_oo1), align = "center")plot_oo2 <- model_rf_up_m1$finalModel[["err.rate"]] %>%
as.data.frame() %>%
dplyr::mutate(Arvores = 1:arvores) %>%
tidyr::gather("Var", "Erro", -Arvores) %>%
dplyr::filter(Var %in% c("OOB", "X3", "X5", "X6", "X7")) %>%
ggplot2::ggplot() +
geom_line(aes(x = Arvores, y = Erro, col = Var),
size = 1) +
scale_color_manual(values = c("black",
scales::hue_pal()(6)[3],
scales::hue_pal()(6)[4],
scales::hue_pal()(6)[5],
scales::hue_pal()(6)[6])) +
xlab("N° Árvores") + ylab("Erro") +
theme_minimal_hgrid(12) +
theme(legend.position = "bottom") + tema
plot_oo3 <- model_rf_up_m1$finalModel[["err.rate"]] %>%
as.data.frame() %>%
dplyr::mutate(Arvores = 1:arvores) %>%
tidyr::gather("Var", "Erro", -Arvores) %>%
dplyr::filter(Var %in% c("X3", "X5", "X6", "X7")) %>%
ggplot2::ggplot() +
geom_line(aes(x = Arvores, y = Erro, col = Var),
size = 1) +
scale_color_manual(values = c(scales::hue_pal()(6)[3],
scales::hue_pal()(6)[4],
scales::hue_pal()(6)[5],
scales::hue_pal()(6)[6])) +
xlab("N° Árvores") + ylab("Erro") +
theme_minimal_hgrid(12) +
theme(legend.position = "bottom") + tema
plot_oo3 <- cowplot::plot_grid(plot_oo2, plot_oo3, align = "hv", rows = 2, axis = "bt")
cowplot::plot_grid(plot_oo1, plot_oo3, align = "hv", cols = 2, axis = "bt")
plot_oob <- model_rf_up_m1$finalModel[["err.rate"]] %>%
as.data.frame() %>%
dplyr::mutate(Arvores = 1:arvores) %>%
tidyr::gather("Var", "Erro", -Arvores) %>%
ggplot2::ggplot() +
geom_line(aes(x = Arvores, y = Erro, col = Var),
size = 1) +
scale_color_manual(values = c("black",
scales::hue_pal()(6)[1],
scales::hue_pal()(6)[2],
scales::hue_pal()(6)[3],
scales::hue_pal()(6)[4],
scales::hue_pal()(6)[5],
scales::hue_pal()(6)[6])) +
xlab("N° Árvores") + ylab("Erro") +
theme_minimal_hgrid(12) +
theme(legend.position = "bottom") + tema
ggsave(file = "plot_oob.png", plot_oob, width = 11, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plot_oob), align = "center")CONSIDERAÇÕES FINAIS
No presente trabalho fora proposto um modelo preditivo de classificação de vidro multiclasse, utilizando do algoritmo de Random Forest para diferentes cenários e situações de treinamento, dado a condição de desbalanceamento de classes de vidro, para suporte da análise forense.
O algoritmo mostrou-se eficiente visto que o resultado final compôs um valor de acurácia de 80,33%, ou seja, 49 de 61 observações, superior ao modelo original.
Como indicado por Breiman (2001), apesar de o algoritmo de Random Forest ser robusto para ruídos e outliers, o modelo de melhor performance foi construído a partir da a remoção de potenciais outliers. Deste modo, fica evidente a importância das técnicas de reamostragem para construção de modelos preditivos em condições de desbalanceamento de classes, haja visto que o modelo proposto no presente artigo foi concebido utilizando a técnica de oversampling.
Para a não-linearidade do problema, difícil segmentação de classes, o algoritmo utilizado apresenta resultados satisfatórios, inclusive para situações com pequeno número de objetos, como o vidro do tipo X3.
Como sugestão para trabalhos futuros, indicamos a aplicação de técnica de modelos de misturas, tendo em vista as possíveis subpopulações de distribuição dos atributos. Sugerimos também tentativa de técnicas mais robustas para detecção de outliers, como a PCA (Análise de Componentes Principais), e, para a construção de modelo com maior acurácia, a tentativa de emprego de método de super learning poderá proporcionar melhor performance.
Discentes:
Brenner Silva;
Marcello Pessoa.
Docente:
Karla Esquerre.
***