Documento

Nessa continuação iremos usar outro método, muito poderoso e rápido, para a predição das notas e compará-las aos resultados obtidos no artigo anterior.

Caso não tenha visto, Veja aqui!

Usaremos os mesmo banco de dados, com diferentes inputs. Significa que usaremos mais variáveis para o nosso modelo. O XGBoost está entre os algoritmos com maior destaque, pois sua maior simplicidade de calculo e rapidez de processamento o torna popular, não só isso, está entre os melhores, e ganhando inúmeras competições.

Saiba mais aqui

Porém o modelo necessita de alguma particularidades e é em cima disso que iremos trabalhar, se forma simples, pois nosso banco de dados facilita nosso trabalho.

Inicio

definimos o diretório (etapa não obrigatória, pois importaremos o banco de dados de um pacote)

diretorio <- getwd()
setwd(diretorio)

Importaremos os pacotes necessários para realizar nosso modelo:

library(tidyverse)
## -- Attaching packages -------------------------------------------- tidyverse 1.2.1 --
## v ggplot2 2.2.1     v purrr   0.2.4
## v tibble  1.4.1     v dplyr   0.7.4
## v tidyr   0.7.2     v stringr 1.2.0
## v readr   1.1.1     v forcats 0.2.0
## -- Conflicts ----------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(xgboost)
## 
## Attaching package: 'xgboost'
## The following object is masked from 'package:dplyr':
## 
##     slice

De maneira simples e igualmente ao exemplo anterior, importamos o banco de dados do pacote:

prime <- ggplot2movies::movies

Da mesma maneira selecionamos e limpamos os dados.
Note que, ao contrário do exemplo anterior, selecionamos ainda dummy variables referentes ao tipo de filme (drama, ação, comédia, etc)

dados <- ggplot2movies::movies %>% 
  filter(!is.na(budget), budget > 0) %>% 
  select( year, budget, rating, Action, Animation, Comedy, Drama, Documentary, Romance, Short) %>% 
  arrange(desc(year))

Treinamento e teste

Para validação do modelo é necessário saber o quão bom nosso modelo está sendo.
Então faremos a seleção de 75% dos dados para treinamento e 25% para teste.
Definimos train e test.

smp_size <- floor(0.75 * nrow(dados))
train_ind <- sample(seq_len(nrow(dados)), size = smp_size)

train <- dados[train_ind, ]
test <- dados[-train_ind, ]

Definindo a variável x

labels <- train$rating 
ts_label <- test$rating

O XGBoost necessita que os dados estejam em matrix ou no formato proprio xgb.mtx para isso transformamos o nosso data.frame em matrix.

Note que aqui, obrigatoriamente devemos ter dados numéricos. Pode ser um empasse se tiver fatores, comuns em data.frames. Porém podem ser facilmente convertidos em dummy variables. No nosso caso, já possuimos o formato correto, porém pode ser facilmente conseguido atravéz de vários pacotes em R.
Poderíamos ter feito antes e depois ter dividido os dados, nos evitaria gastar algumas linhas de códigos.

new_tr <- model.matrix(~.+0,train[,-3])
new_ts <- model.matrix(~.+0,test[,-3])

dados_matrix <- data.matrix(dados, rownames.force = NA)

Transformando em xgb.mtx

Para melhor desempenho, como recomenda o desenvolvedor. Então faremos isso:

dtrain <- xgb.DMatrix(data = new_tr, label = labels)
dtest <- xgb.DMatrix(data = new_ts, label = ts_label)

Modelo XGBoost Random Forest

Vamo agora criar nosso modelo como reg:linear, eta=0.3, gamma=0, max_depth=6, min_child_weig=1,subsample=1 e colsample_bytree=1
Esses são nossos parametros padrões

params <- list(booster = "gbtree", objective = "reg:linear", 
                 eta=0.3, gamma=0, max_depth=6, min_child_weight=1, 
                 subsample=1, colsample_bytree=1)

XGBoost melhores parametros:

Usando a função nativa do modelo xgb.cv, vamos calcular o melhor numero de rounds nrounds para esse modelo. E mais, essa função também retorna o erro de CV que é uma estimativa do erro do modelo.

Chamamos nossos parametro params, os dados para treinamento no formato xgb dtrain, nround=100, nfold=5 e com early.stop.round=20. Imprimindo a cada 10 rounds.

xgbcv <- xgb.cv( params = params, data = dtrain, 
                 nrounds = 100, nfold = 5, showsd = T, stratified = T, 
                 print_every_n = 10, early_stop_round = 20, maximize = F)
## [1]  train-rmse:4.208212+0.006881    test-rmse:4.213284+0.045450 
## [11] train-rmse:1.214817+0.005037    test-rmse:1.351302+0.018935 
## [21] train-rmse:1.131980+0.012267    test-rmse:1.353012+0.021421 
## [31] train-rmse:1.077095+0.009034    test-rmse:1.362972+0.020514 
## [41] train-rmse:1.030146+0.009939    test-rmse:1.372006+0.021572 
## [51] train-rmse:0.991713+0.009474    test-rmse:1.380108+0.019636 
## [61] train-rmse:0.953274+0.013946    test-rmse:1.389901+0.022987 
## [71] train-rmse:0.919142+0.019412    test-rmse:1.400244+0.024642 
## [81] train-rmse:0.884433+0.019332    test-rmse:1.412106+0.028881 
## [91] train-rmse:0.859247+0.016239    test-rmse:1.420127+0.025833 
## [100]    train-rmse:0.841786+0.018456    test-rmse:1.427388+0.027767

Também avaliamos o RMSE mínimo.

min(xgbcv$evaluation_log$train_rmse_mean)
## [1] 0.8417856

Treinamento

Dos dados resultantes da função de validação cruzada, temos nrounds=90

xgb1 <- xgb.train (params = params, data = dtrain, nrounds = 90, 
                   watchlist = list(val=dtest,train=dtrain), print_every_n = 10,
                   early_stop_round = 10, maximize = F , eval_metric = "error")
## [1]  val-error:-5.166821 train-error:-5.127039 
## [11] val-error:-5.166821 train-error:-5.127039 
## [21] val-error:-5.166821 train-error:-5.127039 
## [31] val-error:-5.166821 train-error:-5.127039 
## [41] val-error:-5.166821 train-error:-5.127039 
## [51] val-error:-5.166821 train-error:-5.127039 
## [61] val-error:-5.166821 train-error:-5.127039 
## [71] val-error:-5.166821 train-error:-5.127039 
## [81] val-error:-5.166821 train-error:-5.127039 
## [90] val-error:-5.166821 train-error:-5.127039

Predição do modelo

De forma simples escrevemos apenas:

xgbpred <- predict(xgb1,dtest)

Analisando o resultado

Calculamos simplesmento o RMSE entre o valor predito e o valor real do filme.

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
xgb1_rmse <- RMSE(test$rating, xgbpred)
xgb1_rmse
## [1] 1.418679

Sendo esse o valor do erro médio quadrátido.

Para ficar bonito, plotamos o grafico que nos diz o grau de importancia das variáveis:

library(caret)
mat <- xgb.importance (feature_names = colnames(new_tr),model = xgb1)
xgb.plot.importance (importance_matrix = mat[1:9], col=3)

Assim vemos que ao adicionar nota a um filme, o fator mais importante é o orçamento, seguido do ano de lançamento. Tiramos a importante informação que se o filme for drama e curtametragem também tem peso significativo para o valor da nota.

É isso. Qualquer dúvida fique a vontade de enviar um e-mail para vinicius.lucena.souza@gmail.com

Referencia

Vinicius Lucena Github Linkedin