Deep Learning em R com Keras
Hélisson
11 de dezembro de 2018
KERAS
O Keras é uma biblioteca de deeplearning em Python. Aqui mostraremos que com o package Keras, podemos utilizar essa poderosa biblioteca aqui no R também. Para isso, vamos utilizar os dados das eleições para deputados e tentar predizer os resultados.
Carregando e ajustando os dados de treino
readr::read_csv(here::here("data/train.csv"),
progress = FALSE,
local=readr::locale("br"),
col_types = cols(ano = col_integer(),
sequencial_candidato = col_character(),
quantidade_doacoes = col_integer(),
quantidade_doadores = col_integer(),
total_receita = col_double(),
media_receita = col_double(),
recursos_de_outros_candidatos.comites = col_double(),
recursos_de_pessoas_fisicas = col_double(),
recursos_de_pessoas_juridicas = col_double(),
recursos_proprios = col_double(),
`recursos_de_partido_politico` = col_double(),
quantidade_despesas = col_integer(),
quantidade_fornecedores = col_integer(),
total_despesa = col_double(),
media_despesa = col_double(),
situacao = col_character(),
.default = col_character())) %>%
mutate(estado_civil = as.factor(estado_civil),
nome = as.factor(nome),
sexo = as.factor(sexo),
grau = as.factor(grau),
cargo = as.factor(cargo),
partido = as.factor(partido),
ocupacao = as.factor(ocupacao),
situacao = as.factor(situacao),
sequencial_candidato = as.numeric(sequencial_candidato),
uf = as.factor(uf)) -> data_train
data_train %>%
glimpse()## Observations: 7,622
## Variables: 24
## $ ano <int> 2006, 2006, 2006, 2006, ...
## $ sequencial_candidato <dbl> 10001, 10002, 10002, 100...
## $ nome <fct> JOSÉ LUIZ NOGUEIRA DE SO...
## $ uf <fct> AP, RO, AP, MS, RO, AP, ...
## $ partido <fct> PT, PT, PT, PRONA, PT, P...
## $ quantidade_doacoes <int> 6, 13, 17, 6, 48, 8, 6, ...
## $ quantidade_doadores <int> 6, 13, 16, 6, 48, 8, 6, ...
## $ total_receita <dbl> 16600.00, 22826.00, 1581...
## $ media_receita <dbl> 2766.67, 1755.85, 9301.2...
## $ recursos_de_outros_candidatos.comites <dbl> 0.00, 6625.00, 2250.00, ...
## $ recursos_de_pessoas_fisicas <dbl> 9000.00, 15000.00, 34150...
## $ recursos_de_pessoas_juridicas <dbl> 6300.00, 1000.00, 62220....
## $ recursos_proprios <dbl> 1300.00, 201.00, 59500.0...
## $ recursos_de_partido_politico <dbl> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ quantidade_despesas <int> 14, 24, 123, 8, 133, 38,...
## $ quantidade_fornecedores <int> 14, 23, 108, 8, 120, 37,...
## $ total_despesa <dbl> 16583.60, 20325.99, 1460...
## $ media_despesa <dbl> 1184.54, 846.92, 1187.09...
## $ cargo <fct> DEPUTADO FEDERAL, DEPUTA...
## $ sexo <fct> MASCULINO, FEMININO, FEM...
## $ grau <fct> ENSINO MÉDIO COMPLETO, S...
## $ estado_civil <fct> CASADO(A), SOLTEIRO(A), ...
## $ ocupacao <fct> VEREADOR, SERVIDOR PÚBLI...
## $ situacao <fct> nao_eleito, nao_eleito, ...Balanceamento
Precisamos garantir que as classes que serão analizadas estão bem representadas no conjunto de dados, caso contrário, teremos um resultado inapropriado no final da classificação, o que não será muito útil.
- Situação
## Queremos saber se a classe situação está desbalanceada.
data_train %>%
ggplot(aes(situacao, fill=situacao)) +
geom_bar() +
labs(x="Situação", y="FA")
É fácil notar que há um desbalanceamento muito grande no nosso conjunto de dados.
Correlação
data_train %>%
select(-ano,
-sequencial_candidato,
-nome) %>%
select(
recursos_de_outros_candidatos.comites,
recursos_de_pessoas_fisicas,
recursos_de_pessoas_juridicas,
recursos_proprios,
total_receita,
media_receita,
quantidade_doacoes,
quantidade_doadores,
`recursos_de_partido_politico`) %>%
ggcorr(palette = "RdBu", label = TRUE,
hjust = 0.95, label_size = 3,size = 3,
nbreaks = 5, layout.exp = 5)
Ajustando os dados
set.seed(100)
data_train$id <- 1:nrow(data_train)
data_train %>% dplyr::sample_frac(.8) -> train
dplyr::anti_join(data_train,
train,
by = 'id') -> testtrain %>%
select(-ano,-nome,-id,-sequencial_candidato) -> train
test %>%
select(-ano,-nome,-id,-sequencial_candidato) -> test
train %>%
dplyr::select_if(.,is.numeric) -> train.numeric
train %>%
dplyr::select_if(.,negate(is.numeric)) -> train.categorical
test %>%
dplyr::select_if(.,is.numeric) -> test.numeric
test %>%
dplyr::select_if(.,negate(is.numeric)) -> test.categoricaltrain.numeric %>%
preProcess(.,method = c("center","scale")) -> processParams
processParams %>%
predict(.,train.numeric) -> train.numeric
processParams %>%
predict(.,test.numeric) -> test.numeric
processParams## Created from 6098 samples and 13 variables
##
## Pre-processing:
## - centered (13)
## - ignored (0)
## - scaled (13)Fazendo o balanceamento com o ROSE
train %>%
clean_names() %>%
ROSE(situacao ~ .,
data =.,
seed = 100) %$%
data -> train.rosetrain.rose %>%
group_by(situacao) %>%
summarise(num = n()) %>%
ungroup() %>%
mutate(total = sum(num),
proportion = num/total)## # A tibble: 2 x 4
## situacao num total proportion
## <fct> <int> <int> <dbl>
## 1 nao_eleito 3066 6098 0.503
## 2 eleito 3032 6098 0.497Transformando Insformações Categoricas
Agora precisamos transformar os dados categoricos para um formato que funcione melhor para o processo de classificação. Para isso faremos uma transformação \(one-hot-encoding\).
## one hot encoding
train.numeric %>%
dplyr::bind_cols(train.categorical) -> train
test.numeric %>%
dplyr::bind_cols(test.categorical) -> testencoding <- build_encoding(dataSet = train,
cols = c("uf","sexo","grau","ocupacao",
"partido","estado_civil"),
verbose = F)
train <- one_hot_encoder(dataSet = train,
encoding = encoding,
drop = TRUE,
verbose = F)train.rose <- one_hot_encoder(dataSet = train.rose,
encoding = encoding,
drop = TRUE,
verbose = F)test <- one_hot_encoder(dataSet = test,
encoding = encoding,
drop = TRUE,
verbose = F)Preditores com Variação próxima de zero
Valores com variaçao próxima de zero não contribuiem em nada para um resultado melhor, e ainda por cima, podem quebrar alguns modelos. Por isso, iremos tratá-los.
train %>%
nearZeroVar(saveMetrics = TRUE) %>%
tibble::rownames_to_column("variable") %>%
filter(nzv == T) %>%
pull(variable) -> near_zero_vars
train %>%
select(-one_of(near_zero_vars)) -> train
train.rose %>%
select(-one_of(near_zero_vars)) -> train.rose
test %>%
select(-one_of(near_zero_vars)) -> test
near_zero_vars %>%
glimpse() ## chr [1:224] "cargo" "uf.AC" "uf.AL" "uf.AM" "uf.AP" "uf.BA" "uf.CE" ...Ajustando para o Keras
Agora precisamos adatar os nossos dados para utilizar o KERAS.
split_target_predictors <- function(df) {
df %>%
select(-situacao) %>%
as.matrix() -> x_data
df %>%
select(situacao) %>%
dummyVars(" ~ situacao", data = .,levelsOnly = TRUE) -> dmy
df %>%
select(situacao) %>%
data.frame(predict(dmy, newdata = .)) %>%
select(-situacao) %>%
as.matrix() -> y_data
dimnames(x_data) <- NULL
dimnames(y_data) <- NULL
newData <- list("predictors" = x_data, "target" = y_data)
return(newData)
}Dados de teste
test %>%
split_target_predictors() -> x_test
# extract target and predictors
y_test <- x_test$target
x_test <- x_test$predictorsDados de Submissão
submit_data %>%
select(-ano,-nome,-sequencial_candidato) -> submit_data
submit_data %>%
dplyr::select_if(.,is.numeric) -> submit_data.numeric
submit_data %>%
dplyr::select_if(.,negate(is.numeric)) -> submit_data.categorical
processParams %>%
predict(.,submit_data.numeric) -> submit_data.numeric
submit_data.numeric %>%
dplyr::bind_cols(submit_data.categorical) -> submit_data
submit_data <- one_hot_encoder(dataSet = submit_data,
encoding = encoding,
drop = TRUE,
verbose = F)
submit_data %>%
select(-one_of(near_zero_vars)) -> submit_data
submit_data %>%
glimpse()## Observations: 4,592
## Variables: 38
## $ quantidade_doacoes <dbl> -0.196539754, -0.1807211...
## $ quantidade_doadores <dbl> -0.20278851, -0.18464424...
## $ total_receita <dbl> -0.38166763, -0.37809337...
## $ media_receita <dbl> -0.340758506, -0.3332746...
## $ recursos_de_outros_candidatos.comites <dbl> -0.183048163, -0.1830481...
## $ recursos_de_pessoas_fisicas <dbl> -0.3196189, -0.2959079, ...
## $ recursos_de_pessoas_juridicas <dbl> -0.31179905, -0.31179905...
## $ recursos_proprios <dbl> -0.16530228, -0.16530228...
## $ recursos_de_partido_politico <dbl> -0.194678468, -0.1946784...
## $ quantidade_despesas <dbl> -0.30362862, -0.29654389...
## $ quantidade_fornecedores <dbl> -0.30829692, -0.30244644...
## $ total_despesa <dbl> -0.39077498, -0.38680872...
## $ media_despesa <dbl> -0.1208458894, -0.121583...
## $ uf.MG <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ uf.PR <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ uf.RJ <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ uf.RS <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ uf.SP <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ sexo.FEMININO <int> 0, 0, 0, 0, 0, 0, 0, 1, ...
## $ sexo.MASCULINO <int> 1, 1, 1, 1, 1, 1, 1, 0, ...
## $ `grau.ENSINO FUNDAMENTAL COMPLETO` <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ `grau.ENSINO MÉDIO COMPLETO` <int> 1, 0, 0, 0, 0, 1, 0, 0, ...
## $ `grau.SUPERIOR COMPLETO` <int> 0, 1, 0, 1, 1, 0, 1, 1, ...
## $ `grau.SUPERIOR INCOMPLETO` <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ ocupacao.ADVOGADO <int> 0, 0, 0, 0, 1, 0, 0, 0, ...
## $ ocupacao.DEPUTADO <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ ocupacao.EMPRESÁRIO <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ ocupacao.OUTROS <int> 0, 0, 1, 0, 0, 0, 0, 0, ...
## $ partido.PDT <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ partido.PMDB <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ partido.PSB <int> 0, 0, 1, 0, 0, 0, 0, 0, ...
## $ partido.PSDB <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ partido.PT <int> 0, 0, 0, 1, 1, 1, 1, 0, ...
## $ partido.PTB <int> 0, 0, 0, 0, 0, 0, 0, 1, ...
## $ partido.PV <int> 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ estado.civil.CASADO.A. <int> 0, 0, 1, 1, 1, 0, 1, 0, ...
## $ estado.civil.DIVORCIADO.A. <int> 0, 0, 0, 0, 0, 0, 0, 1, ...
## $ estado.civil.SOLTEIRO.A. <int> 1, 1, 0, 0, 0, 1, 0, 0, ...Configurando a Rede Neural
data_conf <- as.matrix(submit_data)
ind <- sample(2, nrow(data_conf), replace=TRUE, prob=c(0.67, 0.33))
data_conf.training <- data_conf[ind==1, 1:18]
data_conf.test <- data_conf[ind==2, 1:18]
data_conf.trainingtarget <- data_conf[ind==1, 19]
data_conf.testtarget <- data_conf[ind==2, 19]
data_conf.trainLabels <- to_categorical(data_conf.trainingtarget)
data_conf.testLabels <- to_categorical(data_conf.testtarget)
model.deep <- keras_model_sequential()
model.deep %>%
layer_dense(units = 8, activation = 'relu', input_shape = c(18)) %>%
layer_dense(units = 2, activation = 'softmax')
summary(model.deep)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 8) 152
## ___________________________________________________________________________
## dense_2 (Dense) (None, 2) 18
## ===========================================================================
## Total params: 170
## Trainable params: 170
## Non-trainable params: 0
## ___________________________________________________________________________model.deep %>% compile(
loss = 'categorical_crossentropy',
optimizer = 'adam',
metrics = 'accuracy'
)Visualizando o Train Fit
history <- model.deep %>% fit(
data_conf.training,
data_conf.trainLabels,
epochs = 35,
batch_size = 5,
validation_split = 0.2
)
plot(history)
plot(history$metrics$loss, main="Perda", xlab = "Época", ylab="loss", col="blue", type="l")
lines(history$metrics$val_loss, col="green")
legend("topright", c("train","test"), col=c("blue", "green"), lty=c(1,1))
plot(history$metrics$acc, main="Accuracy", xlab = "Época", ylab="accuracy", col="blue", type="l")
lines(history$metrics$val_acc, col="green")
legend("bottomright", c("train","test"), col=c("blue", "green"), lty=c(1,1))
classes <- model.deep %>% predict_classes(data_conf.test, batch_size = 128)
table(data_conf.testtarget, classes)## classes
## data_conf.testtarget 0
## 0 1123
## 1 447score <- model.deep %>% evaluate(data_conf.test, data_conf.testLabels, batch_size = 128)
print(score)## $loss
## [1] 0.5990877
##
## $acc
## [1] 0.7152866Testando com mais uma camada
score_other <- model.deep %>% evaluate(data_conf.test, data_conf.testLabels, batch_size = 128)
print(score_other)## $loss
## [1] 0.5990877
##
## $acc
## [1] 0.7152866Comparando
- No modelo passado, com o Adaboost, conseguimos
## AdaBoost Classification Trees
##
## 7622 samples
## 16 predictor
## 2 classes: 'nao_eleito', 'eleito'
##
## Pre-processing: scaled (25), centered (25), remove (53)
## Resampling: Cross-Validated (3 fold, repeated 3 times)
## Summary of sample sizes: 5081, 5081, 5082, 5081, 5082, 5081, ...
## Addtional sampling using SMOTE prior to pre-processing
##
## Resampling results across tuning parameters:
##
## nIter method Accuracy Kappa
## 1 Adaboost.M1 0.9532940 0.9065894
## 1 Real adaboost 0.9504514 0.9008927
## 2 Adaboost.M1 0.9566607 0.9133670
## 2 Real adaboost 0.9592410 0.9185068
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were nIter = 2 and method =
## Real adaboost.- Nesse:
print(score)## $loss
## [1] 0.5990877
##
## $acc
## [1] 0.7152866Vemos que o Ada se saiu melhor.