keras: Deep Learning em R

Neste laboratório vamos realizar uma breve introdução sobre a utilização do keras package para deep learning em R com os dados dos laboratórios anteriores sobre os candidatos à câmara federal.

Este laboratório foi baseado no tutorial de deep learning da DataCamp. Os dados utilizados nesse laboratório foram coletados do TSE, sendo tratados e contemplam informações sobre aproximadamente 4.100 candidatos, os dados podem ser baixados neste link.

Nesse laboratório vamos abordar os seguintes pontos:

  1. Configuração do ambiente para utilização do keras em R;
  2. Exploração dos dados;
  3. Normalização dos dados;
  4. Separação dos dados em treino e teste;
  5. Construindo e avaliando uma MLP com keras;
  6. Tuning de uma MLP com keras.
  7. Utilizacao de uma MLP com keras para a predicao dos candidatos eleitos para a Camara dos Deputados.

Nesse tutorial estamos assumindo que você está em um ambiente UNIX-like (Черт возьми, окна).

Instalando o keras

É necessário ter em mente que o keras package em R é uma interface para a implementação do keras em Python, então é necessário ter o ambiente Python configurado no nosso workspace, logo, vamos executar os seguintes comandos no terminal.

sudo apt-get install python
sudo apt-get install python-virtualenv
sudo pip install keras
sudo pip install tensorflow

Após, vamos instalar o keras package no nosso ambiente em R, para realizar tal tarefa vamos executar os seguintes comandos no ambiente R.

install.packages("keras")
install.packages("tensorflow")

Após a instalação do keras package vamos carregá-lo e instalar o TensorFlow.

# Carregando o package
library(keras)
library(tensorflow)

# Instalar o TensorFlow
install_tensorflow()

Lendo os dados

Nesse laboratório vamos usar dois conjunto de dados, um será para uma visão geral sobre o keras e o outro será para avaliarmos o desempenho de deep learning nos dados que temos sobre candidatos a câmara federal e a nossa tentativa de classificar os deputados eleitos e não eleitos.

O conjunto de dados para a visão geral sobre o keras será o famoso dataset iris. O dataset iris é um conjunto de dados sobre diferentes espécies da flor Íris.

# Dados candidatos Camara Federal
trainDataLab <- read.csv("~/Documents/AD2/Lab5/train.csv")

# Dados Iris
iris <- read.csv(url("http://archive.ics.uci.edu/ml/machine-learning-databases/iris/iris.data"), header = FALSE)

names(iris) <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")

Vamos observar como os dados estão estruturados usando a função str.

# Inspect the structure
str(iris)
## 'data.frame':    150 obs. of  5 variables:
##  $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Species     : Factor w/ 3 levels "Iris-setosa",..: 1 1 1 1 1 1 1 1 1 1 ...

Temos 150 observações sobre diferentes espécies de Íris e os dados estão estruturados em 5 atributos, onde 4 atributos são quantitativos e 1 atributo é qualitativo, sendo o atributo qualitativo “Species” a espécie da Íris que foi análisada. Além disso, podemos observar que os 4 atributos quantitativos restantes fazem referência, respectivamente, ao comprimento e largura da Sépala, e comprimento e largura da Pétala da flor analisada.

O objetivo desse overview sobre o keras é tentar classificar as flores de Íris com base nos comprimentos e larguras das Pétalas e Sépalas. Sabendo disto, vamos observar nos dados de teste quantas classes existem para a classificação.

table(iris$Species)
## 
##     Iris-setosa Iris-versicolor  Iris-virginica 
##              50              50              50

Temos 3 classes de classificação com 50 observações para cada uma, ou seja, um fato bom deste dataset é que os dados estão balanceados! Sendo desnecessário técnicas de balanceamento!

Exploração dos dados

Nossa variável target é Species, então vamos usar um facet_grid para termos uma noção de como os dados, de forma geral, se comportam.

library(ggplot2)

iris$SL <- cut_width(iris$Sepal.Length, 1.2)
iris$SW <- cut_width(iris$Sepal.Width, 0.7)

plot <- ggplot(iris, aes(Petal.Length, Petal.Width, colour = factor(Species))) + geom_point()

plot + facet_grid(SL ~ SW, labeller = label_both)

Podemos observar que em cada grid os dados se agrupam bem em clusters, dando um bom indicativo de que as variáveis explicativas são bem representativas para a variável a ser explicada Species.

Além disso, vamos visualizar como se comportam os dados de forma isolada para os dados das Pétalas e Sépalas.

ggplot(iris, aes(Petal.Length, Petal.Width, colour = factor(Species))) + geom_point()

Podemos observar que as informações sobre as Pétalas das Íris são bem representativos em relação à Species pelo fato das observações para cada tipo de Species ficarem bem agrupadas.

ggplot(iris, aes(Sepal.Length, Sepal.Width, colour = factor(Species))) + geom_point()

O mesmo agrupamento com as informações sobre as Sépalas não é observado como nos dados sobre as Pétalas. Essa informações são importantes, pois, indicam quais variáveis são mais importantes para explicar Species.

Outra informação importante sobre os dados é se as variáveis explicativas são correlacionadas, para isto, vamos visualizar o correlograma das variáveis explicativas.

library(GGally)

ggpairs(subset(iris, select = c(Petal.Length, Petal.Width, Sepal.Length, Sepal.Width)))

Podemos observar que as variáveis Petal.Lenght e Petal.Width são altamente correlacionadas linearmente, em alguns algoritmos de Aprendizado de Máquina essa correlação pode ser um problema para a avaliação da importância de cada variável no modelo. Além disso, uma alta correlação entre as variáveis explicativas indicam que os dados explicam as mesmas informações sobre a variável a ser explicada, que no nosso caso é Species.

