Análise Estatística 2
Gabriel Monteiro
TMDB Box Office Prediction
“In a world… where movies made an estimated $41.7 billion in 2018, the film industry is more popular than ever. But what movies make the most money at the box office? How much does a director matter? Or the budget? For some movies, it’s “You had me at ‘Hello.’” For others, the trailer falls short of expectations and you think “What we have here is a failure to communicate.” In this competition, you’re presented with metadata on over 7,000 past films from The Movie Database to try and predict their overall worldwide box office revenue. Data points provided include cast, crew, plot keywords, budget, posters, release dates, languages, production companies, and countries. You can collect other publicly available data to use in your model predictions, but in the spirit of this competition, use only data that would have been available before a movie’s release.”
O objetivo do trabalho é construir um modelo adequado para o conjunto de dados sobre os filmes fornecido na plataforma Kaggle, que consiga prever a receita de cada filme baseado em suas informações. Um conjunto de treinamento foi fornecido com as receitas dos filmes incluidas, e usaremos esse conjunto para construir e validar um modelo que usaremos para prever as receitas dos filmes do conjunto de testes, que não possui o valor das receitas indicado.
Este modelo terá como variável resposta a receita (revenue) dos filmes, e usaremos as outras informações a respeito dos filmes como as variáveis explicativas. Usaremos a plataforma R para a construção do modelo, assim como para a manipulação dos dados. O primeiro passo será carregar os dados com os quais iremos trabalhar e verificar quantos filmes e quais variáveis estão incluidas no banco, como pode ser visto a seguir:
train <- read_csv("train.csv")
attach(train)
names(train)
## [1] "id" "belongs_to_collection"
## [3] "budget" "genres"
## [5] "homepage" "imdb_id"
## [7] "original_language" "original_title"
## [9] "overview" "popularity"
## [11] "poster_path" "production_companies"
## [13] "production_countries" "release_date"
## [15] "runtime" "spoken_languages"
## [17] "status" "tagline"
## [19] "title" "Keywords"
## [21] "cast" "crew"
## [23] "revenue"
nrow(train)
## [1] 3000Observamos acima que o banco possui 3000 observações e 23 variáveis. A partir destas variáveis, iremos selecionar aquelas que nos ajudem a obter informações sobre o valor da receita do filme. A variável imdb_id, por exemplo, não é uma variável que usaremos no modelo, uma vez que ela é apenas uma identificação do filme para um site de crítica, logo possui os 3000 valores distintos.
A seguir iremos filtrar e recategorizar algumas variáveis, pois elas estão apresentadas no banco de dados de uma maneira que seus valores não ficam fáceis de serem lidos pelo R para a construção do modelo e também para agrupar/simplificar algumas informações fornecidas pelos dados.
### VARIAVEL GENEROS ###
generos = c()
for(i in 1:nrow(train)) {
aux = substr(genres[i],1+str_locate(genres[i], pattern = "'name': '")[2],str_locate(genres[i], pattern = "'\\}")[2]-2)
generos[i] = aux
}
generos
unique(generos)
train = cbind(train,generos)
### VARIAVEL PRODUCTION COMPANIES ###
prodcomp = c()
for(i in 1:nrow(train)) {
aux = substr(production_companies[i],1+str_locate(production_companies[i], pattern = "'name': '")[2],str_locate(production_companies[i], pattern = "',")[2]-2)
prodcomp[i] = aux
}
prodcomp
unique(prodcomp) # Mais de 1000 companies
train = cbind(train,prodcomp)
modepc = as.data.frame(table(prodcomp))
modepc = modepc[order(modepc$Freq,decreasing=TRUE),]
modepc[1,1] #Universal Pictures
### VARIAVEL PRODUCTION COUNTRIES ###
prodpais = c()
for(i in 1:nrow(train)) {
aux = substr(production_countries[i],1+str_locate(production_countries[i], pattern = "'iso_3166_1': '")[2],str_locate(production_countries[i], pattern = "',")[2]-2)
prodpais[i] = aux
}
prodpais
unique(prodpais)
train = cbind(train,prodpais)
### VARIAVEL RELEASE DATE ###
datalanc = c()
for(i in 1:nrow(train)) {
aux = substr(release_date[i],nchar(release_date[i])-1,nchar(release_date[i]))
datalanc[i] = aux
}
datalanc
datalanc = as.numeric(datalanc)
for (i in 1:length(datalanc)) {
if(datalanc[i] < 20) {
datalanc[i] = 19 - datalanc[i]
}else{
datalanc[i] = 119 - datalanc[i]
}
}
datalanc
unique(datalanc)
which(datalanc == 95)
train = cbind(train,datalanc)
### VARIAVEL SPOKEN LANGUAGES ###
linguas = c()
for(i in 1:nrow(train)) {
aux = substr(spoken_languages[i],1+str_locate(spoken_languages[i], pattern = "'iso_639_1': '")[2],str_locate(spoken_languages[i], pattern = "',")[2]-2)
linguas[i] = aux
}
linguas
unique(linguas)
train = cbind(train,linguas)
### VARIAVEL HOMEPAGE ###
homepg = c()
for(i in 1:nrow(train)) {
homepg[i] = ifelse(is.na(homepage[i]),0,1)
}
homepg = as.factor(homepg)
train = cbind(train,homepg)
### MES DE LANÇAMENTO ###
meslanc = c()
for(i in 1:nrow(train)) {
aux = substr(release_date[i],1,str_locate(release_date[i],"/")[2]-1)
meslanc[i] = aux
}
meslanc
unique(meslanc)
train = cbind(train,meslanc)
### DIA DA SEMANA DE LANÇAMENTO ###
dialanc = c()
for(i in 1:nrow(train)) {
if(mdy(release_date[i]) > mdy("12/31/2018")) {
d = as.character(mdy(release_date[i]))
d = paste("19",substring(d,3,nchar(d)),sep="")
dialanc[i] = weekdays(ymd(d))
}else{
dialanc[i] = weekdays(mdy(release_date[i]))
}
}
dialanc
unique(dialanc)
train = cbind(train,dialanc)
# As variáveis generos, linguas e prodpais e prodcomp apresentam os seguintes valores com a maior frequência(moda):
generos <- ifelse(generos != "Drama", "Others",generos)
linguas <- ifelse(linguas != "en", "Others",linguas)
prodpais <- ifelse(prodpais != "US", "Others",prodpais)
prodcomp <- ifelse(prodcomp != "Universal Pictures","Others",prodcomp)
#######
is_Drama = generos
is_Drama[is_Drama=="Drama"] = 1
is_Drama[is_Drama=="Others"] = 0
train$is_Drama=is_Drama
is_en = linguas
is_en[is_en=="en"] = 1
is_en[is_en=="Others"] = 0
train$is_en=is_en
is_us = prodpais
is_us[is_us=="US"] = 1
is_us[is_us=="Others"] = 0
train$is_us=is_us
is_UP = prodcomp
is_UP[is_UP=="Universal Pictures"] = 1
is_UP[is_UP=="Others"] = 0
train$is_UP=is_UP
##########
select_var = c("budget","popularity","runtime","revenue","datalanc","homepg","meslanc","dialanc","is_Drama","is_us","is_en","is_UP")
train = train[,select_var]
train = train[complete.cases(train),]
Agora, selecionamos e transformamos as variáveis que farão parte, a princípio, do modelo. Também removemos os filmes que continham informações não preenchidas em relação a essas variáveis. E será com esses dados que trabalharemos na construção do modelo. A seguir, iremos explorar os dados e fazer uma análise com o intuito de verificar se existe algum modelo que pode se adequar aos dados em questão.
attach(train)
## The following objects are masked _by_ .GlobalEnv:
##
## datalanc, dialanc, homepg, is_Drama, is_en, is_UP, is_us,
## meslanc
## The following objects are masked from train (pos = 3):
##
## budget, popularity, revenue, runtime
nrow(train) #Número de filmes na base de dados
## [1] 2823
names(train) #Variáveis utilizadas
## [1] "budget" "popularity" "runtime" "revenue" "datalanc"
## [6] "homepg" "meslanc" "dialanc" "is_Drama" "is_us"
## [11] "is_en" "is_UP"
describe(revenue)
## vars n mean sd median trimmed mad min max
## X1 1 2823 70662563 140830757 19054534 38379818 27472379 1 1519557910
## range skew kurtosis se
## X1 1519557909 4.41 26.19 2650587
hist(revenue)
boxplot(revenue)
shapiro.test(revenue)
##
## Shapiro-Wilk normality test
##
## data: revenue
## W = 0.51584, p-value < 2.2e-16
meslanc_tb = table(meslanc)
dialanc_tb = table(dialanc)
barplot(meslanc_tb[order(as.numeric(names(meslanc_tb)))],xlab="Mês",ylab="Frequência",main="Mês de lançamento dos filmes",col=c(1:12))
barplot(dialanc_tb,ylab="Frequência",main="Dia da semana de lançamento dos filmes",col=c(1:7),las=2)
table(homepg)
## homepg
## 0 1
## 2054 946
table(is_Drama)
## is_Drama
## 0 1
## 2208 785
table(is_en)
## is_en
## 0 1
## 605 2375
table(is_us)
## is_us
## 0 1
## 1127 1818
table(is_UP)
## is_UP
## 0 1
## 2676 167
summary(budget)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0 0 10000000 23825239 30000000 380000000
summary(popularity)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00058 4.67364 7.66656 8.88159 11.10834 294.33704
summary(runtime)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0 95.0 105.0 108.3 118.0 338.0
summary(datalanc)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.00 8.00 15.00 19.29 26.00 98.00
Através da análise dos gráficos acima e das medidas estatísticas calculadas, vemos que a variável revenue não apresenta distribuição aproximadamente normal, o que pode ser bem observado no histograma, onde vemos uma distribuição dos dados muito assimétrica. Sendo assim, iremos aplicar o log na variável revenue. Algumas das variáveis explicativas são dicotômicas, o que sugere o uso de variáveis dummy no modelo.
O primeiro modelo que iremos aplicar é um dos modelos mais simples e conhecidos na Estatística: Regressão Linear Múltipla. Na construção desse modelo, usaremos 80% do nosso conjunto de dados como treinamento e 20% como teste, para validar a previsão realizada feita através do modelo de regressão construído.
train$revenue = log(train$revenue)
hist(train$revenue)
set.seed(555)
smp_size <- floor(0.8 * nrow(train))
train_ind <- sample(seq_len(nrow(train)), size = smp_size)
train_2 = train[train_ind,]
test = train[-train_ind,]
model = lm(revenue~.,data=train_2)
step(model)
## Start: AIC=3990.94
## revenue ~ budget + popularity + runtime + datalanc + homepg +
## meslanc + dialanc + is_Drama + is_us + is_en + is_UP
##
## Df Sum of Sq RSS AIC
## <none> 12910 3990.9
## - is_en 1 38.63 12949 3995.7
## - homepg 1 58.52 12969 3999.2
## - meslanc 11 176.84 13087 3999.7
## - is_Drama 1 85.17 12996 4003.8
## - datalanc 1 87.73 12998 4004.2
## - runtime 1 108.21 13019 4007.8
## - dialanc 6 178.00 13088 4009.9
## - is_us 1 123.12 13034 4010.4
## - is_UP 1 126.77 13037 4011.0
## - popularity 1 217.56 13128 4026.7
## - budget 1 2071.84 14982 4325.0
##
## Call:
## lm(formula = revenue ~ budget + popularity + runtime + datalanc +
## homepg + meslanc + dialanc + is_Drama + is_us + is_en + is_UP,
## data = train_2)
##
## Coefficients:
## (Intercept) budget popularity
## 1.241e+01 2.946e-08 2.641e-02
## runtime datalanc homepg1
## 1.099e-02 1.471e-02 3.842e-01
## meslanc10 meslanc11 meslanc12
## -9.026e-02 5.088e-02 8.140e-01
## meslanc2 meslanc3 meslanc4
## 8.446e-02 2.241e-01 1.408e-01
## meslanc5 meslanc6 meslanc7
## -1.469e-02 2.195e-01 6.465e-01
## meslanc8 meslanc9 dialancquarta-feira
## 3.117e-01 -1.567e-01 4.914e-01
## dialancquinta-feira dialancsábado dialancsegunda-feira
## 5.895e-01 -4.882e-01 2.458e-01
## dialancsexta-feira dialancterça-feira is_Drama1
## 6.528e-01 1.134e-01 -4.653e-01
## is_us1 is_en1 is_UP1
## 5.400e-01 3.668e-01 1.030e+00
summary(model)
##
## Call:
## lm(formula = revenue ~ ., data = train_2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -14.4786 -0.9157 0.4729 1.4826 4.9577
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.241e+01 4.230e-01 29.343 < 2e-16 ***
## budget 2.946e-08 1.557e-09 18.922 < 2e-16 ***
## popularity 2.641e-02 4.308e-03 6.132 1.03e-09 ***
## runtime 1.099e-02 2.541e-03 4.324 1.60e-05 ***
## datalanc 1.471e-02 3.778e-03 3.894 0.000102 ***
## homepg1 3.842e-01 1.208e-01 3.180 0.001492 **
## meslanc10 -9.026e-02 2.538e-01 -0.356 0.722200
## meslanc11 5.088e-02 2.683e-01 0.190 0.849597
## meslanc12 8.140e-01 2.641e-01 3.082 0.002082 **
## meslanc2 8.446e-02 2.769e-01 0.305 0.760333
## meslanc3 2.241e-01 2.647e-01 0.847 0.397239
## meslanc4 1.408e-01 2.666e-01 0.528 0.597481
## meslanc5 -1.469e-02 2.673e-01 -0.055 0.956157
## meslanc6 2.195e-01 2.700e-01 0.813 0.416342
## meslanc7 6.465e-01 2.737e-01 2.363 0.018234 *
## meslanc8 3.117e-01 2.603e-01 1.198 0.231235
## meslanc9 -1.567e-01 2.446e-01 -0.640 0.521942
## dialancquarta-feira 4.914e-01 2.880e-01 1.707 0.088025 .
## dialancquinta-feira 5.895e-01 2.801e-01 2.105 0.035428 *
## dialancsábado -4.882e-01 3.440e-01 -1.419 0.155961
## dialancsegunda-feira 2.458e-01 3.553e-01 0.692 0.489112
## dialancsexta-feira 6.528e-01 2.678e-01 2.437 0.014868 *
## dialancterça-feira 1.134e-01 3.224e-01 0.352 0.725004
## is_Drama1 -4.653e-01 1.213e-01 -3.836 0.000128 ***
## is_us1 5.400e-01 1.171e-01 4.613 4.20e-06 ***
## is_en1 3.668e-01 1.420e-01 2.584 0.009839 **
## is_UP1 1.030e+00 2.200e-01 4.680 3.03e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.406 on 2231 degrees of freedom
## Multiple R-squared: 0.3157, Adjusted R-squared: 0.3077
## F-statistic: 39.58 on 26 and 2231 DF, p-value: < 2.2e-16
plot(model)
model_pred = predict(model,test)
test$predicted = model_pred
summary(test$predicted)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.13 15.26 15.97 16.21 16.93 23.36
summary(test$revenue)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.099 15.400 16.834 16.250 18.095 20.751
Como podemos ver, o modelo sugerido não teve um resultado satisfatório. As suposições do modelo de regressão linear foram violadas: o modelo é heterocedástico e os resíduos não são normalmente distribuídos. Além desses problemas, que invalidam o uso do modelo. A próxima etapa será a de desenvolver um modelo mais complexo e que gere um melhor ajuste dos dados, o modelo trabalhado será o Random Forest, como pode ser visto abaixo.
rf = randomForest(revenue ~ . , data = train_2, mtry=3,importance = TRUE)
rf##
## Call:
## randomForest(formula = revenue ~ ., data = train_2, mtry = 3, importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 4.341984
## % Var explained: 48.03plot(rf)
rf$importance## %IncMSE IncNodePurity
## budget 3.33988252 5027.00476
## popularity 1.72119327 4424.58244
## runtime 0.17484671 1661.97035
## datalanc 0.84381334 1932.58305
## homepg 0.23410269 296.90694
## meslanc 0.14566354 1928.39376
## dialanc 0.05648859 1138.46148
## is_Drama 0.07961595 272.31957
## is_us 0.13321013 329.12059
## is_en 0.05330021 267.11073
## is_UP 0.02465345 92.47838varImpPlot(rf)
predrf = predict(rf,test)
summary(predrf)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 11.03 15.12 16.51 16.30 17.67 20.17library(Metrics)##
## Attaching package: 'Metrics'## The following objects are masked from 'package:caret':
##
## precision, recallrmse(test$revenue,predrf) #Random Forest## [1] 2.20045rmse(test$revenue,test$predicted) #Regressão Linear## [1] 2.483379
O ajuste obtido utilizando RandomForest gerou um resultado melhor que o modelo de Regressão Linear Múltipla. o EQM é uma das métricas que nos ajudam a visualizar essa diferença no ajuste. Porém, para previsões em banco de dados como este que estamos trabalhando, métodos como gradient boosting produzem resultados mais satisfatórios. Por fim iremos construir mais 2 modelos para previsão neste conjunto de dados: Gradient Boosting e Extreme Gradient Boosting e vamos comparar os resultados para selecionar um modelo final.
train_2$budget = as.numeric(train_2$budget)
test$budget = as.numeric(test$budget)
cols = c("is_Drama","is_en","is_us","is_UP")
train_2[cols] <- lapply(train_2[cols], factor)
test[cols] <- lapply(test[cols], factor)
gradient =gbm(revenue ~ . ,data = train_2,distribution = "gaussian",n.trees = 10000,
shrinkage = 0.01, interaction.depth = 2)
gradient## gbm(formula = revenue ~ ., distribution = "gaussian", data = train_2,
## n.trees = 10000, interaction.depth = 2, shrinkage = 0.01)
## A gradient boosted model with gaussian loss function.
## 10000 iterations were performed.
## There were 11 predictors of which 11 had non-zero influence.summary(gradient)
## var rel.inf
## budget budget 30.1670821
## popularity popularity 26.9984688
## meslanc meslanc 17.8922492
## datalanc datalanc 9.5961794
## dialanc dialanc 6.9566302
## runtime runtime 5.5527716
## is_en is_en 0.9295074
## is_us is_us 0.7445286
## homepg homepg 0.5021329
## is_Drama is_Drama 0.4550542
## is_UP is_UP 0.2053955n.trees = seq(from=100 ,to=10000, by=100)
predmatrix = predict(gradient,test,n.trees = n.trees)
dim(predmatrix)## [1] 565 100test.error<-with(test,apply( (predmatrix-test$revenue)^2,2,mean))
plot(n.trees , test.error , pch=19,col="blue",xlab="Number of Trees",ylab="Test Error", main = "Perfomance of Boosting on Test Set")
abline(h = min(test.error),col="red") #Erro minimo através das arvores geradas
min(test.error) #EQM OBTIDO## [1] 4.710506
Agora iremos rodar o Extreme Boosting Gradient:
model <- train(
revenue ~., data = train_2, method = "xgbTree",
trControl = trainControl("cv", number = 10)
)
model$bestTune## nrounds max_depth eta gamma colsample_bytree min_child_weight
## 106 50 3 0.4 0 0.8 1
## subsample
## 106 1model## eXtreme Gradient Boosting
##
## 2258 samples
## 11 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 2033, 2033, 2032, 2033, 2032, 2033, ...
## Resampling results across tuning parameters:
##
## eta max_depth colsample_bytree subsample nrounds RMSE
## 0.3 1 0.6 0.50 50 2.135708
## 0.3 1 0.6 0.50 100 2.134199
## 0.3 1 0.6 0.50 150 2.132537
## 0.3 1 0.6 0.75 50 2.127308
## 0.3 1 0.6 0.75 100 2.121631
## 0.3 1 0.6 0.75 150 2.126155
## 0.3 1 0.6 1.00 50 2.124639
## 0.3 1 0.6 1.00 100 2.113812
## 0.3 1 0.6 1.00 150 2.114298
## 0.3 1 0.8 0.50 50 2.128458
## 0.3 1 0.8 0.50 100 2.119584
## 0.3 1 0.8 0.50 150 2.127833
## 0.3 1 0.8 0.75 50 2.118479
## 0.3 1 0.8 0.75 100 2.115907
## 0.3 1 0.8 0.75 150 2.119562
## 0.3 1 0.8 1.00 50 2.123609
## 0.3 1 0.8 1.00 100 2.114199
## 0.3 1 0.8 1.00 150 2.115347
## 0.3 2 0.6 0.50 50 2.086392
## 0.3 2 0.6 0.50 100 2.089459
## 0.3 2 0.6 0.50 150 2.116332
## 0.3 2 0.6 0.75 50 2.053382
## 0.3 2 0.6 0.75 100 2.049950
## 0.3 2 0.6 0.75 150 2.080468
## 0.3 2 0.6 1.00 50 2.088499
## 0.3 2 0.6 1.00 100 2.076554
## 0.3 2 0.6 1.00 150 2.078453
## 0.3 2 0.8 0.50 50 2.102577
## 0.3 2 0.8 0.50 100 2.119313
## 0.3 2 0.8 0.50 150 2.141201
## 0.3 2 0.8 0.75 50 2.067068
## 0.3 2 0.8 0.75 100 2.093483
## 0.3 2 0.8 0.75 150 2.105354
## 0.3 2 0.8 1.00 50 2.080139
## 0.3 2 0.8 1.00 100 2.072159
## 0.3 2 0.8 1.00 150 2.085904
## 0.3 3 0.6 0.50 50 2.114923
## 0.3 3 0.6 0.50 100 2.170928
## 0.3 3 0.6 0.50 150 2.227976
## 0.3 3 0.6 0.75 50 2.077639
## 0.3 3 0.6 0.75 100 2.098733
## 0.3 3 0.6 0.75 150 2.135842
## 0.3 3 0.6 1.00 50 2.051472
## 0.3 3 0.6 1.00 100 2.067006
## 0.3 3 0.6 1.00 150 2.098016
## 0.3 3 0.8 0.50 50 2.123376
## 0.3 3 0.8 0.50 100 2.159789
## 0.3 3 0.8 0.50 150 2.199735
## 0.3 3 0.8 0.75 50 2.061760
## 0.3 3 0.8 0.75 100 2.105666
## 0.3 3 0.8 0.75 150 2.145536
## 0.3 3 0.8 1.00 50 2.047071
## 0.3 3 0.8 1.00 100 2.048169
## 0.3 3 0.8 1.00 150 2.072030
## 0.4 1 0.6 0.50 50 2.140278
## 0.4 1 0.6 0.50 100 2.142372
## 0.4 1 0.6 0.50 150 2.145911
## 0.4 1 0.6 0.75 50 2.130558
## 0.4 1 0.6 0.75 100 2.122626
## 0.4 1 0.6 0.75 150 2.126641
## 0.4 1 0.6 1.00 50 2.126049
## 0.4 1 0.6 1.00 100 2.120738
## 0.4 1 0.6 1.00 150 2.123499
## 0.4 1 0.8 0.50 50 2.134348
## 0.4 1 0.8 0.50 100 2.143286
## 0.4 1 0.8 0.50 150 2.147857
## 0.4 1 0.8 0.75 50 2.121564
## 0.4 1 0.8 0.75 100 2.117420
## 0.4 1 0.8 0.75 150 2.123158
## 0.4 1 0.8 1.00 50 2.126103
## 0.4 1 0.8 1.00 100 2.119077
## 0.4 1 0.8 1.00 150 2.119976
## 0.4 2 0.6 0.50 50 2.102010
## 0.4 2 0.6 0.50 100 2.135322
## 0.4 2 0.6 0.50 150 2.152640
## 0.4 2 0.6 0.75 50 2.097457
## 0.4 2 0.6 0.75 100 2.114720
## 0.4 2 0.6 0.75 150 2.146980
## 0.4 2 0.6 1.00 50 2.069699
## 0.4 2 0.6 1.00 100 2.059995
## 0.4 2 0.6 1.00 150 2.068351
## 0.4 2 0.8 0.50 50 2.142864
## 0.4 2 0.8 0.50 100 2.149480
## 0.4 2 0.8 0.50 150 2.167803
## 0.4 2 0.8 0.75 50 2.097038
## 0.4 2 0.8 0.75 100 2.102903
## 0.4 2 0.8 0.75 150 2.115095
## 0.4 2 0.8 1.00 50 2.069134
## 0.4 2 0.8 1.00 100 2.080925
## 0.4 2 0.8 1.00 150 2.097170
## 0.4 3 0.6 0.50 50 2.127731
## 0.4 3 0.6 0.50 100 2.194311
## 0.4 3 0.6 0.50 150 2.243840
## 0.4 3 0.6 0.75 50 2.136343
## 0.4 3 0.6 0.75 100 2.175959
## 0.4 3 0.6 0.75 150 2.206702
## 0.4 3 0.6 1.00 50 2.068139
## 0.4 3 0.6 1.00 100 2.116118
## 0.4 3 0.6 1.00 150 2.142831
## 0.4 3 0.8 0.50 50 2.184114
## 0.4 3 0.8 0.50 100 2.232026
## 0.4 3 0.8 0.50 150 2.311248
## 0.4 3 0.8 0.75 50 2.150620
## 0.4 3 0.8 0.75 100 2.197271
## 0.4 3 0.8 0.75 150 2.238764
## 0.4 3 0.8 1.00 50 2.044353
## 0.4 3 0.8 1.00 100 2.072292
## 0.4 3 0.8 1.00 150 2.103356
## Rsquared MAE
## 0.4545530 1.445798
## 0.4564648 1.449233
## 0.4572496 1.449883
## 0.4597915 1.439996
## 0.4622217 1.442299
## 0.4609773 1.444937
## 0.4606378 1.431585
## 0.4658091 1.426182
## 0.4656016 1.428375
## 0.4589042 1.440428
## 0.4638957 1.439091
## 0.4597608 1.448153
## 0.4638705 1.428711
## 0.4645708 1.429908
## 0.4638659 1.432089
## 0.4615880 1.427621
## 0.4658928 1.425743
## 0.4651921 1.428041
## 0.4808885 1.408753
## 0.4814012 1.421536
## 0.4704444 1.440067
## 0.4960888 1.382649
## 0.4981286 1.384326
## 0.4849789 1.398570
## 0.4786049 1.392483
## 0.4851990 1.387884
## 0.4854458 1.395772
## 0.4733164 1.395645
## 0.4671641 1.422410
## 0.4597741 1.432010
## 0.4894359 1.388603
## 0.4778137 1.399846
## 0.4742000 1.406791
## 0.4827431 1.395010
## 0.4874156 1.397724
## 0.4816432 1.406501
## 0.4680074 1.414113
## 0.4477197 1.445415
## 0.4270781 1.481424
## 0.4870750 1.401020
## 0.4788513 1.415875
## 0.4638763 1.438241
## 0.4977744 1.374637
## 0.4923773 1.390373
## 0.4802493 1.411837
## 0.4663615 1.425940
## 0.4548413 1.455388
## 0.4416307 1.483815
## 0.4934565 1.384901
## 0.4769210 1.421067
## 0.4612989 1.450523
## 0.4993936 1.376810
## 0.4995611 1.377689
## 0.4903675 1.392822
## 0.4528712 1.453887
## 0.4525595 1.461424
## 0.4519374 1.467959
## 0.4579990 1.449253
## 0.4616891 1.447654
## 0.4605223 1.453076
## 0.4600214 1.433417
## 0.4628381 1.432354
## 0.4616053 1.435465
## 0.4558705 1.456752
## 0.4522425 1.466326
## 0.4509905 1.468595
## 0.4621559 1.439210
## 0.4640855 1.435974
## 0.4622564 1.441784
## 0.4597962 1.436183
## 0.4637600 1.431524
## 0.4631708 1.435751
## 0.4744549 1.425679
## 0.4627453 1.447657
## 0.4565259 1.447899
## 0.4755649 1.413986
## 0.4697657 1.426789
## 0.4569459 1.457281
## 0.4882818 1.397217
## 0.4937337 1.394055
## 0.4911047 1.396209
## 0.4571282 1.438623
## 0.4584940 1.457679
## 0.4536331 1.475774
## 0.4765468 1.413100
## 0.4758664 1.414009
## 0.4719231 1.427083
## 0.4890315 1.391478
## 0.4842830 1.403011
## 0.4772540 1.414988
## 0.4688216 1.442596
## 0.4465162 1.481182
## 0.4324079 1.523185
## 0.4600306 1.427067
## 0.4474749 1.463336
## 0.4365471 1.494077
## 0.4902382 1.400037
## 0.4728705 1.434013
## 0.4645544 1.460580
## 0.4449535 1.466976
## 0.4311753 1.503762
## 0.4050572 1.563547
## 0.4552410 1.434759
## 0.4404553 1.464213
## 0.4288417 1.506267
## 0.5021597 1.376100
## 0.4924971 1.395456
## 0.4812557 1.421995
##
## Tuning parameter 'gamma' was held constant at a value of 0
##
## Tuning parameter 'min_child_weight' was held constant at a value of 1
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were nrounds = 50, max_depth = 3,
## eta = 0.4, gamma = 0, colsample_bytree = 0.8, min_child_weight = 1
## and subsample = 1.predictions <- model %>% predict(test)
rmse(predictions, test$revenue)## [1] 2.179394Conclusão:
Por fim, após aplicar 4 modelos para realizar as previsões desejadas pelo problema proposto no Kaggle, concluimos que o Extreme Gradient Boosting gerou o melhor resultado, retornando um EQM de 2.179394.