LAB06-Deep Learning em R com Keras

tutorial original: https://www.datacamp.com/community/tutorials/keras-r-deep-learning

Carregando os dados

Para esse exemplo iremos usar os dados fornecidos pelo “UCI Machine Learning Repository”, que nesse caso será o conhecido Iris Data Set, para mais detalhes segue o link: http://archive.ics.uci.edu/ml/datasets/Iris.

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

Em seguida iremos checar os dados importados usando alguns comandos.

# Return the first part of `iris`
head(iris)

# Inspect the structure
str(iris)

'data.frame':   150 obs. of  5 variables:
 $ V1: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
 $ V2: num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
 $ V3: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
 $ V4: num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
 $ V5: Factor w/ 3 levels "Iris-setosa",..: 1 1 1 1 1 1 1 1 1 1 ...

# Obtain the dimensions
dim(iris)

[1] 150   5

Explorando os dados

Na imagem a seguir podemos ver os três diferentes tipo de iris usadas nos dados.

Como pudemos notar na função “str()” nosso data frame não possui nomes de colunas que facilitam o entendimento dos dados, no momento temos “V1, V2, V3, V4 e V5”, primeiramente iremos renomear as colunas para algo que faça mais sentido.

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

Agora iremos montar um gráfico com os dados relacionando o tamanho com a largura das pétalas.

plot(iris$Petal.Length, 
     iris$Petal.Width, 
     pch=21, bg=c("red","green3","blue")[unclass(iris$Species)], 
     xlab="Petal Length", 
     ylab="Petal Width")

obs: a função “unclass()” converte o nome das espécies em números (seria semelhante a one hot encoding).

Observando a imagem parece existir uma correlação entre tamanho e largura das pétalas para as diferentes espécies, podemos confirmar essa hipótese e também verificar a correlação entre os outros atributos usando a função “corrplot()” junto de “cor()” para cada atributo.

# Store the overall correlation in `M`
correlacoes <- cor(iris[,1:4])
# Plot the correlation plot with `M`
corrplot(correlacoes, method="circle")

# Overall correlation between `Petal.Length` and `Petal.Width` 
cor(iris$Petal.Length, iris$Petal.Width)

[1] 0.9627571

como podemos observar existe uma grande correlação entre tamanho e largura das pétalas, que em valores numéricos seria de 0.9627571.

Processando os dados

Algumas práticas básicas para usar dados são relacionadas a limpeza e normalização dos dados e como iremos usar os dados em um algorítimo de aprendizagem de máquina também precisamos dividir os dados entre treino e validação.

Primeiro iremos sumarizar o data frame para avaliar os dados.

# Pull up a summary of `iris`
summary(iris)

  Sepal.Length    Sepal.Width     Petal.Length    Petal.Width               Species  
 Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100   Iris-setosa    :50  
 1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300   Iris-versicolor:50  
 Median :5.800   Median :3.000   Median :4.350   Median :1.300   Iris-virginica :50  
 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                       

Aqui um ponto bem importante de observar é que os dados estão bem balanceados, isso irá facilitar o treinamento do nosso algoritmo.

Agora iremos normalizar os dados, para isso iremos usar a função “normalize” do pacote keras, mas primeiro precisamos transformar nosso data frame em uma matriz.

# transforma os dados em valores numéricos (one hot encoding)
iris[,5] <- as.numeric(iris[,5]) -1
# Turn `iris` into a matrix
iris <- as.matrix(iris)
# Set `iris` `dimnames` to `NULL`
dimnames(iris) <- NULL

Em seguida podemos normalizar os dados.

# Normalize the `iris` data
iris[,1:4] <- normalize(iris[,1:4])

Em seguida podemos olhar como ficou nossa matriz de dados normalizados, observe que agora cada valor varia entre 0 e 1.

# Return the summary of `iris`
summary(iris)

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

Agora que possuirmos um conjunto de dados de qualidade, nós podemos dividir os dados em treino e validação, para que possamos construir nosso modelo, mas antes disso iremos definir uma “seed” usando a função “set.seed()”, para possamos ter uma “aleatoriedade determinística”, assim o nosso código fica mais reproduzível.

Iremos usar a função “sample()” para gerar um array com valores 1 ou 2 com probabilidade de 67% e 33% respectivamente, em seguida os valores que possuem 1 serão a matriz de test e os demais serão a matriz de validação