O ideal é que as variáveis explicativas fossem tão independentes quanto o possível, ou seja, não possuíssem correlação umas com as outras, mas vamos deixar essa informação em background e se for necessário vamos usá-la posteriormente.

Normalização dos dados

A normalização de dados é importante pelo fato de que diferentes escalas nas variáveis explicativas podem enviesar o aprendizado de alguns algoritmos, pois, uma variável em que a escala de valores é próxima da escala da variável a ser explicada pode dar uma errônea impressão que ela é mais importante para explicar a variável de interesse quando isto não é verdade. Normalizar/padronizar os dados garante que cada variável explicativa tenha pesos iguais para a explicação da variável de interesse.

Existem diversas técnicas de normalização de dados, duas técnicas conhecidas são:

Normalização Função Descrição
Standard Score (X - u) / o X observação, u média das observações, o desvio padrão das observações
Feature scaling (X - Xmin) / (Xmax - Xmin) X observação, Xmax maior valor das observações, Xmin menor valor das observações
L2-norm ||v|| = sqrt(X1^2 + X2^2 + … + Xm^2) Essa normalização transforma cada vetor coluna em um vetor unitário com base na distância euclidiana

Vamos observar as escalas das nossas variáveis explicativas.

iris$SL <- NULL
iris$SW <- NULL
summary(iris)
##   Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
##  Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100  
##  1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300  
##  Median :5.800   Median :3.000   Median :4.350   Median :1.300  
##  Mean   :5.843   Mean   :3.054   Mean   :3.759   Mean   :1.199  
##  3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800  
##  Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500  
##             Species  
##  Iris-setosa    :50  
##  Iris-versicolor:50  
##  Iris-virginica :50  
##                      
##                      
##

Podemos observar que as escalas das variáveis estão bem próximas, ou seja, não seria uma obrigação neste caso realizar uma normalização dos dados, mas a título de uso, vamos realizá-la.

Neste caso, vamos usar a função de normalização normilize disponibilizada pelo keras. A função de normalização usada por padrão pela normalize é a L2-norm.

normalizedIris <- iris
normalizedIris[,5] <- as.numeric(normalizedIris[,5]) -1

normalizedIris <- as.matrix(normalizedIris)
dimnames(normalizedIris) <- NULL

normalizedIris <- normalize(normalizedIris[,1:4])

summary(normalizedIris)
##        V1               V2               V3               V4         
##  Min.   :0.6539   Min.   :0.2384   Min.   :0.1678   Min.   :0.01473  
##  1st Qu.:0.7153   1st Qu.:0.3267   1st Qu.:0.2509   1st Qu.:0.04873  
##  Median :0.7549   Median :0.3544   Median :0.5364   Median :0.16415  
##  Mean   :0.7516   Mean   :0.4048   Mean   :0.4550   Mean   :0.14096  
##  3rd Qu.:0.7884   3rd Qu.:0.5252   3rd Qu.:0.5800   3rd Qu.:0.19753  
##  Max.   :0.8609   Max.   :0.6071   Max.   :0.6370   Max.   :0.28042

Podemos observar os dados normalizados que estão entre valores de [0, 1].

Dados de Treino e Teste

Agora vamos separar as observações em dados de teste e treino. A separação dos dados é importante para a avaliação de performance do nosso modelo de deep learning que vamos construir. Para isto, vamos utilizar a função sample separando com 0.70 de probabilidade dos dados como de treino e com 0.30 de probabilidade dos dados como de teste.

set.seed(150011001)

# Determine sample size
ind <- sample(2, nrow(normalizedIris), replace=TRUE, prob=c(0.70, 0.30))

# Split the `normalizedIris` data
iris.training <- normalizedIris[ind==1, 1:4]
iris.test <- normalizedIris[ind==2, 1:4]

# Split the class attribute
iris.trainingtarget <- iris[ind==1, 5]
iris.testtarget <- iris[ind==2, 5]

str(iris.training)
##  num [1:106, 1:4] 0.804 0.828 0.805 0.818 0.803 ...
str(iris.test)
##  num [1:44, 1:4] 0.8 0.791 0.784 0.78 0.802 ...
summary(iris.trainingtarget)
##     Iris-setosa Iris-versicolor  Iris-virginica 
##              31              37              38
summary(iris.testtarget)
##     Iris-setosa Iris-versicolor  Iris-virginica 
##              19              13              12

One-Hot Encoding

Quando trabalhamos com modelos de classificação multi-classe com redes neurais, normalmente é uma boa prática garantir que a variável target esteja em One-Hot Encoding, que é uma estrutura matricial que na coluna j indica se a observação i é ou não da classe associada com o valor de j.

Novamente, o package keras disponibiliza uma função que já realiza a transformação da variável target para One-Hot Encoding, a função to_categorical.

# One hot encode training target values
iris.trainLabels <- to_categorical(iris.trainingtarget)[, 2:4]

# One hot encode test target values
iris.testLabels <- to_categorical(iris.testtarget)[, 2:4]

