Duração da Viagem de Táxi em Nova York

3.1 RMSE: Medida de avaliação do modelo.

RMSE significa Root-mean-square deviation (Raiz quadrada do erro-médio), é uma medida frequentemente usada das diferenças entre os valores (amostra ou população) previstos por um modelo ou um estimador e os valores observados. Sua fórmula é dada por:

O RMSE de um estimador \(\hat{\theta}\) com respeito a um parâmetro estimado \(\theta\) é definido como a raiz quadrada do erro quadrático médio :

\[{\displaystyle {\operatorname {RMSE} ({\hat {\theta}}) = {\sqrt {\operatorname {MSE} ({\hat {\theta}})}} = {\sqrt {\operatorname {E} (({\hat {\theta}} - \theta) ^ {2})}}.}} \]

O erro quadrático médio (RMSE) tem sido usado como um parâmetro estatístico padrão para medir o desempenho do modelo em várias ciências.

3.2 Gradient Boosting

Breve revisão da literatura

“Gradient boosting é uma técnica de machine learning para problemas de regressão e classificação, que produz um modelo de previsão na forma de um ensemble.” English Wikipedia.org

“O modelo em si é o que chamamos de ensemble, uma combinação de vários modelos fracos para gerar um modelo poderoso. O modelo fraco utilizado pelo XGBoost é a árvore de decisão.” Serasa Experian, 2017

“Em um problema de regressão, os passos são equivalentes, com a diferença que a métrica que deve ser minimizada em cada divisão não é uma estimativa de impureza, mas tipicamente um erro quadrático médio do ajuste (ou outra métrica mais apropriada para o problema específico).” DataLab serasa experian 2019

“Um classificador ensemble (também chamado de comitê de learners, mistura de especialistas ou sistema de classificadores múltiplo), consiste em um conjunto de classificadores treinados individualmente, classificadores de base, cujas decisões são de alguma forma combinadas.” (Marques et al., 2012).

“A idéia do gradiente boosting originou-se da observação de Leo Breiman de que o boosting pode ser interpretado como um algoritmo de otimização em uma função de custo adequada.” English Wikipedia.org, 2019

“Gradient Boosting Machine é um meta-algoritmo de aprendizado supervisionado que é geralmente utilizado em problemas de classificação e regressão. O principio algorítmico por trás do GBM é a produção de previsões/classificações derivadas de modelos preditivos fracos (Weak Learners), em especial árvores de decisão essas que por sua vez combinadas via ensemble learning para redução de vieses dos algoritmos.” Mineração de Dados, 2018

3.3 Cross Validation: Hold-Out

ver em https://medium.com/data-hackers/crossvalidation-de-maneira-did%C3%A1tica-79c9b080a6ec

3.4 Pacotes e Funções Extras do R

Lista dos pacotes utilizados nesse trabalho.

library('tidyverse')
library('dplyr')
library('lubridate')
library('data.table')
library('ggplot2') 
library('RColorBrewer') 
library('corrplot') 
library('readr') 
library('data.table') 
library('tibble') 
library('tidyr') 
library('stringr') 
library('leaflet') 
library('xgboost') 
library('readr')
library('glm2')
library('grid')
library('yardstick')
library('caret')
library('xgboost')

Função extra: multiplot.

Referência: Multiple graphs on one page

multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  
  numPlots = length(plots)
  
  # If layout is NULL, then use 'cols' to determine layout
  
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }
  
  if (numPlots==1) {
    print(plots[[1]])
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

3.5 Dados

Usou-se a função fread do pacote data.table para acelerar a leitura dos dados originais do Kaggle.

# Dados Originais 

train_full <- fread("~/Trabalho_Analise2/train.csv")

test_full <- fread("~/Trabalho_Analise2/test.csv")

Visão geral da base de dados de treinamento:

glimpse(train_full)

## Observations: 1,458,644
## Variables: 11
## $ id                 <chr> "id2875421", "id2377394", "id3858529", "id350…
## $ vendor_id          <int> 2, 1, 2, 2, 2, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, …
## $ pickup_datetime    <chr> "2016-03-14 17:24:55", "2016-06-12 00:43:35",…
## $ dropoff_datetime   <chr> "2016-03-14 17:32:30", "2016-06-12 00:54:38",…
## $ passenger_count    <int> 1, 1, 1, 1, 1, 6, 4, 1, 1, 1, 1, 4, 2, 1, 1, …
## $ pickup_longitude   <dbl> -73.98215, -73.98042, -73.97903, -74.01004, -…
## $ pickup_latitude    <dbl> 40.76794, 40.73856, 40.76394, 40.71997, 40.79…
## $ dropoff_longitude  <dbl> -73.96463, -73.99948, -74.00533, -74.01227, -…
## $ dropoff_latitude   <dbl> 40.76560, 40.73115, 40.71009, 40.70672, 40.78…
## $ store_and_fwd_flag <chr> "N", "N", "N", "N", "N", "N", "N", "N", "N", …
## $ trip_duration      <int> 455, 663, 2124, 429, 435, 443, 341, 1551, 255…

A base de dados de treinamento tem tamanho 1.458.644 observações e 11 variáveis que serão explanadas na seção 3.5.

Visão geral do conjunto de teste:

# Essa base não possui a variável dropoff_datetime e nem a trip_duration.
glimpse(test_full)

## Observations: 625,134
## Variables: 9
## $ id                 <chr> "id3004672", "id3505355", "id1217141", "id215…
## $ vendor_id          <int> 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 1, 2, 1, 2, 1, …
## $ pickup_datetime    <chr> "2016-06-30 23:59:58", "2016-06-30 23:59:53",…
## $ passenger_count    <int> 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 4, 1, 1, 1, 1, …
## $ pickup_longitude   <dbl> -73.98813, -73.96420, -73.99744, -73.95607, -…
## $ pickup_latitude    <dbl> 40.73203, 40.67999, 40.73758, 40.77190, 40.76…
## $ dropoff_longitude  <dbl> -73.99017, -73.95981, -73.98616, -73.98643, -…
## $ dropoff_latitude   <dbl> 40.75668, 40.65540, 40.72952, 40.73047, 40.75…
## $ store_and_fwd_flag <chr> "N", "N", "N", "N", "N", "N", "N", "N", "N", …

3.6 Variáveis da base de treinamento

• id - um identificador único para cada viagem;
• vendor_id - um código indicando o provedor associado ao registro de viagem;
• pickup_datetime - data e hora em que o medidor foi ativado;
• dropoff_datetime - data e hora em que o medidor foi desativado;
• passenger_count - o número de passageiros no veículo (valor inserido pelo motorista);
• pickup_longitude - a longitude em que o medidor foi engajado;
• pickup_latitude - a latitude em que o medidor foi envolvido;
• dropoff_longitude - a longitude em que o medidor foi desativado;
• dropoff_latitude - a latitude em que o medidor foi desativado;
• store_and_fwd_flag - Este indicador indica se o registro de viagem foi mantido na memória do veículo antes de ser enviado ao fornecedor porque o veículo não tinha uma conexão com o servidor - Y = armazenar e encaminhar; N = não é uma loja e uma viagem para a frente;
• trip_duration - duração da viagem em segundos. (VARIÁVEL DEPENDENTE)

4.1 Variável dependente - trip_duration

A duração média em segundos de uma viagem de táxi em Nova York registrada no banco de dados foi de 959, que equivale a aproximadamente 16 minutos.

A duração máxima foi de 3.526.282 segundos que equivale a aproximadamente 40 dias, alarmando um outlier. A mediana da variável trip_duration foi de 662 segundos (~ 11 minutos).

Medidas descritivas da variável dependente trip_duration:

summary(train_full$trip_duration)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       1     397     662     959    1075 3526282

A distribuição da variável dependente é mostrada no ggplot abaixo. Observa-se nos gráficos que essa variável possui uma distribuição fortemente assimétrica.

g1 <- ggplot(train_full, aes(trip_duration)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) + 
  xlab("trip_duration") +
  ylab("Frequência") + ggtitle("Histograma")

g2 <- ggplot(train_full, aes(y = trip_duration, x =NULL)) +
  geom_boxplot(fill= "#2171b5") + 
   ylab("trip_duration")  + xlab(" ") + ggtitle("Boxplot")

layout <- matrix(c(1,2),1,2,byrow=TRUE)
multiplot(g1, g2, layout=layout)

Pela forte assimetria dos dados, vamos observar sua distribuição abaixo e acima da mediana \(mediana = 662\).

dados_full_abaixo <- train_full %>% filter(trip_duration < 662)

dados_full_acima <- train_full %>% filter(trip_duration >= 662)


t1 <- ggplot(dados_full_abaixo, aes(trip_duration)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) + 
  xlab("trip_duration (< 662)") +
  ylab("Frequência") + ggtitle("Histograma")

t2 <- ggplot(dados_full_acima, aes(trip_duration)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) + 
  xlab("trip_duration (> = 662)") +
  ylab("Frequência") + ggtitle("Histograma")


t3 <- ggplot(dados_full_abaixo, aes(y = trip_duration, x =NULL)) +
  geom_boxplot(fill= "#2171b5") + 
   ylab("trip_duration (< 662)")  + xlab(" ") + ggtitle("Boxplot")

t4 <- ggplot(dados_full_acima, aes(y = trip_duration, x =NULL)) +
  geom_boxplot(fill= "#2171b5") + 
   ylab("trip_duration (> = 662)")  + xlab(" ") + ggtitle("Boxplot")

layout <- matrix(c(1,2),1,2,byrow=TRUE)
multiplot(t1, t3, layout=layout)

layout <- matrix(c(1,2),1,2,byrow=TRUE)
multiplot(t2, t4, layout=layout)

Será utilizado o log da variável dependente para tentar um bom ajuste no modelo:

train_full$trip_duration2 <- log(train_full$trip_duration)
summary(train_full$trip_duration2)  

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   5.984   6.495   6.465   6.980  15.076

g9 <- ggplot(train_full, aes(trip_duration2)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) + 
  xlab("log(trip_duration)") +
  ylab("Frequência") + ggtitle("Histograma")


g7 <- ggplot(train_full, aes(y = trip_duration2, x =NULL)) +
  geom_boxplot(fill= "#2171b5") + 
   ylab("log(trip_duration)")  + xlab(" ") + ggtitle("Boxplot")

layout <- matrix(c(1,2),1,2,byrow=TRUE)
multiplot(g9, g7, layout=layout)

4.2 Vendor_id

Só aceita os valores 1 ou 2, provavelmente para diferenciar duas empresas de táxi.

Frequência do vendor_id:

table(train_full$vendor_id)

## 
##      1      2 
## 678342 780302

ggplot(train_full, aes(x=factor(vendor_id))) + 
  geom_bar(color = "white", fill= "#2171b5" ) + 
  xlab("Vendor Id") + ylab("Frequência") 

4.3 Store_and_fwd_flag

Frequência de Store_and_fwd_flag:

table(train_full$store_and_fwd_flag)

## 
##       N       Y 
## 1450599    8045

ggplot(train_full, aes(x=factor(store_and_fwd_flag))) + 
  geom_bar(color = "white", fill= "#2171b5" ) + 
  xlab("Store and fwd flag") + ylab("Frequência") 

Store_and_fwd_flag foi codificada em: N = 1 e Y = 2.

# N = 1
# Y = 2
train_full = train_full %>% mutate(store_and_fwd_flag = ifelse(.$store_and_fwd_flag == "N", 1,2))

4.4 pickup_datetime & dropoff_datetime

• As variáveis pickup_datetime e dropoff_datetime (no conjunto de treinamento) são combinações de data e hora que teremos que reformatar para uma forma mais útil. Foi usada a função read_delim do pacote readr para formatar a varivável pickup_datetime em uma formas úteis de analisar, utilizando o pacote lubridate.

#abrindo novamente a base de dados para ter as variaveis no formato "datatime"

train_full <- read_delim("train.txt", "\t", escape_double = FALSE, 
                    col_types = cols(dropoff_datetime = col_datetime(format = "%Y-%m-%d %H:%M:%S"), 
                                     pickup_datetime = col_datetime(format = "%Y-%m-%d %H:%M:%S")), 
                    trim_ws = TRUE)
train_full$trip_duration2 <- log(train_full$trip_duration)

Uilizando o pacote lubridate, foram extraídos o dia da semana, hora e o mês da variável pickup_datetime (data, hora e mês em que o medidor foi ativado). Nessa variável podemos analisar o quanto teve de demanda por dia, mês e hora. Não foi analisada dropoff_datetime, pois ela não entrará no modelo que será construído, uma vez que não está na base de teste.

# Tratamento da variável `pickup_datetime`


######pickup_datetime
train_full <- train_full %>% mutate(hr_up_int = hour(train_full$pickup_datetime)) %>%
  mutate(minuto_up_int = (minute(train_full$pickup_datetime))/60) %>%
  mutate(horas_up = hr_up_int + minuto_up_int) %>%
  mutate(dia_up = wday(train_full$pickup_datetime))%>%
  mutate(mes_up = month(train_full$pickup_datetime))

# dia_up
train_full = train_full %>% mutate(dia_up = ifelse(.$dia_up == 1, "Domingo",
                                         ifelse(.$dia_up == 2, "Segunda",
                                                ifelse(.$dia_up == 3, "Terca",
                                                       ifelse(.$dia_up == 4, "Quarta",
                                                              ifelse(.$dia_up == 5, "Quinta",
                                                                     ifelse(.$dia_up == 6, "Sexta",
                                                                          ifelse(.$dia_up == 7, "Sabado", .$dia_up))))))))

# mes_up
train_full = train_full %>% mutate(mes_up = ifelse(.$mes_up == 1, "Jan",
                                         ifelse(.$mes_up == 2, "Fev",
                                                ifelse(.$mes_up == 3, "Mar",
                                                       ifelse(.$mes_up == 4, "Abr",
                                                              ifelse(.$mes_up == 5, "Mai",
                                                                     ifelse(.$mes_up == 6, "Jun",
                                                                            ifelse(.$mes_up == 7, "Jul", .$mes_up))))))))

Análise das novas variáveis que foram extraídas da variável pickup_datetime:

# Variável `pickup_datetime` após extraído o mês
table(train_full$mes_up)

## 
##   Abr   Fev   Jan   Jun   Mai   Mar 
## 25241 23946 22967 23576 24622 25512

dados1 <- train_full %>% 
  dplyr::select(mes_up) %>%
  transmute(Mes = mes_up) %>% 
  group_by(Mes) %>%
  summarise(n = n()) %>%
  mutate(Frequencia = n/sum(n)) %>% 
  arrange(desc(n)) %>%
  mutate(Mes = factor (Mes, levels = Mes))

# grafico 
dados1 %>%
    ggplot(aes(x = reorder(Mes, n), y= n, fill= Mes)) +
    geom_bar(stat = "identity") +
    guides(fill = "none") + #tirou a legenda
    coord_flip() +  #muda a direcao do grafico de barras
    labs(x = "Mês", y = "Frequência", title = "Frequência dos meses de ativação do medidor") +
    geom_label(aes(label = paste(round(100*Frequencia), "%", sep = ""))) + # colocou o rotulo
    scale_fill_brewer(palette = "Blues", direction = -1) 

# Variável `pickup_datetime` após extraído o dia da semana
table(train_full$dia_up)

## 
## Domingo  Quarta  Quinta  Sabado Segunda   Sexta   Terca 
##   19427   21090   21805   22019   18980   22274   20269

dados2 <- train_full %>% 
  dplyr::select(dia_up) %>%
  transmute(Dia = dia_up) %>% 
  group_by(Dia) %>%
  summarise(n = n()) %>%
  mutate(Frequencia = n/sum(n)) %>% 
  arrange(desc(n)) %>%
  mutate(Dia = factor (Dia, levels = Dia))

# grafico 
dados2 %>%
    ggplot(aes(x = reorder(Dia, n), y= n, fill= Dia)) +
    geom_bar(stat = "identity") +
    guides(fill = "none") + #tirou a legenda
    coord_flip() +  #muda a direcao do grafico de barras
    labs(x = "Dia da semana", y = "Frequência", title = "Frequência dos dias de ativação do medidor") +
    geom_label(aes(label = paste(round(100*Frequencia), "%", sep = ""))) + # colocou o rotulo
    scale_fill_brewer(palette = "Blues", direction = -1) 

#Variável `pickup_datetime` após extraído o horário
summary(train_full$horas_up)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    9.55   14.75   14.09   19.45   23.98

u1 <- ggplot(train_full, aes(horas_up)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) +
  xlab("Horários ativação do medidor") +
  ylab("Frequência") + ggtitle("Histograma")

u2 <- ggplot(train_full, aes(y = horas_up, x =NULL)) +
  geom_boxplot( fill= "#2171b5") + 
  ylab("Horários ativação do medidor")  + xlab(" ") + ggtitle("Boxplot")

layout <- matrix(c(2,1),2,1,byrow=TRUE)
multiplot(u1, u2, layout=layout)

ggplot(train_full, aes(x=horas_up)) + 
  geom_density(color = "white", fill= "#2171b5") + 
  xlab("Horários ativação do medidor") + ylab("Densidade")

4.5 Passenger_count

• A variável passenger_count tem mediana de 1 e um máximo de 9.

table(train_full$passenger_count)

## 
##      0      1      2      3      4      5      6      7 
##      7 103136  21141   6058   2835   7797   4889      1

train_full %>%
  group_by(passenger_count) %>%
  count() %>%
  ggplot(., aes(x=reorder(passenger_count, -n), y=n)) +
  geom_bar(stat="identity", color = "white", fill= "#2171b5") + xlab("Número de passageiros") + ylab("Frequência")

4.6 Distancia

• Foi criada a variável da distancia euclidiana a partir das variáveis de latitude e longitude:

distancia <- ((train_full$pickup_latitude - train_full$dropoff_latitude)^2 + 
                (train_full$pickup_longitude - train_full$dropoff_longitude)^2)


train_full <- train_full %>% 
  mutate(distancia = distancia)


summary(train_full$distancia)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  0.00000  0.00016  0.00045  0.00337  0.00148 40.60621

d1 <- ggplot(train_full, aes(distancia)) + 
  geom_histogram (color = "white", fill= "#2171b5", bins = 30) +
  xlab("distancia") +
  ylab("Frequência") + ggtitle("Histograma")

d2 <- ggplot(train_full, aes(y = distancia, x =NULL)) +
  geom_boxplot() + 
    ylab("distancia")  + xlab(" ") + ggtitle("Boxplot")

layout <- matrix(c(2,1),2,1,byrow=TRUE)
multiplot(d1, d2, layout=layout)

4.7 Dados de localização: Longitude e Latitude

• O pickup/dropoff_longitute e pickup/dropoff_latitute descrevem as coordenadas geográficas onde o medidor foi ativado / desativado.

Foi retirada uma amostra equivalente a 10% do tamanho da base para acelerar a análise exploratória por gráficos do pacote leaflet, totalizando 145.864 observações.

train_5perc <- train_full %>% sample_frac(0.05)

Com uso do pacote leaflet foram feitos mapas de pontos para observar as localizações que o taxista ligou e desligou o medidor do táxi nas viagens.

Localizações que o motorista ligou o medidor:

leaflet() %>% addTiles() %>% addCircles(data = train_5perc, 
                                        lng = train_5perc$pickup_longitude, 
                                        lat = train_5perc$pickup_latitude, 
                                        radius = 1)

Localizações que o motorista desligou o medidor:

leaflet() %>% addTiles() %>% addCircles(data = train_5perc, 
                                        lng = train_5perc$dropoff_longitude, 
                                        lat = train_5perc$dropoff_latitude, 
                                        radius = 1)

5.1 Predição por Modelo Linear Generalizado Gamma com Validação Cruzada

O modelo Gamma foi escolhido para esse ajuste, por ser um modelo adequado para variáveis respostas positivas assimétricas. A função densidade de probabilidade é dada por :

\[{\displaystyle f (x; \alpha, \beta) = {\frac {\beta ^ {\alpha} x ^ {\alpha -1} e ^ {- \beta x}} {\Gamma (\alpha)} } \quad {\text {for}} \ \ x> 0 \ \ {\text {e}} \ \ \alpha,\ \beta> 0,} \]

Utilizou-se a variável trip_duration sem a transformação logarítimica e será observado o seu ajuste:

set.seed(7871)

k = 5 #vezes que vou dividir o train
# Cross Validation
train_80$crossvalidation <- sample(1:k, nrow(train_80), replace = TRUE)
predicao = rep(0,nrow(val_20))
for(i in 1:k){
  
  traincv <- train_80 %>% filter(crossvalidation !=i)
  valcv <- train_80 %>% filter(crossvalidation == i)
  
  modelo.gama <- glm2(formula = trip_duration ~ vendor_id + passenger_count +
                        pickup_longitude + pickup_latitude + dropoff_longitude +
                        dropoff_latitude + factor(store_and_fwd_flag) + horas_up +
                        dia_up + mes_up + distancia, family = Gamma(link = "log"),
                      data = train_80)
  
  predicao <- predicao + predict(modelo.gama, val_20, type = "response") 
}

RMSE referente ao mlg Gamma ajustado:

yardstick::rmse_vec(val_20$trip_duration, predicao)

# valid rmse: 10.87768

5.2 Predição por XGBOOST com Validação Cruzada

Nsesse modelo em XGBoost (eXtreme Gradient Boosting), utilizou-se a variável trip_durationcom a tranformação logarítimica afim de ter um modelo melhor que o MLG ajustado anteriormente.

set.seed(30)

train <- read_delim("train.txt", "\t", escape_double = FALSE, 
                    col_types = cols(dropoff_datetime = col_datetime(format = "%Y-%m-%d %H:%M:%S"), 
                                     pickup_datetime = col_datetime(format = "%Y-%m-%d %H:%M:%S")), 
                    trim_ws = TRUE)

train$trip_duration2 <- log(train$trip_duration)

#Tratando as variaveis pickup_datetime  e dropoff_datetime 
# pickup_datetime
train <- train %>% mutate(hr_up_int = hour(train$pickup_datetime)) %>% 
  mutate(minuto_up_int = (minute(train$pickup_datetime))/60) %>% 
  mutate(horas_up = hr_up_int + minuto_up_int) %>% 
  mutate(dia_up = wday(train$pickup_datetime))%>% 
  mutate(mes_up = month(train$pickup_datetime))

# dropoff_datetime
train <- train %>% mutate(hr_off_int = hour(train$dropoff_datetime)) %>% 
  mutate(minuto_off_int = (minute(train$dropoff_datetime))/60) %>% 
  mutate(horas_off = hr_off_int + minuto_off_int) %>% 
  mutate(dia_off = wday(train$dropoff_datetime))%>% 
  mutate(mes_off = month(train$dropoff_datetime))

## Levels: Sun1 < Mon2 < Tues3 < Wed4 < Thurs5 < Fri6 < Sat7

#### criando variavel a partir da distancia euclidiana de lat long

distancia <- ((train$pickup_latitude - train$dropoff_latitude)^2 + 
                (train$pickup_longitude - train$dropoff_longitude)^2)

train <- train %>% 
  mutate(distancia = distancia)

#-------------- store_and_fwd_flag
# N = 1
# Y = 2
train = train %>% mutate(store_and_fwd_flag = ifelse(.$store_and_fwd_flag == "N", 1,2))

####----------------- selecionando as variaveis que vou utilizar
train <- train %>% dplyr::select(vendor_id, passenger_count,
                                 pickup_longitude,pickup_latitude,
                                 dropoff_longitude, dropoff_latitude,
                                 store_and_fwd_flag, trip_duration2,
                                 horas_up, dia_up, mes_up,distancia)

####------- divide-se a base de train em trn = 80% e validacao = 20%

train <- train %>% 
  mutate(flag = sample(0:1, n(), replace = T, prob=c(0.8, 0.2)))


train_80 <- train %>%  filter(flag == 0) %>% dplyr::select(-flag)  #Base de treinamento com 80% da base original


val_20 <- train %>%  filter(flag==1) %>% dplyr::select(-flag) #Base de Validação com 20% da base original

Tem-se como resultado, o RMSE referente ao modelo ajustado:

# RMSE

yardstick::rmse_vec(val_20$trip_duration2, predicao2)

# valid-rmse: 0.429299 

Segue a importanância das variáveis do modelo gradient boosting:

imp_matrix <- as.tibble(xgb.importance(feature_names = colnames(train %>% dplyr::select(-trip_duration2)), model = gb_dt))

imp_matrix %>%
    ggplot(aes(reorder(Feature, Gain, FUN = max), Gain, fill = Feature)) +
    geom_col() +
    coord_flip() +
    theme(legend.position = "none") +
    labs(x = "Variáveis", y = "Importância") +
    ggtitle ("Importância das Variáveis")