# Determine sample size
ind <- sample(2, nrow(iris), replace=TRUE, prob=c(0.67, 0.33))
# Split the `iris` data
iris.training <- iris[ind==1, 1:4]
iris.validation <- iris[ind==2, 1:4]
# Split the class attribute
iris.trainingtarget <- iris[ind==1, 5]
iris.validationtarget <- iris[ind==2, 5]

O último passo na manipulação dos dados é aplicar One Hot Encoding (OHE) em nosso atributo alvo “Species”, em um modelo de classificação multi-classe como esse, é recomendado que o vetor resposta “Species” seja uma matriz com um vetor para cada classe e nesses vetores apenas 1 ou 0 simbolizando se o exemplo é de determinada classe ou não.

Keras traz a função built-in “to_categorical()” que aplica one hot encoding em uma variável, então iremos passar o vetor alvo da nossa matriz de treino e validação para essa função.

# One hot encode training target values
iris.trainLabels <- to_categorical(iris.trainingtarget)
# One hot encode test target values
iris.validationLabels <- to_categorical(iris.validationtarget)
# Print out the iris.testLabels head to double check the result
head(iris.validationLabels)

     [,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

Como podemos ver no lugar de apenas um vetor com valores de 1 a 3 agora temos 3 vetores com valores 1 ou 0, e como foi dito cada um dos vetores corresponde a uma das classes possíveis do nossos dados (setosa, versicolor e virginica).

Construindo o modelo

Antes de construir o modelo é bom revisitar o propósito inicial do exercício, que é prever qual a espécie de Iris dados determinados dados, e nesse caso seria o nosso vetor “Species” que foi transformado em um “One hot Encoding”, assim nosso resultado final será um desses três vetores com valor 1 e os outros 2 com valor 0.

Para montar o modelo iremos usar a função “keras_model_sequential()”, isso significa que iremos construir um modelo de forma sequencial, ou seja cada camada é adicionada uma após a outra de forma sequencial, isso ficará mais claro com o código.

O tipo de rede que iremos usar é a “MLP” ou “Multi-layer perceptron”, que nada mais é que um conjunto de camadas totalmente conectadas também conhecidas como densas, isso significa que a saída de cada neurônio de uma camada é usada como entrada para todos os neurônios da próxima camada.

Para as funções de ativação das camadas intermediárias ou escondidas, iremos usar a mais comum que seria “Relu”, essa escolha está relacionada ao problema de “exploding e vanishing gradients” que irá refletir na eficiência de treinamento do nosso modelo, e como se trata de uma classificação nossa última função de ativação ou output do modelo será uma “softmax”, que serve para converter uma probabilidade de cada classe em 0 ou 1.

# 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')

Alguns detalhe sobre o modelo, ele possui input 4 (os 4 atributos dos dados), output 3 (1 para cada tipo de Iris) e 8 nós em sua camada escondida (esse valor é arbitrário).

Agora podemos ver a representação do modelo:

summary(model)

_____________________________________________________________________________________________________________________________________
Layer (type)                                               Output Shape                                          Param #             
=====================================================================================================================================
dense_9 (Dense)                                            (None, 8)                                             40                  
_____________________________________________________________________________________________________________________________________
dense_10 (Dense)                                           (None, 3)                                             27                  
=====================================================================================================================================
Total params: 67
Trainable params: 67
Non-trainable params: 0
_____________________________________________________________________________________________________________________________________

Agora que a arquitetura foi definida é hora de compilar o modelo, para esse exemplo iremos usar “categorical_crossentropy” como nossa função de loss, “adam” como o otimizador e “accuracy” será nossa métrica.

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

Em relação ao otimizador “adam” é importante notar que também podemos tunar outros parâmetros além da taxa de aprendizado, como por exemplo beta1, beta2 e epsilon. Para a métrica acurácia se adéqua melhor ao nosso problema mas temos outras opções como Mean Squared Error (MSE). Nossa função loss “categorical_crossentropy”, seria a função padrão para classificação multi-classe(mais de 2 classes).

Tendo isso definido podemos “encaixar” nossos dados no modelo.

Aqui definimos os parâmetros para o treinamento, primeiro definimos o número de epochs, cada epoch é uma iteração do nosso modelo sobre os dados de treinamento seguidos pela validação dos resultados(foward, backward propagation e update dos pesos), “batch_size” é referente a quantidade dos dados de treinamento que vão ser processados por vez (isso pode melhorar o uso da memória), além de que o modelo vai ser atualizado mais frequentemente(1 vez a cada batch).

Algo muito interessante que podemos fazer é visualizar os gráficos do nosso modelo referentes a função loss e a acurácia, isso com base tanto nos dados de treino quanto nos dados de validação.

# Plot the model loss of the training data
plot(history$metrics$loss, main="Model Loss", xlab = "epoch", ylab="loss", col="blue", type="l", ylim=c(0,1.5))
# Plot the model loss of the test data
lines(history$metrics$val_loss, col="green")

# Add legend
legend("topright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Plot the accuracy of the training data 
plot(history$metrics$acc, main="Model Accuracy", xlab = "epoch", ylab="accuracy", col="blue", type="l", ylim=c(0,1))
# Plot the accuracy of the validation data
lines(history$metrics$val_acc, col="green")

# Add Legend
legend("bottomright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

Aqui podemos observar o seguinte:

• A função loss tem um comportamento dentro do esperado, ela tende a diminuir conforme o número de epochs aumenta até chegar um ponto onde ela parece estabilizar.
• Para a acurácia o observado também está dentro do esperado, a acurácia tende a aumentar conforme aumentam os epochs até estabilizar em um ponto.
• Obs: Se a acurácia parece estar aumentado nos últimos epoch, é um sinal que modelo ainda não acabou de aprender.
• Obs2: Se a acurácia para o treino está aumentando mas a acurácia para o teste está diminuindo o modelo provavelmente está sofrendo de overfitting.

Agora que nosso modelo foi criado, compilado e treinado, nós podemos usá-lo para prever resultados para nossos dados de teste.

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

Com nossas predições uma forma interessante de visualizar os dados é usando uma matriz de confusão

# Confusion matrix
table(iris.validationtarget, classes)

                     classes
iris.validationtarget  0  1
                    0 13  0
                    1  0 20
                    2  0 14

AVALIAR OS RESULTADOS

Outra forma interessante de avaliar o modelo é usando a função “evaluate()”, para isso basta passar os dados e labels de validação.

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

47/47 [==============================] - 0s 43us/step

# Print the score
print(score)

$loss
[1] 0.4384495

$acc
[1] 0.7021276

Busca por hiperparâmetros é provavelmente onde se gasta mais tempo quando se monta um modelo, mas também é o que diferencia um bom modelo de outro ruim, ou pouco eficiente. Mas isso é algo que depende muito do problema em questão, no nosso caso nossos dados são bem simples, então não é preciso fazer muito.

Dentre as várias possibilidades de ajustes, iremos cobrir três: o número de camadas escondidas, número de nós e o algoritmo de otimização.

Adicionando camadas

Aqui iremos usar a mesma estrutura de modelo mas com uma camada a mais.

# Plot the model loss
plot(history2$metrics$loss, main="Model Loss", xlab = "epoch", ylab="loss", col="blue", type="l", ylim=c(0,1.7))
lines(history2$metrics$val_loss, col="green")

legend("topright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Plot the model accuracy
plot(history2$metrics$acc, main="Model Accuracy", xlab = "epoch", ylab="accuracy", col="blue", type="l", ylim=c(0,1))
lines(history2$metrics$val_acc, col="green")

legend("bottomright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Evaluate the model
score2 <- model2 %>% evaluate(iris.validation, iris.validationLabels, batch_size = 128)

47/47 [==============================] - 0s 64us/step

# Print the score
print(score2)

$loss
[1] 0.2639041

$acc
[1] 0.9148936

Nós escondidos

Agora iremos mais uma vez usar a mesma estrutura inicial mas desa vez iremos adicionar mais nós a camada escondida.

# Plot the model loss
plot(history3$metrics$loss, main="Model Loss", xlab = "epoch", ylab="loss", col="blue", type="l", ylim=c(0,1.5))
lines(history3$metrics$val_loss, col="green")

legend("topright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Plot the model accuracy
plot(history3$metrics$acc, main="Model Accuracy", xlab = "epoch", ylab="accuracy", col="blue", type="l", ylim=c(0,1))
lines(history3$metrics$val_acc, col="green")

legend("bottomright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Evaluate the model
score3 <- model3 %>% evaluate(iris.validation, iris.validationLabels, batch_size = 128)

47/47 [==============================] - 0s 53us/step

# Print the score
print(score3)

$loss
[1] 0.2327757

$acc
[1] 0.9361702

Em relação a topologia da rede (quantidade de camadas e nós), a princípio pode parecer uma boa ideia adicionar mais camadas e nós, para aumentar a complexidade da nossa função e poder capturar mais dados, mas isso vai fazer com que o modelo se ajuste demais aos dados de treinamento e perca a capacidade de capturar também os dados de validação (overfitting). Ou seja além de dificultar o overfitting redes menores também vão ser treinadas mais rápido, por esses motivos de forma geral nós sempre iremos preferir redes mais simples.

Otimizador

Um hiperperâmetro que também podemos ajustar é o otimizador e até mesmo os próprios parâmetros do otimizador a seguir iremos usar o Stochastic Gradient Descent (SGD) como nosso otimizador e também mudar a taxa de aprendizado.

# Plot the model loss
plot(history4$metrics$loss, main="Model Loss", xlab = "epoch", ylab="loss", col="blue", type="l", ylim=c(0,1.6))
lines(history4$metrics$val_loss, col="green")

legend("topright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Plot the model accuracy
plot(history4$metrics$acc, main="Model Accuracy", xlab = "epoch", ylab="accuracy", col="blue", type="l", ylim=c(0,1))
lines(history4$metrics$val_acc, col="green")

legend("bottomright", c("train","test"), col=c("blue", "green"), lty=c(1,1))

# Evaluate the model
score4 <- model4 %>% evaluate(iris.validation, iris.validationLabels, batch_size = 128)

47/47 [==============================] - 0s 53us/step

# Print the loss and accuracy metrics
print(score4)

$loss
[1] 0.4923409

$acc
[1] 0.7021276

Salvar, carregar ou exportar o modelo

Salvar e carregar um modelo é muito importante, principalmente quando se trata de modelos mais complexos e robustos, pode se tornar quase impraticável replicar o treinamento de um modelo em outro ambiente, por exemplo, você não vai querer tentar treinar um modelo em seu computador que levou dias para ser treinado em um super computador, ou até mesmo você pode treinar seu modelo em dias diferentes.

Isso pode ser facilmente feito usando as funções da biblioteca “hdf5”, “save_model_hdf5()” e “load_model_hdf5()”, isso é muito importante quando se usa “transfer learning”, que em resumo seria usar um modelo já treinado e usar seus pesos como base em outro modelo, isso normalmente é feito usando um modelo de propósito geral como base para outro de propósito específico.

save_model_hdf5(model, "my_model.h5")
model <- load_model_hdf5("my_model.h5")

Também é possível salvar os pesos (weights) do modelo.

save_model_weights_hdf5(model, "my_model_weights.h5")
model %>% load_model_weights_hdf5("my_model_weights.h5")

Também é possível exportar o modelo para JSON ou YAML.

json_string <- model_to_json(model)
model <- model_from_json(json_string)
yaml_string <- model_to_yaml(model)
model <- model_from_yaml(yaml_string)

Usando dados das eleições dos deputados de 2014

Para um segundo experimento iremos usar dados reais, mais interessantes e de maior complexidade, que serão os dados referentes a eleição dos deputados de 2014.

Carregando os dados pt2

trainDp <- read.csv("data/train5.csv", encoding="UTF-8")
testDp <- read.csv("data/test5.csv", encoding="UTF-8")

Explorando os dados pt2

Para qualquer conjunto de dados que vai ser submetido para treinar um modelo de predição é importante verificar a distribuição entre as classes.

total = nrow(trainDp)
dist_classes <- trainDp %>% count(situacao_final)
ggplot(dist_classes, aes(y = dist_classes$n/total * 100, x = dist_classes$situacao_final))+
  geom_bar(stat="identity") +
  labs(title = "Distribuição de classes", x = "Situação final", y = "Proporção (%)") +
  theme(axis.text.x = element_text(angle = 0, hjust = 1), legend.position="none") +
  theme(axis.text=element_text(size=8), axis.title=element_text(size=12,face="bold"))

Como podemos observar na imagem, existe um grande desbalanceamento nas classes, mais de 80% dos dados são referentes a candidatos que não foram eleitos, isso faz bastante sentido já que apenas uma quantidade específica foi eleita, e normalmente é bem menor que o total de candidatos, mas para treinar um modelo isso acaba sendo ruim já que a classe dos não eleitos tem uma representação muito maior que a outra, isso pode enviesar o modelo para esses casos, ou seja, o modelo pode representar bem melhor esses dados que possuem mais exemplos (overfitting), e não representar tão bem a outra classe, já que existem poucos exemplos da mesma. Outro problema de dados desbalanceados é que nesse caso se o modelo prever todos os exemplos como “nao_eleitos” ainda sim ele conseguirá algo próximo de 80% de acurácia, e obviamente essa predição foi muito ruim, mas analisando apenas acurácia fica difícil de identificar isso.

Processando os dados pt2

Ao observar os dados podemos ver que os valores nulos são representados por “#NULO” no conjunto de dados, então vamos substituir esses valores por “NA”, assim poderemos avaliar melhor os dados.

# obs o processamento deve ser feito para os dados de treino e teste
trainDp[trainDp == '#NULO'] <- NA
testDp[testDp == '#NULO'] <- NA
# observando a quantidade de valores nulos para cada atributo
sapply(trainDp, function(y) sum(length(which(is.na(y)))))

                                   ID                                  nome                       numero_cadidato 
                                    0                                     0                                     0 
                                   UF                               partido               setor_economico_receita 
                                    0                                     0                                  2140 
                   quantidade_doacoes                   quantidade_doadores                         total_receita 
                                    0                                     0                                     0 
                        media_receita recursos_de_outros_candidatos.comites                  recursos_de_partidos 
                                    0                                     0                                     0 
          recursos_de_pessoas_físicas         recursos_de_pessoas_juridicas                     recursos_proprios 
                                    0                                     0                                     0 
                  quantidade_despesas               quantidade_fornecedores                         total_despesa 
                                    0                                     0                                     0 
                        media_despesa               setor_economico_despesa                                 idade 
                                    0                                  2310                                     0 
                                 sexo                                  grau                          estado_civil 
                                    0                                     0                                     0 
                   descricao_ocupacao                    descricao_cor_raca                  despesa_max_campanha 
                                    0                                     0                                     0 
                       situacao_final 
                                    0 

Com essa informação podemos chegar a algumas conclusões, apenas os atributos “setor_economico_receita” e “setor_economico_despesa” possuem dados nulos, e levando em conta que o nosso total de dados é 4135 podemos concluir que nesses duas camadas a moda seria na verdade os dado nulos, esse tipo de situação dificulta muito substituir esses valores por outros derivados de alguma forma, devido a isso optei por remover esses atributos.

Para submeter os dados para um modelo de deep learning precisamos transformar nossos atributos categóricos em atributos numéricos, para isso usaremos one hot encoding.

# transformando os valores categóricos para o formato one hot
trainDp <- dummy.data.frame(trainDp, names=c('estado_civil'), sep="_")
trainDp <- dummy.data.frame(trainDp, names=c('sexo'), sep="_")
trainDp <- dummy.data.frame(trainDp, names=c('grau'), sep="_")
trainDp <- dummy.data.frame(trainDp, names=c('descricao_cor_raca'), sep="_")
# testar
# to_categorical(trainDp$descricao_cor_raca)
testDp <- dummy.data.frame(testDp, names=c('estado_civil'), sep="_")
testDp <- dummy.data.frame(testDp, names=c('sexo'), sep="_")
testDp <- dummy.data.frame(testDp, names=c('grau'), sep="_")
testDp <- dummy.data.frame(testDp, names=c('descricao_cor_raca'), sep="_")

# removendo atributos não usados (atributos com alto índice de nulos, e atributos com pouca importância: nome, ID, numero_candidato, estado_civil e descricao_ocupacao)
trainDPF <- trainDp %>% select(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, total_despesa, media_despesa, idade, despesa_max_campanha, situacao_final)
testDPF <- testDp %>% select(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, total_despesa, media_despesa, idade, despesa_max_campanha)

Construindo o modelo pt2

inputSize = ncol(trainDPF)
outputSize = length(unique(trainDPF$situacao_final))
# transforma os dados em valores numéricos (one hot encoding)
trainDPF[,inputSize] <- as.numeric(trainDPF[,inputSize]) -1
# Turn into a matrix
trainDPF <- as.matrix(trainDPF)
# Set `dimnames` to `NULL`
dimnames(trainDPF) <- NULL
# Normalize the data
trainDPF[,1:(inputSize-1)] <- normalize(trainDPF[,1:(inputSize-1)])
# Determine sample size
ind2 <- sample(2, nrow(trainDPF), replace=TRUE, prob=c(0.70, 0.30))
# Split the data
dp.training <- trainDPF[ind2==1, 1:(inputSize-1)]
dp.validation <- trainDPF[ind2==2, 1:(inputSize-1)]
# Split the class attribute
dp.trainingtarget <- trainDPF[ind2==1, inputSize]
dp.validationtarget <- trainDPF[ind2==2, inputSize]
# One hot encode training target dp.trainingtarget
dp.trainLabels <- to_categorical(dp.trainingtarget)
# One hot encode test target values
dp.validationLabels <- to_categorical(dp.validationtarget)

Para esse exemplo iremos usar mais camadas pois se trata de um problema mais complexo, também iremos utilizar outra função de loss “binary_crossentropy”, pois se trata de classificação de apenas 2 classes.

# Plot the model loss
plot(historyDP$metrics$loss, main="Model Loss", xlab = "epoch", ylab="loss", col="blue", type="l", ylim=c(0,1))
lines(historyDP$metrics$val_loss, col="green")

legend("topright", c("train"), col=c("blue"), lty=c(1,1))

# Plot the model accuracy
plot(historyDP$metrics$acc, main="Model Accuracy", xlab = "epoch", ylab="accuracy", col="blue", type="l", ylim=c(0,1))
lines(historyDP$metrics$val_acc, col="green")

legend("bottomright", c("train"), col=c("blue"), lty=c(1,1))

# Evaluate the model
scoreDP <- modelDP %>% evaluate(dp.validation, dp.validationLabels, batch_size = 128)

 128/1265 [==>...........................] - ETA: 0s
1265/1265 [==============================] - 0s 30us/step

# Print the loss and accuracy metrics
print("Validação")

[1] "Validação"

print(scoreDP)

$loss
[1] 0.1626936

$acc
[1] 0.9241107

Analisando esses gráficos, o que percebemos é que desde o início o nosso modelo já encontrou o valor bem próximo do ótimo, isso é um pouco estranho pois os dados possuem uma certa complexidade, mas isso também pode ser devido a eficiência dos parâmetros que fizeram com que a função encontrasse um ponto ótimo de forma bem rápida.

inputSizeT = ncol(testDPF)
# transforma os dados em valores numéricos (one hot encoding)
testDPF[,inputSizeT] <- as.numeric(testDPF[,inputSizeT]) -1
# Turn into a matrix
testDPF <- as.matrix(testDPF)
# Set `dimnames` to `NULL`
dimnames(testDPF) <- NULL
# Normalize the data
testDPF[,1:(inputSizeT-1)] <- normalize(testDPF[,1:(inputSizeT-1)])

Como podemos ver nosso modelo na verdade classificou tudo como “nao_eleito” isso pode ter acontecido por conta dos desbalanceamento nos dados de treinamento, mas também pode ser que o modelo não seja eficiente.

Isso enfatiza o ponto de analisar as predições do modelo de uma forma mais criteriosa, e não observar apenas a acurácia final, nesse caso a acurácia na validação foi de 92.41%, que seria muito boa, mas analisando as predições finais podemos ver que provavelmente não se trata de um bom modelo.

totalPred = nrow(submission_predict.df)
dist_classesPred <- data.frame( "situacao_final" = integer(), "n" = integer())
dist_classesPred[nrow(dist_classesPred) + 1, ] <- c( 'eleito', sum(submission_predict.df$preds == 'eleito'))
dist_classesPred[nrow(dist_classesPred) + 1, ] <- c( 'nao_eleito', sum(submission_predict.df$preds == 'nao_eleito'))
dist_classesPred$n <- as.numeric(dist_classesPred$n)
ggplot(dist_classesPred, aes(y = dist_classesPred$n/totalPred * 100, x = dist_classesPred$situacao_final))+
  geom_bar(stat="identity") +
  labs(title = "Distribuição de classes", x = "Situação final", y = "Proporção (%)") +
  theme(axis.text.x = element_text(angle = 0, hjust = 1), legend.position="none") +
  theme(axis.text=element_text(size=8), axis.title=element_text(size=12,face="bold"))

Agora com os dados de treino e as predições nos dados de teste, nós podemos unir os dois conjuntos e usar os dados para realizar análises no que seria o conjunto completo dos dados.

# merge both dataframes to get the "complete data"
dados_totais <- rbind(trainDp, submission)
write.csv(dados_totais, file = "C:/Users/dimit/Desktop/Projetos/AD2/data/dadosTotais.csv", row.names = FALSE)