# Print out the iris.testLabels to double check the result
print(iris.testLabels)
##       [,1] [,2] [,3]
##  [1,]    1    0    0
##  [2,]    1    0    0
##  [3,]    1    0    0
##  [4,]    1    0    0
##  [5,]    1    0    0
##  [6,]    1    0    0
##  [7,]    1    0    0
##  [8,]    1    0    0
##  [9,]    1    0    0
## [10,]    1    0    0
## [11,]    1    0    0
## [12,]    1    0    0
## [13,]    1    0    0
## [14,]    1    0    0
## [15,]    1    0    0
## [16,]    1    0    0
## [17,]    1    0    0
## [18,]    1    0    0
## [19,]    1    0    0
## [20,]    0    1    0
## [21,]    0    1    0
## [22,]    0    1    0
## [23,]    0    1    0
## [24,]    0    1    0
## [25,]    0    1    0
## [26,]    0    1    0
## [27,]    0    1    0
## [28,]    0    1    0
## [29,]    0    1    0
## [30,]    0    1    0
## [31,]    0    1    0
## [32,]    0    1    0
## [33,]    0    0    1
## [34,]    0    0    1
## [35,]    0    0    1
## [36,]    0    0    1
## [37,]    0    0    1
## [38,]    0    0    1
## [39,]    0    0    1
## [40,]    0    0    1
## [41,]    0    0    1
## [42,]    0    0    1
## [43,]    0    0    1
## [44,]    0    0    1

Nos nossos dados, cada valor de j representa:

  1. Iris-setosa
  2. Iris-versicolor
  3. Iris-virginica

Construindo o Modelo

Para construir o modelo é necessário inicializar um modelo sequencial com a ajuda da função keras_model_sequential disponibilizada pelo keras.

O modelo que vamos construir é uma rede neural MLP Multi-layer perceptron com a função de ativação ReLU (Rectifier Linear Units) na hidden layer e a função de ativação softmax na output layer. É importante usar a função de ativação softmax na output layer para garantir que os valores de saída estejam no range [0, 1], pois, estes valores são interpretados como probabilidades.

# Initialize a sequential model
model <- keras_model_sequential() 

# Add layers to the model
model %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

No modelo acima criamos duas camadas. A primeira camada possui um shape de entrada com 4 perceptrons um para cada variável explicativa, e além disso possui 8 hidden perceptrons para aprendizado. A segunda camada que é a de saída possui 3 perceptrons, um para Classe da nossa variável target (versicolor, virginica e setosa).

Algumas funções podem ser usadas para inspeção de um modelo construído:

  1. summary - imprime um resumo sobre o modelo;
  2. get_config - retorna uma lista que contém a configuração do modelo;
  3. get_layer - retorna a configuração de uma camada;
  4. model$layers - atributo que pode ser usado para obter informações sobre as camadas do modelo;
  5. model$inputs - atributo que lista os tensores de entrada;
  6. model$outputs - atributo que lista os tensores de saída.
# Print a summary of a model
summary(model)
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense_1 (Dense)                  (None, 8)                     40          
## ___________________________________________________________________________
## dense_2 (Dense)                  (None, 3)                     27          
## ===========================================================================
## Total params: 67
## Trainable params: 67
## Non-trainable params: 0
## ___________________________________________________________________________
# Get model configuration
get_config(model)
## [{'class_name': 'Dense', 'config': {'kernel_initializer': {'class_name': 'VarianceScaling', 'config': {'distribution': 'uniform', 'scale': 1.0, 'seed': None, 'mode': 'fan_avg'}}, 'name': 'dense_1', 'kernel_constraint': None, 'bias_regularizer': None, 'bias_constraint': None, 'dtype': 'float32', 'activation': 'relu', 'trainable': True, 'kernel_regularizer': None, 'bias_initializer': {'class_name': 'Zeros', 'config': {}}, 'units': 8, 'batch_input_shape': (None, 4), 'use_bias': True, 'activity_regularizer': None}}, {'class_name': 'Dense', 'config': {'kernel_initializer': {'class_name': 'VarianceScaling', 'config': {'distribution': 'uniform', 'scale': 1.0, 'seed': None, 'mode': 'fan_avg'}}, 'name': 'dense_2', 'kernel_constraint': None, 'bias_regularizer': None, 'bias_constraint': None, 'activation': 'softmax', 'trainable': True, 'kernel_regularizer': None, 'bias_initializer': {'class_name': 'Zeros', 'config': {}}, 'units': 3, 'use_bias': True, 'activity_regularizer': None}}]
# Get layer configuration
get_layer(model, index = 1)
## <keras.layers.core.Dense>
# List the model's layers
model$layers
## [[1]]
## <keras.layers.core.Dense>
## 
## [[2]]
## <keras.layers.core.Dense>
# List the input tensors
model$inputs
## [[1]]
## Tensor("dense_1_input:0", shape=(?, 4), dtype=float32)
# List the output tensors
model$outputs
## [[1]]
## Tensor("dense_2/Softmax:0", shape=(?, 3), dtype=float32)

Compilando e Treinando o Modelo

Dado que já criamos a arquitetura da nossa rede neural, vamos agora compilar o modelo e fazê-lo aprender com os dados. Para compilar nosso modelo precisamos definir a função de perda (loss function) para o cálculo dos valores de erro das predições, o algoritmo de otimização (optimizer) para escolher o melhor modelo em cada perceptron minimizando os erros, e a métrica de avaliação final do modelo (metrics).

O keras disponibiliza diversas funções e métricas para a compilação dos modelos. Para a nossa função de perda vamos utilizar a categorical_crossentropy, a função de otimização será a adam e a métrica de avaliação a accuracy.

# Compile the model
model %>% compile(
     loss = 'categorical_crossentropy',
     optimizer = 'adam',
     metrics = 'accuracy'
 )

O algoritmo de otimização adam é uma combinação de dois algoritmos que estendem o stochastic gradient descent:

  1. Adaptive Gradient Algorithm (AdaGrad).
  2. Root Mean Square Propagation (RMSProp).

Dependendo do algoritmo de otimização escolhido, será necessário tunar alguns parâmetros como o learning rate ou momentum.

Como nosso modelo de classificação é multi-classe, então, tivemos que utilizar a função categorical_crossentropy, contudo, se nosso modelo de classificação fosse binário, escolheríamos a função binary_crossentropy.

Já a métrica de avaliação final do modelo, vamos utilizar a accuracy que é a quantidade de predições corretas sobre o total de predições. Existem outras métricas de avaliação como a F1-score, recall, precision.

Agora podemos mandar o modelo aprender com nossos dados. Vamos treinar o modelo para 200 iterações sobre todas as amostras no dados de treino dividos em 5 pedaços.

set.seed(1555000000)

# Fit the model 
history <- model %>% fit(
     iris.training, 
     iris.trainLabels, 
     epochs = 200, 
     batch_size = 5, 
     validation_split = 0.2)

O código acima treina o modelo para um número específico de ephocs ou exposições do conjunto de dados de treino. Um epoch é uma iteração por todos os dados de treino. O tamanho do batch define o número de amostras que serão propagadas na rede neural.

Com o modelo treinado, vamos visualizar a história do treinamento do nosso modelo.

plot(history)

O plot acima apresenta a história do treinamento do modelo. O primeiro gráfico reporta a história da acurácia do modelo tanto nos dados de treinamento como nos dados de validação. O segundo gráfico reporta a história da função de perda do modelo tanto nos dados de treinamento como nos dados de validação, no caso da função loss quanto menor o valor, melhor.

Algumas conclusões que podemos tirar observando a história do treinamento do modelo:

  • Se acurácia nos dados de treinamento só aumenta enquanto a acurácia no dados de validação diminui, então é provável que esteja acontecendo um overfitting: o modelo está apenas memorizando os dados de treino ao invés de aprender com eles.
  • Se a acurácia continua a aumentar nas últimas iterações (epoch) tanto nos dados de treino como nos dados de validação, podemos afirmar que o modelo ainda não aprendeu tudo que poderia ser aprendido com os dados de treino.

Predição de Dados

Agora que o modelo está criado, compilado e treinado, vamos realizar predições para os dados de teste que separamos. Para isso, vamos utilizar a função predict e depois imprimir a confusion matrix para visualizar as predições corretas e incorretas que nosso modelo realizou com a ajuda da função table.

# Predict the classes for the test data
classes <- model %>% predict_classes(iris.test, batch_size = 128)

# Confusion matrix
table(iris.testtarget, classes)
##                  classes
## iris.testtarget    0  1
##   Iris-setosa     19  0
##   Iris-versicolor  0 13
##   Iris-virginica   0 12

O ideal da confusion matrix é que todas as observações para cada classe estivessem na diagonal da matriz, qualquer outros valores fora da diagonal são considerados predições incorretas.

Avaliando o modelo

Mesmo tendo um indicativo sobre a performance do modelo observando a confusion matrix, é importante avaliar o modelo, para isto vamos utilizar a função evaluate, a função vai nos dar um score sobre o modelo.

# Evaluate on test data and labels
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the score
print(score)
## $loss
## [1] 0.3709408
## 
## $acc
## [1] 0.7272727

Como já comentamos anteriormente, o score da acurácia quanto mais próximo de 1 melhor, já o de score de loss quanto mais próximo de 0 melhor. Estes valores apresentam uma forma de avaliar a performance do modelo.

Fine-tuning do Modelo

Para o tuning do nosso modelo podemos tentar diversas soluções como:

  1. Adicionar mais camadas;
  2. Adicionar mais perceptrons em cada camada;
  3. Variar o número de epochs;
  4. Variar o batch size;
  5. Testar outros parâmetros na função compile.
Adicionando camadas

Vamos adicionar mais uma camada com 5 perceptrons.

# Initialize the sequential model
modelMLayers <- keras_model_sequential() 

# Add layers to model
modelMLayers %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 5, activation = 'relu') %>% 
    layer_dense(units = 3, activation = 'softmax')

# Compile the model
modelMLayers %>% compile(
     loss = 'categorical_crossentropy',
     optimizer = 'adam',
     metrics = 'accuracy'
 )

# Fit the model to the data
history <- modelMLayers %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 200, batch_size = 5, 
     validation_split = 0.2
 )

# Plot model history
plot(history)

# Evaluate the model
score <- modelMLayers %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the score
print(score)
## $loss
## [1] 0.07623673
## 
## $acc
## [1] 0.9772727
Adicionando perceptrons

Vamos aumentar o número de perceptrons da primeira camada de 8 para 28.

# Initialize a sequential model
model <- keras_model_sequential() 

# Add layers to the model
model %>% 
    layer_dense(units = 28, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

# Compile the model
model %>% compile(
     loss = 'categorical_crossentropy',
     optimizer = 'adam',
     metrics = 'accuracy'
 )

# Fit the model to the data
history <- model %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 200, batch_size = 5, 
     validation_split = 0.2
 )

plot(history)

# Evaluate the model
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the score
print(score)
## $loss
## [1] 0.2955967
## 
## $acc
## [1] 0.7954546
Aumentando o número de epochs

Aumentando o número de epochs para 500.

# Initialize a sequential model
model <- keras_model_sequential() 

# Build up your model by adding layers to it
model %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

# Use the optimizer to compile the model
model %>% compile(optimizer='adam', 
                  loss='categorical_crossentropy', 
                  metrics='accuracy')

# Fit the model to the training data
history <- model %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 500, batch_size = 5, 
     validation_split = 0.2
 )

plot(history)

# Evaluate the model
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the loss and accuracy metrics
print(score)
## $loss
## [1] 0.2496268
## 
## $acc
## [1] 0.8636364
Variando o batch_size

Diminuindo para 2.

# Initialize a sequential model
model <- keras_model_sequential() 

# Build up your model by adding layers to it
model %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

# Use the optimizer to compile the model
model %>% compile(optimizer='adam', 
                  loss='categorical_crossentropy', 
                  metrics='accuracy')

# Fit the model to the training data
history <- model %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 200, batch_size = 2, 
     validation_split = 0.2)
 

plot(history)

# Evaluate the model
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the loss and accuracy metrics
print(score)
## $loss
## [1] 0.1570387
## 
## $acc
## [1] 0.9545454

Aumentando para 10.

# Initialize a sequential model
model <- keras_model_sequential() 

# Build up your model by adding layers to it
model %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

# Use the optimizer to compile the model
model %>% compile(optimizer='adam', 
                  loss='categorical_crossentropy', 
                  metrics='accuracy')

# Fit the model to the training data
history <- model %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 200, batch_size = 10, 
     validation_split = 0.2)
 

plot(history)

# Evaluate the model
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the loss and accuracy metrics
print(score)
## $loss
## [1] 0.420747
## 
## $acc
## [1] 0.7272727
Parâmetros da função compile

Podemos ajustar os parâmetros do algoritmo de otimização da função compile. Vamos experimentar ajustar o learning rate do algoritmo Stochastic Gradient Descent (SGD) com a função optimizer_sgd.

# Initialize a sequential model
model <- keras_model_sequential() 

# Build up your model by adding layers to it
model %>% 
    layer_dense(units = 8, activation = 'relu', input_shape = c(4)) %>% 
    layer_dense(units = 3, activation = 'softmax')

# Define an optimizer
sgd <- optimizer_sgd(lr = 0.01)

# Use the optimizer to compile the model
model %>% compile(optimizer=sgd, 
                  loss='categorical_crossentropy', 
                  metrics='accuracy')

# Fit the model to the training data
history <- model %>% fit(
     iris.training, iris.trainLabels, 
     epochs = 200, batch_size = 5, 
     validation_split = 0.2
 )

plot(history)

# Evaluate the model
score <- model %>% evaluate(iris.test, iris.testLabels, batch_size = 128)

# Print the loss and accuracy metrics
print(score)
## $loss
## [1] 0.494023
## 
## $acc
## [1] 0.7272727

MLP para Deputados Eleitos

Agora vamos construir uma MLP para o nosso problema de classificar um candidato a Camara dos Deputados como eleito ou nao eleito.

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:tensorflow':
## 
##     train
observations <- read.csv("~/Documents/AD2/Lab5/train.csv")
testSamples <- read.csv("~/Documents/AD2/Lab5/test.csv")

observations <- subset(observations, select = c(UF, partido, sexo, descricao_ocupacao, descricao_cor_raca, quantidade_doacoes, quantidade_doadores, total_receita, media_receita, recursos_de_outros_candidatos.comites, recursos_de_partidos, recursos_de_pessoas_físicas, recursos_de_pessoas_juridicas, recursos_proprios, quantidade_despesas, quantidade_fornecedores, idade, despesa_max_campanha, situacao_final))

testSamples <- subset(testSamples, select = c(UF, partido, sexo, descricao_ocupacao, descricao_cor_raca, quantidade_doacoes, quantidade_doadores, total_receita, media_receita, recursos_de_outros_candidatos.comites, recursos_de_partidos, recursos_de_pessoas_físicas, recursos_de_pessoas_juridicas, recursos_proprios, quantidade_despesas, quantidade_fornecedores, idade, despesa_max_campanha))

str(testSamples)
## 'data.frame':    1012 obs. of  18 variables:
##  $ UF                                   : Factor w/ 27 levels "AC","AL","AM",..: 10 10 10 10 10 10 10 10 10 10 ...
##  $ partido                              : Factor w/ 31 levels "DEM","PCB","PC do B",..: 5 8 8 10 25 25 25 4 4 27 ...
##  $ sexo                                 : Factor w/ 2 levels "FEMININO","MASCULINO": 2 2 2 2 2 2 2 2 2 2 ...
##  $ descricao_ocupacao                   : Factor w/ 102 levels "ADMINISTRADOR",..: 2 7 33 1 88 33 95 2 24 55 ...
##  $ descricao_cor_raca                   : Factor w/ 5 levels "AMARELA","BRANCA",..: 4 5 4 2 4 5 5 4 4 2 ...
##  $ quantidade_doacoes                   : int  3 3 5 2 4 65 5 18 25 3 ...
##  $ quantidade_doadores                  : int  3 3 4 2 2 44 1 13 22 1 ...
##  $ total_receita                        : num  5100 4490 3515 1500 2100 ...
##  $ media_receita                        : num  1700 1497 703 750 525 ...
##  $ recursos_de_outros_candidatos.comites: num  0e+00 0e+00 0e+00 0e+00 0e+00 0e+00 0e+00 5e+04 3e+05 0e+00 ...
##  $ recursos_de_partidos                 : num  0 490 1015 0 0 ...
##  $ recursos_de_pessoas_físicas          : num  4500 4000 2500 1500 600 ...
##  $ recursos_de_pessoas_juridicas        : num  0 0 0 0 0 ...
##  $ recursos_proprios                    : num  600 0 0 0 1500 ...
##  $ quantidade_despesas                  : int  13 3 3 2 4 61 5 75 67 24 ...
##  $ quantidade_fornecedores              : int  7 3 2 2 4 46 1 27 29 15 ...
##  $ idade                                : int  35 53 40 67 35 32 28 51 34 62 ...
##  $ despesa_max_campanha                 : int  4000000 4000000 4000000 2000000 3000000 3000000 3000000 2500000 2500000 2500000 ...
observations <- upSample(x = observations[, -ncol(observations)],
                     y = observations$situacao_final)
colnames(observations)[ncol(observations)] <- "situacao_final"

str(observations)
## 'data.frame':    7438 obs. of  19 variables:
##  $ UF                                   : Factor w/ 27 levels "AC","AL","AM",..: 26 4 26 2 24 15 16 26 19 16 ...
##  $ partido                              : Factor w/ 32 levels "DEM","PCB","PC do B",..: 1 14 14 15 8 20 18 26 8 8 ...
##  $ sexo                                 : Factor w/ 2 levels "FEMININO","MASCULINO": 2 2 2 2 2 2 2 2 2 2 ...
##  $ descricao_ocupacao                   : Factor w/ 156 levels "ADMINISTRADOR",..: 76 97 75 39 39 127 39 2 39 123 ...
##  $ descricao_cor_raca                   : Factor w/ 5 levels "AMARELA","BRANCA",..: 2 4 2 2 2 2 4 5 2 2 ...
##  $ quantidade_doacoes                   : int  89 13 78 22 159 27 14 193 30 60 ...
##  $ quantidade_doadores                  : int  30 13 16 11 141 16 11 55 8 49 ...
##  $ total_receita                        : num  1107580 89464 1956049 1326149 1795660 ...
##  $ media_receita                        : num  12445 6882 25078 60279 11293 ...
##  $ recursos_de_outros_candidatos.comites: num  270445 0 1626024 1500 0 ...
##  $ recursos_de_partidos                 : num  728000 70000 100000 1255149 550000 ...
##  $ recursos_de_pessoas_físicas          : num  40681 15964 15835 27500 189350 ...
##  $ recursos_de_pessoas_juridicas        : num  68454 1500 208890 30000 1044462 ...
##  $ recursos_proprios                    : num  0 2000 5300 12000 11848 ...
##  $ quantidade_despesas                  : int  346 37 2952 354 761 85 288 1783 158 862 ...
##  $ quantidade_fornecedores              : int  117 15 1104 215 263 35 129 874 56 288 ...
##  $ idade                                : int  38 43 58 56 58 49 35 54 62 72 ...
##  $ despesa_max_campanha                 : int  6000000 900000 6000000 3000000 4000000 6000000 5000000 10000000 9000000 3000000 ...
##  $ situacao_final                       : Factor w/ 2 levels "eleito","nao_eleito": 1 1 1 1 1 1 1 1 1 1 ...
# must have at least the one observation of each factor
testSamples$situacao_final <- "eleito"
observations <- rbind(observations, testSamples)
str(observations)
## 'data.frame':    8450 obs. of  19 variables:
##  $ UF                                   : Factor w/ 27 levels "AC","AL","AM",..: 26 4 26 2 24 15 16 26 19 16 ...
##  $ partido                              : Factor w/ 32 levels "DEM","PCB","PC do B",..: 1 14 14 15 8 20 18 26 8 8 ...
##  $ sexo                                 : Factor w/ 2 levels "FEMININO","MASCULINO": 2 2 2 2 2 2 2 2 2 2 ...
##  $ descricao_ocupacao                   : Factor w/ 156 levels "ADMINISTRADOR",..: 76 97 75 39 39 127 39 2 39 123 ...
##  $ descricao_cor_raca                   : Factor w/ 5 levels "AMARELA","BRANCA",..: 2 4 2 2 2 2 4 5 2 2 ...
##  $ quantidade_doacoes                   : int  89 13 78 22 159 27 14 193 30 60 ...
##  $ quantidade_doadores                  : int  30 13 16 11 141 16 11 55 8 49 ...
##  $ total_receita                        : num  1107580 89464 1956049 1326149 1795660 ...
##  $ media_receita                        : num  12445 6882 25078 60279 11293 ...
##  $ recursos_de_outros_candidatos.comites: num  270445 0 1626024 1500 0 ...
##  $ recursos_de_partidos                 : num  728000 70000 100000 1255149 550000 ...
##  $ recursos_de_pessoas_físicas          : num  40681 15964 15835 27500 189350 ...
##  $ recursos_de_pessoas_juridicas        : num  68454 1500 208890 30000 1044462 ...
##  $ recursos_proprios                    : num  0 2000 5300 12000 11848 ...
##  $ quantidade_despesas                  : int  346 37 2952 354 761 85 288 1783 158 862 ...
##  $ quantidade_fornecedores              : int  117 15 1104 215 263 35 129 874 56 288 ...
##  $ idade                                : int  38 43 58 56 58 49 35 54 62 72 ...
##  $ despesa_max_campanha                 : int  6000000 900000 6000000 3000000 4000000 6000000 5000000 10000000 9000000 3000000 ...
##  $ situacao_final                       : Factor w/ 2 levels "eleito","nao_eleito": 1 1 1 1 1 1 1 1 1 1 ...
normObs <- observations
str(normObs)
## 'data.frame':    8450 obs. of  19 variables:
##  $ UF                                   : Factor w/ 27 levels "AC","AL","AM",..: 26 4 26 2 24 15 16 26 19 16 ...
##  $ partido                              : Factor w/ 32 levels "DEM","PCB","PC do B",..: 1 14 14 15 8 20 18 26 8 8 ...
##  $ sexo                                 : Factor w/ 2 levels "FEMININO","MASCULINO": 2 2 2 2 2 2 2 2 2 2 ...
##  $ descricao_ocupacao                   : Factor w/ 156 levels "ADMINISTRADOR",..: 76 97 75 39 39 127 39 2 39 123 ...
##  $ descricao_cor_raca                   : Factor w/ 5 levels "AMARELA","BRANCA",..: 2 4 2 2 2 2 4 5 2 2 ...
##  $ quantidade_doacoes                   : int  89 13 78 22 159 27 14 193 30 60 ...
##  $ quantidade_doadores                  : int  30 13 16 11 141 16 11 55 8 49 ...
##  $ total_receita                        : num  1107580 89464 1956049 1326149 1795660 ...
##  $ media_receita                        : num  12445 6882 25078 60279 11293 ...
##  $ recursos_de_outros_candidatos.comites: num  270445 0 1626024 1500 0 ...
##  $ recursos_de_partidos                 : num  728000 70000 100000 1255149 550000 ...
##  $ recursos_de_pessoas_físicas          : num  40681 15964 15835 27500 189350 ...
##  $ recursos_de_pessoas_juridicas        : num  68454 1500 208890 30000 1044462 ...
##  $ recursos_proprios                    : num  0 2000 5300 12000 11848 ...
##  $ quantidade_despesas                  : int  346 37 2952 354 761 85 288 1783 158 862 ...
##  $ quantidade_fornecedores              : int  117 15 1104 215 263 35 129 874 56 288 ...
##  $ idade                                : int  38 43 58 56 58 49 35 54 62 72 ...
##  $ despesa_max_campanha                 : int  6000000 900000 6000000 3000000 4000000 6000000 5000000 10000000 9000000 3000000 ...
##  $ situacao_final                       : Factor w/ 2 levels "eleito","nao_eleito": 1 1 1 1 1 1 1 1 1 1 ...
for(i in c(1:5, 19)) {
  normObs[, i] <- as.numeric(normObs[, i]) - 1
}
str(normObs)
## 'data.frame':    8450 obs. of  19 variables:
##  $ UF                                   : num  25 3 25 1 23 14 15 25 18 15 ...
##  $ partido                              : num  0 13 13 14 7 19 17 25 7 7 ...
##  $ sexo                                 : num  1 1 1 1 1 1 1 1 1 1 ...
##  $ descricao_ocupacao                   : num  75 96 74 38 38 126 38 1 38 122 ...
##  $ descricao_cor_raca                   : num  1 3 1 1 1 1 3 4 1 1 ...
##  $ quantidade_doacoes                   : int  89 13 78 22 159 27 14 193 30 60 ...
##  $ quantidade_doadores                  : int  30 13 16 11 141 16 11 55 8 49 ...
##  $ total_receita                        : num  1107580 89464 1956049 1326149 1795660 ...
##  $ media_receita                        : num  12445 6882 25078 60279 11293 ...
##  $ recursos_de_outros_candidatos.comites: num  270445 0 1626024 1500 0 ...
##  $ recursos_de_partidos                 : num  728000 70000 100000 1255149 550000 ...
##  $ recursos_de_pessoas_físicas          : num  40681 15964 15835 27500 189350 ...
##  $ recursos_de_pessoas_juridicas        : num  68454 1500 208890 30000 1044462 ...
##  $ recursos_proprios                    : num  0 2000 5300 12000 11848 ...
##  $ quantidade_despesas                  : int  346 37 2952 354 761 85 288 1783 158 862 ...
##  $ quantidade_fornecedores              : int  117 15 1104 215 263 35 129 874 56 288 ...
##  $ idade                                : int  38 43 58 56 58 49 35 54 62 72 ...
##  $ despesa_max_campanha                 : int  6000000 900000 6000000 3000000 4000000 6000000 5000000 10000000 9000000 3000000 ...
##  $ situacao_final                       : num  0 0 0 0 0 0 0 0 0 0 ...
normObs <- as.matrix(normObs)
dimnames(normObs) <- NULL

normObs[, 6:18] <- normalize(normObs[, 6:18])
summary(normObs)
##        V1              V2              V3               V4        
##  Min.   : 0.00   Min.   : 0.00   Min.   :0.0000   Min.   :  0.00  
##  1st Qu.:10.00   1st Qu.: 9.00   1st Qu.:1.0000   1st Qu.: 38.00  
##  Median :17.00   Median :17.00   Median :1.0000   Median : 50.00  
##  Mean   :15.47   Mean   :16.33   Mean   :0.7969   Mean   : 63.46  
##  3rd Qu.:22.00   3rd Qu.:24.00   3rd Qu.:1.0000   3rd Qu.: 96.00  
##  Max.   :26.00   Max.   :31.00   Max.   :1.0000   Max.   :155.00  
##        V5              V6                  V7           
##  Min.   :0.000   Min.   :1.000e-07   Min.   :3.330e-08  
##  1st Qu.:1.000   1st Qu.:2.200e-06   1st Qu.:1.000e-06  
##  Median :1.000   Median :6.567e-06   Median :3.130e-06  
##  Mean   :1.691   Mean   :1.878e-05   Mean   :1.029e-05  
##  3rd Qu.:3.000   3rd Qu.:1.618e-05   3rd Qu.:8.835e-06  
##  Max.   :4.000   Max.   :2.989e-03   Max.   :2.760e-03  
##        V8                  V9                 V10           
##  Min.   :0.0000001   Min.   :7.000e-08   Min.   :0.0000000  
##  1st Qu.:0.0028302   1st Qu.:3.572e-04   1st Qu.:0.0000000  
##  Median :0.0515482   Median :1.405e-03   Median :0.0008675  
##  Mean   :0.1408865   Mean   :3.531e-03   Mean   :0.0118727  
##  3rd Qu.:0.2467713   3rd Qu.:4.138e-03   3rd Qu.:0.0085131  
##  Max.   :0.7114554   Max.   :1.361e-01   Max.   :0.6788678  
##       V11               V12                 V13           
##  Min.   :0.00000   Min.   :0.0000000   Min.   :0.0000000  
##  1st Qu.:0.00000   1st Qu.:0.0002182   1st Qu.:0.0000000  
##  Median :0.00080   Median :0.0039990   Median :0.0009129  
##  Mean   :0.05569   Mean   :0.0186325   Mean   :0.0411191  
##  3rd Qu.:0.06321   3rd Qu.:0.0194743   3rd Qu.:0.0518521  
##  Max.   :0.56288   Max.   :0.5041876   Max.   :0.5003813  
##       V14                 V15                 V16           
##  Min.   :0.0000000   Min.   :1.000e-07   Min.   :3.330e-08  
##  1st Qu.:0.0000000   1st Qu.:4.098e-06   1st Qu.:2.000e-06  
##  Median :0.0007789   Median :2.975e-05   Median :1.087e-05  
##  Mean   :0.0134054   Mean   :8.511e-05   Mean   :4.060e-05  
##  3rd Qu.:0.0083768   3rd Qu.:1.096e-04   3rd Qu.:4.560e-05  
##  Max.   :0.4840784   Max.   :2.064e-03   Max.   :8.690e-04  
##       V17                 V18              V19        
##  Min.   :1.267e-06   Min.   :0.2446   Min.   :0.0000  
##  1st Qu.:8.167e-06   1st Qu.:0.9544   1st Qu.:0.0000  
##  Median :1.198e-05   Median :0.9981   Median :0.0000  
##  Mean   :3.890e-05   Mean   :0.9575   Mean   :0.4401  
##  3rd Qu.:1.991e-05   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   :7.580e-03   Max.   :1.0000   Max.   :1.0000

Separando os dados de teste e de treino.

# Split the `normalizedIris` data
obs.training <- normObs[c(1:7438), 1:18]
obs.test <- normObs[c(7439:8450), 1:18]

# Split the class attribute
obs.trainingtarget <- normObs[c(1:7438), 19]

for(i in c(1:5)) {
  training <- to_categorical(obs.training[, i])
  test <- to_categorical(obs.test[, i])
  if(dim(training)[2] != dim(test)[2]) {
    # complete dimension
    test <- cbind(test, rep(0, dim(test)[1]))
  }
  obs.training <- cbind(obs.training, training)
  obs.test <- cbind(obs.test, test)
}

obs.training <- obs.training[, -c(1:5)]
obs.test <- obs.test[, -c(1:5)]

str(obs.training)
##  num [1:7438, 1:235] 1.45e-05 1.43e-05 1.20e-05 6.26e-06 3.50e-05 ...
str(obs.test)
##  num [1:1012, 1:235] 7.50e-07 7.50e-07 1.25e-06 1.00e-06 1.33e-06 ...
# One hot encode training target values
obs.trainLabels <- to_categorical(obs.trainingtarget)

# Print out the iris.testLabels to double check the result
summary(obs.trainLabels)
##        V1            V2     
##  Min.   :0.0   Min.   :0.0  
##  1st Qu.:0.0   1st Qu.:0.0  
##  Median :0.5   Median :0.5  
##  Mean   :0.5   Mean   :0.5  
##  3rd Qu.:1.0   3rd Qu.:1.0  
##  Max.   :1.0   Max.   :1.0

Construindo o modelo e treinando com os dados.

# Initialize a sequential model
model <- keras_model_sequential() 

# Add layers to the model
model %>% 
    layer_dense(units = 200, activation = 'relu', input_shape = c(235)) %>% 
    layer_dense(units = 50, activation = 'relu') %>%
    layer_dense(units = 10, activation = 'relu') %>%
    layer_dense(units = 2, activation = 'softmax')

# Compile the model
model %>% compile(
     loss = 'binary_crossentropy',
     optimizer = 'adam',
     metrics = 'accuracy'
 )

set.seed(1555000000)

# Fit the model 
history <- model %>% fit(
     obs.training, 
     obs.trainLabels, 
     epochs = 75, 
     batch_size = 3, 
     validation_split = 0.25)

plot(history)

Predicao dos dados de teste.

# Predict the classes for the test data
testSamples <- read.csv("~/Documents/AD2/Lab5/test.csv")
output <- subset(testSamples, select=c(ID))
output$prediction <- model %>% predict_classes(obs.test, batch_size = 128)
for(i in c(1:dim(output$prediction))) {
  if(output$prediction[i] == 1) {
    output$prediction[i] <- "nao_eleito"
  } else {
    output$prediction[i] <- "eleito"
  }
}

write.csv(output, file = "output-mlp.csv", row.names = FALSE)

O modelo teve um desempenho de 0.9348 nos dados publicos e no privado teve um desempenho de 0.9268 ficando em 5 lugar no score board final. Ou seja, a acuracia da MLP foi de 92% na predicao de se um deputado vai ser eleito ou nao.