SOBRE:

Este trabalho utiliza de dados fictícios, porém baseados em problemas reais vivenciados por mim em projetos de ciências de dados.

Qualquer provável semelhança com nomes de empresas, marcas e etc é mera coincidência.

INTRODUÇÃO:

A Empresa XYZ realiza mensalmente leilões de veículos usados para outras empresas, em sua maioria, empresas do segmento de prestação de serviços, como fretes e etc. De janeiro a Maio de 2020, a empresa XYZ teve suas atividades pausadas e há previsão de retomada a partir de junho de 2020. A empresa possui apenas 3 modelos de veículos que são ofertados em leilão.

Os modelos possuem diferentes classes, Kilometragem, ano de lançamento, cores e faixas de preços diferentes, assim como as empresas participantes do leilão possuem diferentes características.

O objetivo deste projeto é prever a quantidade de veículos e o faturamento nos leilões que se realizarão nos próximos meses com base em dados históricos (janeiro 2018 a Dezembro 2019) dos leilões já realizados pela XYZ.

Simularemos desde o acesso ao banco de dados via linguagem R, desde todo o processo de ‘Data Munging’, ‘Feature Selection’, ‘Data Viz’ e construção de um modelo de Machine Learning de regressão linear múltipla.

Pacotes:

Modelos:

Coleta dos dados:

Conectaremos a um banco da dados SQL, no caso PostgreSQL para coleta dos datasets. Em seguida, listamos os datasets úteis ao projeto e os atribuíremos à objetos.

pgdrv <- dbDriver(drvName = "PostgreSQL")
db <-DBI::dbConnect(pgdrv,
                    dbname="sandro",
                    host=host, port=port,
                    user = user,
                    password = getPass('password'))
## Please enter password in TK window (Alt+Tab)
listadb <- dbListTables(db)
listadb
## [1] "dim_vendedor"  "dim_clientes"  "dim_uf"        "f_venda"      
## [5] "clientes"      "dados_ans_vig" "df"            "previsao"
dim_clientes <- dbReadTable(db, "dim_clientes")
dim_uf <- dbReadTable(db, "dim_uf")
dim_vendedor <- dbReadTable(db, "dim_vendedor")
f_venda <- dbReadTable(db, "f_venda")
listadf <- list(dim_clientes,dim_vendedor,dim_uf,f_venda)

Criando função para automatizar o ‘View’ , ‘str’ e o ‘head’:

Automatizando as funções de vizualizações do dataset para facilitar em eventuais consultas.

view_fun <- function(x){
  View(listadf[[x]])
}
glimpse_fun <- function(x){
  glimpse(listadf[[x]])
}

head_fun <- function(x){
  head(listadf[[x]])
}

glimpse_fun(1)
## Rows: 14
## Columns: 8
## $ id_cliente                <int> 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,…
## $ cliente                   <chr> "CCO LTDA COMPANY", "SYNC VILLAGE CORP", "L…
## $ faturamento_estimado_2014 <int> 7741240, 5942685, 5015351, 2637296, 3132436…
## $ faturamento_estimado_2015 <int> 7246309, 1814457, 1355282, 4188749, 1694916…
## $ faturamento_estimado_2016 <int> 5754427, 6730113, 6841532, 4269073, 5037513…
## $ faturamento_estimado_2017 <int> 9232471, 3525284, 3847825, 1376018, 2458134…
## $ faturamento_estimado_2018 <int> 8898687, 1667583, 8579784, 1812443, 6228601…
## $ faturamento_estimado_2019 <int> 4336785, 4253902, 7602919, 8500126, 1675294…
glimpse_fun(2)
## Rows: 6
## Columns: 4
## $ id_vendedor    <int> 22, 23, 24, 25, 26, 27
## $ nome           <chr> "Joao Pereira", "Roberto Carlos", "Silvio Robert", "Am…
## $ idade          <int> 29, 25, 34, 23, 44, 21
## $ turno_trabalho <chr> "manha", "manha", "tarde", "tarde", "noite", "noite"
glimpse_fun(3)
## Rows: 6
## Columns: 3
## $ id_uf <int> 16, 17, 18, 19, 20, 21
## $ uf    <chr> "CE", "BA", "MG", "SP", "RJ", "MA"
## $ pais  <chr> " BR", " BR", " BR", " BR", " BR", " BR"
glimpse_fun(4)
## Rows: 150
## Columns: 11
## $ id_uf        <int> 18, 21, 17, 17, 17, 21, 16, 20, 19, 16, 20, 16, 20, 19, …
## $ id_vendedor  <int> 26, 23, 24, 23, 23, 23, 25, 26, 25, 22, 22, 27, 26, 26, …
## $ id_cliente   <int> 42, 50, 49, 53, 44, 52, 51, 43, 41, 40, 51, 45, 51, 40, …
## $ ano          <int> 2012, 2011, 2010, 2010, 2009, 2011, 2010, 2009, 2010, 20…
## $ modelo       <chr> "SUPER GTO", "SUPER GTO", "SUPER GTO", "SUPER GTO", "SUP…
## $ preco        <int> 17500, 15899, 15499, 15499, 14995, 14989, 14495, 13999, …
## $ kilometragem <int> 8367, 36685, 7784, 35636, 34419, 23967, 38275, 23785, 15…
## $ cor          <chr> "Branco", "Prata", "Preto", "Preto", "Preto", "Branco", …
## $ transmissao  <chr> "AUTO", "AUTO", "AUTO", "AUTO", "MANUAL", "AUTO", "AUTO"…
## $ mes_venda    <int> 6, 5, 10, 3, 8, 1, 9, 4, 8, 2, 4, 4, 6, 12, 11, 3, 12, 9…
## $ ano_venda    <int> 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 20…

Construindo o JOIN entre datasets:

Após listar e observar os datasets carregados anteriormente, utilizaremos os datasets: f_venda, dim_uf, dim_vendedor e dim_clientes, em seguida, com a utilização do pacote ‘dplyr’, construíremos um novo dataset através do módulo de Join. Esse processo facilitará em nosso processo de ‘Feature selection’ para variáveis que serão utilizadas futuramente para construção do modelo.

df <- f_venda %>%
  left_join(dim_uf, by = "id_uf") %>%
  left_join(dim_vendedor, by = "id_vendedor") %>%
  left_join(dim_clientes, by = "id_cliente")
glimpse(df)
## Rows: 150
## Columns: 23
## $ id_uf                     <int> 18, 21, 17, 17, 17, 21, 16, 20, 19, 16, 20,…
## $ id_vendedor               <int> 26, 23, 24, 23, 23, 23, 25, 26, 25, 22, 22,…
## $ id_cliente                <int> 42, 50, 49, 53, 44, 52, 51, 43, 41, 40, 51,…
## $ ano                       <int> 2012, 2011, 2010, 2010, 2009, 2011, 2010, 2…
## $ modelo                    <chr> "SUPER GTO", "SUPER GTO", "SUPER GTO", "SUP…
## $ preco                     <int> 17500, 15899, 15499, 15499, 14995, 14989, 1…
## $ kilometragem              <int> 8367, 36685, 7784, 35636, 34419, 23967, 382…
## $ cor                       <chr> "Branco", "Prata", "Preto", "Preto", "Preto…
## $ transmissao               <chr> "AUTO", "AUTO", "AUTO", "AUTO", "MANUAL", "…
## $ mes_venda                 <int> 6, 5, 10, 3, 8, 1, 9, 4, 8, 2, 4, 4, 6, 12,…
## $ ano_venda                 <int> 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2…
## $ uf                        <chr> "MG", "MA", "BA", "BA", "BA", "MA", "CE", "…
## $ pais                      <chr> " BR", " BR", " BR", " BR", " BR", " BR", "…
## $ nome                      <chr> "Rodrigo Adamastor", "Roberto Carlos", "Sil…
## $ idade                     <int> 44, 25, 34, 25, 25, 25, 23, 44, 23, 29, 29,…
## $ turno_trabalho            <chr> "noite", "manha", "tarde", "manha", "manha"…
## $ cliente                   <chr> "LOGISTIC SUPER INC", "SINTOERG LOGISTIC", …
## $ faturamento_estimado_2014 <int> 5015351, 5205895, 9979746, 7689734, 3132436…
## $ faturamento_estimado_2015 <int> 1355282, 7875413, 1258779, 5089985, 1694916…
## $ faturamento_estimado_2016 <int> 6841532, 9315576, 9261162, 3524847, 5037513…
## $ faturamento_estimado_2017 <int> 3847825, 3212903, 4267979, 4236201, 2458134…
## $ faturamento_estimado_2018 <int> 8579784, 7567542, 6054916, 7995266, 6228601…
## $ faturamento_estimado_2019 <int> 7602919, 7887539, 7666077, 6857580, 1675294…

Gather de colunas:

Aqui faremos o gather das colunas de faturamento que possuem relacionamento ambíguo.

df2 <- df %>%
  gather(variable, value, faturamento_estimado_2014:faturamento_estimado_2019)
df = df2
str(df)
## 'data.frame':    900 obs. of  19 variables:
##  $ id_uf         : int  18 21 17 17 17 21 16 20 19 16 ...
##  $ id_vendedor   : int  26 23 24 23 23 23 25 26 25 22 ...
##  $ id_cliente    : int  42 50 49 53 44 52 51 43 41 40 ...
##  $ ano           : int  2012 2011 2010 2010 2009 2011 2010 2009 2010 2010 ...
##  $ modelo        : chr  "SUPER GTO" "SUPER GTO" "SUPER GTO" "SUPER GTO" ...
##  $ preco         : int  17500 15899 15499 15499 14995 14989 14495 13999 13997 13995 ...
##  $ kilometragem  : int  8367 36685 7784 35636 34419 23967 38275 23785 15167 13541 ...
##  $ cor           : chr  "Branco" "Prata" "Preto" "Preto" ...
##  $ transmissao   : chr  "AUTO" "AUTO" "AUTO" "AUTO" ...
##  $ mes_venda     : int  6 5 10 3 8 1 9 4 8 2 ...
##  $ ano_venda     : int  2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
##  $ uf            : chr  "MG" "MA" "BA" "BA" ...
##  $ pais          : chr  " BR" " BR" " BR" " BR" ...
##  $ nome          : chr  "Rodrigo Adamastor" "Roberto Carlos" "Silvio Robert" "Roberto Carlos" ...
##  $ idade         : int  44 25 34 25 25 25 23 44 23 29 ...
##  $ turno_trabalho: chr  "noite" "manha" "tarde" "manha" ...
##  $ cliente       : chr  "LOGISTIC SUPER INC" "SINTOERG LOGISTIC" "LUKE N MACHINES CORP" "OBI-WAN RENT A CAR" ...
##  $ variable      : chr  "faturamento_estimado_2014" "faturamento_estimado_2014" "faturamento_estimado_2014" "faturamento_estimado_2014" ...
##  $ value         : int  5015351 5205895 9979746 7689734 3132436 1463956 9286746 2637296 5942685 7741240 ...

Renomeando variáveis:

Renomearemos as variáveis para adequação.

colnames(df) <- c("id_uf","id_represent",
                  "id_cliente","ano_veiculo",
                  "modelo_veiculo","preco_arrematado",
                  "kmh_veiculo","cor_veiculo",
                  "transmissao_veiculo","mes_venda_veiculo",
                  "ano_venda_veiculo","uf_venda","pais_venda",
                  "representante", "idade_representante",
                  "turno_venda","cliente","ano_fat_cliente","faturamento_cliente")

“loop for” para adequação de variáveis:

Criaremos uma estrutura de loop para substituição de valores dentro da variável ano_fat_cliente.

for (i in 1:length(df$ano_fat_cliente)){
  if (df$ano_fat_cliente[i] == 'faturamento_estimado_2014'){
    df$ano_fat_cliente[i] <- 2014
  } else if (df$ano_fat_cliente[i] == 'faturamento_estimado_2015'){
    df$ano_fat_cliente[i] <- 2015
  } else if(df$ano_fat_cliente[i] == 'faturamento_estimado_2016'){
    df$ano_fat_cliente[i] <- 2016
  } else if(df$ano_fat_cliente[i] == 'faturamento_estimado_2017'){
    df$ano_fat_cliente[i] <- 2017
  } else if(df$ano_fat_cliente[i] == 'faturamento_estimado_2018'){
    df$ano_fat_cliente[i] <- 2018
  } else if(df$ano_fat_cliente[i] == 'faturamento_estimado_2019'){
    df$ano_fat_cliente[i] <- 2019
  }
}
glimpse(df)
## Rows: 900
## Columns: 19
## $ id_uf               <int> 18, 21, 17, 17, 17, 21, 16, 20, 19, 16, 20, 16, 2…
## $ id_represent        <int> 26, 23, 24, 23, 23, 23, 25, 26, 25, 22, 22, 27, 2…
## $ id_cliente          <int> 42, 50, 49, 53, 44, 52, 51, 43, 41, 40, 51, 45, 5…
## $ ano_veiculo         <int> 2012, 2011, 2010, 2010, 2009, 2011, 2010, 2009, 2…
## $ modelo_veiculo      <chr> "SUPER GTO", "SUPER GTO", "SUPER GTO", "SUPER GTO…
## $ preco_arrematado    <int> 17500, 15899, 15499, 15499, 14995, 14989, 14495, …
## $ kmh_veiculo         <int> 8367, 36685, 7784, 35636, 34419, 23967, 38275, 23…
## $ cor_veiculo         <chr> "Branco", "Prata", "Preto", "Preto", "Preto", "Br…
## $ transmissao_veiculo <chr> "AUTO", "AUTO", "AUTO", "AUTO", "MANUAL", "AUTO",…
## $ mes_venda_veiculo   <int> 6, 5, 10, 3, 8, 1, 9, 4, 8, 2, 4, 4, 6, 12, 11, 3…
## $ ano_venda_veiculo   <int> 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2…
## $ uf_venda            <chr> "MG", "MA", "BA", "BA", "BA", "MA", "CE", "RJ", "…
## $ pais_venda          <chr> " BR", " BR", " BR", " BR", " BR", " BR", " BR", …
## $ representante       <chr> "Rodrigo Adamastor", "Roberto Carlos", "Silvio Ro…
## $ idade_representante <int> 44, 25, 34, 25, 25, 25, 23, 44, 23, 29, 29, 21, 4…
## $ turno_venda         <chr> "noite", "manha", "tarde", "manha", "manha", "man…
## $ cliente             <chr> "LOGISTIC SUPER INC", "SINTOERG LOGISTIC", "LUKE …
## $ ano_fat_cliente     <chr> "2014", "2014", "2014", "2014", "2014", "2014", "…
## $ faturamento_cliente <int> 5015351, 5205895, 9979746, 7689734, 3132436, 1463…

Análise Exploratória:

Aqui faremos a análise exploratória para conhecimento dos dados e para construção de insights que poderão vir a ser úteis na construção de nosso modelo preditivo.

Análise de série temportal - unidades vendidas em leilões:

grouped <- df %>%
  count(mes_venda_veiculo,ano_venda_veiculo)
grouped$ano_venda_veiculo <- as.factor(grouped$ano_venda_veiculo)
grafico1 <- ggplot(data = grouped, 
                   aes(x=mes_venda_veiculo,y=n, 
                       group = ano_venda_veiculo, 
                                       color = ano_venda_veiculo)) +
  geom_line(size = 1) +
  geom_point(size = 1.8) +
  scale_x_continuous(breaks = 1:12) +
  ggtitle("1.Análise temporal - Unidades vendidas em leilão") +
  xlab("Mês") +
  ylab("Unidades") +
  theme_light()
print(grafico1 + labs(color="Ano"))

É possível observar, que a empresa teve pico de unidades vendidas em agosto 2019 e seus piores desempenhos foram em fevereiro e dezembro de 2018.

Também vemos valores extremamente estáveis entre os meses de março e junho para ambos os anos.

2.Veiculos vendidos por modelo

grafico2 <- ggplot(df, aes(x = modelo_veiculo, fill = modelo_veiculo)) +
  geom_bar(color = "white") +
  xlab("Modelo do Veículo") +
  ylab("Quantidade vendida") +
  ggtitle("2.Veículos vendidos por modelo")+
  theme(legend.position = "none") +
  theme_light()
print(grafico2 + labs(fill= "Modelo"))

%

## 
##  OXS CLASSIC ROADSTER SEL    SUPER GTO 
##           33           15           52

Aqui notamos uma clara diferença entre o numero de modelos vendidos. O SUPER GTO é de longe o modelo mais vendido dentre os 3, com 52% das vendas realizadas que por sua vez é mais que o triplo que o modelo ROADSTER SEL.

3. Número de veículos vendidos por faixa de preco

grafico3 <- ggplot(data = df, aes(x=preco_arrematado)) +
  geom_histogram(bins = 10, color = "white", fill = "lightblue", alpha = 1)+
  xlab("Preço Arrematado") +
  ylab("Frequência") +
  ggtitle("3.Número de veículos vendidos por faixa de preço") +
  theme_light() + 
  theme(legend.position = "none")
print(grafico3)

61% dos veículos vendidos estão na faixa de preço entre 10.000~15.000.

grafico4 <- ggplot(data =df, aes(x=preco_arrematado, fill = modelo_veiculo)) +
  facet_wrap(~modelo_veiculo) +
  geom_histogram(bins = 10, color= "white") +
  xlab("Preço Arrematado") +
  ylab("Frequência") +
  ggtitle("4.Numero de veículos vendidos por faixa de preço")+
  theme_light()+
  theme(strip.text.x = element_text(color="white", face = "bold")) +
  theme(legend.position = "none")
print(grafico4 + labs(fill = "Modelo"))

O modelo Super GTO tem grande frequência na faixa 11.000~15.000 em comparação aos demais modelos. Vale analisar futuramente se há alguma correlação direta entre os preços dos veículos e as demais variáveis do dataset.

5. Boxplot de veículos por modelo

grafico5 <- ggplot(data = df, aes(x=modelo_veiculo,y=preco_arrematado, fill = modelo_veiculo)) + 
  geom_boxplot(color = "black", alpha = 0.8) +
  ylab("Preço Arrematado") +
  xlab("Modelo do veículo") +
  ggtitle("5.Boxplot - Modelos dos veículos")+
  theme(legend.position = "none") +
  theme_light()
print(grafico5 + labs(fill = "Modelo"))

OXS CLASSIC

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    6200   10815   13742   12694   14699   16995

Desvio padrão:

## [1] 3032.982

ROADSTER SEL

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   10995   14477   15980   16109   17000   21992

Desvio padrão:

## [1] 2429.852

SUPER GTO

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    3800   10836   12995   12202   13995   17500

Desvio padrão:

## [1] 2758.666

É possível identificar a presença de valores outliers para os modelos Roadster e Super GTO. O modelo Roadster Sel é o veículo mais caro e de menor variabilidade em seu preço. Sua mediana é de quase 16.000 e seu valor máximo (desconsiderando outliers) chega a 20.000.

Também é possível perceber que o modelo OXS CLASSIC é o modelo que possui maior variabilidade no preço.

6.Número de veículos vendidos por faixa de kilometragem

grafico3 <- ggplot(data =df, aes(x=kmh_veiculo, fill = modelo_veiculo)) +
  facet_wrap(~modelo_veiculo) +
  geom_histogram(bins = 10, color = "white") +
  xlab("Kilometragem") +
  ylab("Frequência") +
  ggtitle("6.Numero de veículos vendidos por faixa de Kilometragem") +
  theme_light()+
  theme(strip.text.x = element_text(color="white", face = "bold")) +
  theme(legend.position = "none")
print(grafico3 + labs(fill = "Modelo"))

Super GTO é o veículo mais vendido com kilometragem entre 25.000 kmh e 50.000 kmh também é o unico a vender veículos com kilometragem acima de 150.000 Já verificamos no item anterior que o Super GTO é o modelo mais caro, aqui também podemos perceber que, é o modelo que é vendido em menores faixas de kilometragem (possível correlação preco x kmh)

7. Veículos vendidos por cor

grafico7 <- ggplot(df, aes(x = cor_veiculo, fill = modelo_veiculo)) +
  facet_wrap(~modelo_veiculo) +
  facet_wrap(~modelo_veiculo) +
  geom_bar(color = "white") +
  xlab("Cor do veículo") +
  ylab("Quantidade vendida") +
  ggtitle("7.Veículos vendidos por cor") +
  theme_light()+
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  theme(strip.text.x = element_text(color="white", face = "bold")) +
  theme(legend.position = "none")
print(grafico7 + labs(fill = "Modelo"))

As cores dos veículos mais vendidos em todos o modelos são: Vermelho, Preto, e Prata As cores Bege e Gold são as que menos vendem.

8.Matriz de correlação múltipla

colnames(df)
##  [1] "id_uf"               "id_represent"        "id_cliente"         
##  [4] "ano_veiculo"         "modelo_veiculo"      "preco_arrematado"   
##  [7] "kmh_veiculo"         "cor_veiculo"         "transmissao_veiculo"
## [10] "mes_venda_veiculo"   "ano_venda_veiculo"   "uf_venda"           
## [13] "pais_venda"          "representante"       "idade_representante"
## [16] "turno_venda"         "cliente"             "ano_fat_cliente"    
## [19] "faturamento_cliente"
df2 <- df %>%
  select(c(14,17,18,19,5,4,7,8,9,10,11,12,6))
df = df2
str(df)
## 'data.frame':    900 obs. of  13 variables:
##  $ representante      : chr  "Rodrigo Adamastor" "Roberto Carlos" "Silvio Robert" "Roberto Carlos" ...
##  $ cliente            : chr  "LOGISTIC SUPER INC" "SINTOERG LOGISTIC" "LUKE N MACHINES CORP" "OBI-WAN RENT A CAR" ...
##  $ ano_fat_cliente    : chr  "2014" "2014" "2014" "2014" ...
##  $ faturamento_cliente: int  5015351 5205895 9979746 7689734 3132436 1463956 9286746 2637296 5942685 7741240 ...
##  $ modelo_veiculo     : chr  "SUPER GTO" "SUPER GTO" "SUPER GTO" "SUPER GTO" ...
##  $ ano_veiculo        : int  2012 2011 2010 2010 2009 2011 2010 2009 2010 2010 ...
##  $ kmh_veiculo        : int  8367 36685 7784 35636 34419 23967 38275 23785 15167 13541 ...
##  $ cor_veiculo        : chr  "Branco" "Prata" "Preto" "Preto" ...
##  $ transmissao_veiculo: chr  "AUTO" "AUTO" "AUTO" "AUTO" ...
##  $ mes_venda_veiculo  : int  6 5 10 3 8 1 9 4 8 2 ...
##  $ ano_venda_veiculo  : int  2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
##  $ uf_venda           : chr  "MG" "MA" "BA" "BA" ...
##  $ preco_arrematado   : int  17500 15899 15499 15499 14995 14989 14495 13999 13997 13995 ...
num_cols <- sapply(df, is.numeric)
correl <- cor(df[,num_cols])
corrplot(correl, method = "color")

grafico8 <- ggplot(data = df, aes(x = kmh_veiculo, y = preco_arrematado, color = modelo_veiculo)) +
  geom_point(alpha = 1, size = 3.5)+
  xlab("Kilometragem do Veículo") +
  ylab("Preço de Arremate") +
  ggtitle("8.Análise de correlação - Preço de arremate e Kilometragem do veículo")+
  theme_light()
print(grafico8 + labs(color = "Modelo do Veículo", size = "Ano do veículo"))

Confimando nossa suspeita, é possível afirmar que, há forte correlação negativa entre o Preço de arremate dos veículos e sua kilometragem. Também é possível identifcar correlação positiva entre o Preço de arremate e o ano dos veículos.

df$ano_veiculo <- as.factor(df$ano_veiculo)
grafico9 <- ggplot(data = df, aes(x = ano_veiculo, y = preco_arrematado, color = modelo_veiculo)) +
  geom_point(alpha = 1, size = 3.5)+
  xlab("Ano do Veículo") +
  ylab("Preço de Arremate") +
  ggtitle("9.Análise de correlação - Preço de arremate e ano do veículo")+
  theme_light()
print(grafico9 + labs(color = "Modelo do Veículo", size = "Ano do veículo"))

df$ano_veiculo <- as.numeric(df$ano_veiculo)

Construção do modelo de Regressão Linear múltipla

Dados de treino e teste

Em nosso modelo de aprendizagem supervisionada, utilizaremos de 70% dos dados de nosso dataframe para teste, e 30% para treino.

sample <- sample.split(df$ano_veiculo, SplitRatio = 0.70)
t1 <- subset(df, sample == TRUE)
t2 <-  subset(df, sample == FALSE)

Construção do modelo:

No modelo 1, utilizaremos todas as variáveis do dataframe como variáveis preditoras à variável preco_arrematado.

modelo1 = lm(preco_arrematado ~.,data = t1)

No modelo 2, utilizaremos as variáveis kmh_veiculo e ano_veiculo como variáveis preditoras à preco_arrematado.

modelo2 = lm(preco_arrematado ~ kmh_veiculo + ano_veiculo,data = t1)

No modelo 3, acrescentaremos a variável cor_veiculo ao modelo 2.

modelo3 = lm(preco_arrematado ~kmh_veiculo + ano_veiculo + cor_veiculo, data = t1 )

Comparando a perfomance dos modelos:

O R2 do modelo 1 possui 0.86.

summary(modelo1)
## 
## Call:
## lm(formula = preco_arrematado ~ ., data = t1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3256.4  -683.5   -61.3   624.4  3054.1 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    -2.333e+05  2.214e+05  -1.054 0.292509    
## representanteGuilherme Savio    6.743e+01  1.993e+02   0.338 0.735239    
## representanteJoao Pereira       4.956e+01  1.931e+02   0.257 0.797565    
## representanteRoberto Carlos     5.293e+02  1.956e+02   2.706 0.006999 ** 
## representanteRodrigo Adamastor -1.990e+02  1.879e+02  -1.059 0.290040    
## representanteSilvio Robert     -1.399e+02  1.958e+02  -0.715 0.475179    
## clienteCCO LTDA COMPANY        -1.435e+03  4.052e+02  -3.541 0.000431 ***
## clienteDRACO RENT CAR          -1.191e+03  4.006e+02  -2.972 0.003077 ** 
## clienteHERMES N SUDDERLAND      2.052e+02  4.357e+02   0.471 0.637846    
## clienteLOGAN AUTO N LOGISTIC   -1.765e+03  3.971e+02  -4.444 1.05e-05 ***
## clienteLOGISTIC SUPER INC      -1.936e+03  4.609e+02  -4.200 3.09e-05 ***
## clienteLUKE N MACHINES CORP    -5.397e+02  4.300e+02  -1.255 0.209934    
## clienteNEO CARS COMPANY        -1.203e+03  3.770e+02  -3.192 0.001488 ** 
## clienteOBI-WAN RENT A CAR      -6.553e+02  4.392e+02  -1.492 0.136238    
## clienteROBERT AUTO PECAS       -1.506e+03  3.929e+02  -3.834 0.000140 ***
## clienteSINTOERG LOGISTIC       -7.061e+02  4.033e+02  -1.751 0.080532 .  
## clienteSUPER LOGISTIC BRAZIL   -9.932e+02  3.948e+02  -2.516 0.012137 *  
## clienteSYNC VILLAGE CORP       -6.370e+02  3.981e+02  -1.600 0.110093    
## clienteTHOR PECAS E SOLUCOES   -1.982e+03  5.003e+02  -3.962 8.36e-05 ***
## ano_fat_cliente2015            -1.178e+02  1.763e+02  -0.668 0.504224    
## ano_fat_cliente2016            -7.064e+01  1.675e+02  -0.422 0.673447    
## ano_fat_cliente2017            -4.799e+00  1.712e+02  -0.028 0.977653    
## ano_fat_cliente2018            -4.512e+01  1.676e+02  -0.269 0.787887    
## ano_fat_cliente2019            -2.175e+01  1.700e+02  -0.128 0.898273    
## faturamento_cliente             1.169e-05  2.382e-05   0.491 0.623737    
## modelo_veiculoROADSTER SEL      1.239e+03  1.793e+02   6.913 1.25e-11 ***
## modelo_veiculoSUPER GTO        -4.176e+02  1.281e+02  -3.261 0.001174 ** 
## ano_veiculo                     7.394e+02  3.894e+01  18.990  < 2e-16 ***
## kmh_veiculo                    -4.393e-02  3.197e-03 -13.741  < 2e-16 ***
## cor_veiculoBege                 1.765e+03  4.395e+02   4.017 6.67e-05 ***
## cor_veiculoBranco              -8.415e+01  2.345e+02  -0.359 0.719778    
## cor_veiculoCinza                1.552e+01  2.276e+02   0.068 0.945657    
## cor_veiculoGold                -2.128e+03  7.518e+02  -2.830 0.004808 ** 
## cor_veiculoPrata                2.281e+02  2.077e+02   1.098 0.272659    
## cor_veiculoPreto                2.943e+02  2.057e+02   1.431 0.153101    
## cor_veiculoVerde                1.879e+01  3.621e+02   0.052 0.958641    
## cor_veiculoVermelho             6.596e+01  2.139e+02   0.308 0.757926    
## transmissao_veiculoMANUAL      -5.712e+02  1.593e+02  -3.587 0.000363 ***
## mes_venda_veiculo              -3.726e+00  1.759e+01  -0.212 0.832264    
## ano_venda_veiculo               1.198e+02  1.097e+02   1.092 0.275278    
## uf_vendaCE                      7.709e+00  2.021e+02   0.038 0.969579    
## uf_vendaMA                      6.920e+02  1.921e+02   3.602 0.000343 ***
## uf_vendaMG                      2.797e+02  1.988e+02   1.407 0.159920    
## uf_vendaRJ                      1.211e+02  1.782e+02   0.680 0.497064    
## uf_vendaSP                      1.453e+02  1.775e+02   0.819 0.413221    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1207 on 584 degrees of freedom
## Multiple R-squared:  0.8604, Adjusted R-squared:  0.8499 
## F-statistic: 81.83 on 44 and 584 DF,  p-value: < 2.2e-16

O modelo 2 possui R2 de 0.77

summary(modelo2)
## 
## Call:
## lm(formula = preco_arrematado ~ kmh_veiculo + ano_veiculo, data = t1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3500.0  -843.2   -67.1   839.0  5635.6 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  7.412e+03  5.202e+02   14.25   <2e-16 ***
## kmh_veiculo -4.519e-02  3.311e-03  -13.65   <2e-16 ***
## ano_veiculo  7.733e+02  4.085e+01   18.93   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1475 on 626 degrees of freedom
## Multiple R-squared:  0.7764, Adjusted R-squared:  0.7757 
## F-statistic:  1087 on 2 and 626 DF,  p-value: < 2.2e-16

Já o modelo 3 possui R2 de 0.79.

summary(modelo3)
## 
## Call:
## lm(formula = preco_arrematado ~ kmh_veiculo + ano_veiculo + cor_veiculo, 
##     data = t1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3474.3  -857.0     0.0   756.2  4601.5 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          7.200e+03  5.317e+02  13.542  < 2e-16 ***
## kmh_veiculo         -4.654e-02  3.349e-03 -13.897  < 2e-16 ***
## ano_veiculo          7.884e+02  4.076e+01  19.341  < 2e-16 ***
## cor_veiculoBege      1.763e+03  4.588e+02   3.843 0.000134 ***
## cor_veiculoBranco   -3.814e+02  2.422e+02  -1.575 0.115856    
## cor_veiculoCinza     2.409e+02  2.400e+02   1.004 0.315931    
## cor_veiculoGold     -2.259e+03  8.367e+02  -2.700 0.007115 ** 
## cor_veiculoPrata     5.611e+02  2.083e+02   2.694 0.007255 ** 
## cor_veiculoPreto    -2.003e+02  2.068e+02  -0.969 0.333133    
## cor_veiculoVerde    -4.342e+02  3.791e+02  -1.146 0.252441    
## cor_veiculoVermelho  3.244e+02  2.234e+02   1.452 0.147043    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1420 on 618 degrees of freedom
## Multiple R-squared:  0.7956, Adjusted R-squared:  0.7923 
## F-statistic: 240.5 on 10 and 618 DF,  p-value: < 2.2e-16

Ao analisar os três modelos criados, notamos que o modelo 1 é o mais indicado para a predição dos dados. pois possui códigos de significâncias maiores em mais variáveis e R2 maior que os demais modelos, além do que podemos ver nos plots abaixo:

Coleta dos Residuals

Um modelo de regressão linear deve apresentar normalidade dos resíduos, ou seja, a distribuição dos resíduos deve se aproximar de uma distribuição normal. Como podemo ver no gráfico abaixo, os residuos de nosso modelo atendem a essa premissa.

res <- residuals(modelo1)
res <- as.data.frame(res)
grafico10 <- ggplot(data = res, aes(x=res)) +
  geom_histogram(aes(y= ..density..),
                 fill = "grey",color = "black",
                 bins  = 15)+
  ggtitle("10.Residuals") +
  xlab("Residuals") +
  ylab("Frequência") +
  theme_light()+
  stat_function(fun = dnorm, args = list(mean = mean(res$res), sd = sd(res$res)), color = "red", size = 1)
print(grafico10)

grafico11 <- ggplot(data = res, aes(x=res)) +
  geom_histogram(bins = 15, fill = "darkred", color = "white")+
  ggtitle("10.Residuals") +
  xlab("Residuals") +
  ylab("Frequência") +
  theme_light()
print(grafico11)

Analisando mais a fundo o modelo escolhido:

par(mfrow = c(2,2))
plot(modelo1, which = c(1:4), pch = 20)

Gráfico 1: Temos os resíduos em função dos valores estimados. Aqui observamos a independência e a homocedasticidade, se os resíduos se distribuem de maneira razoavelmente aleatória e com mesma amplitude em torno do zero.

Gráfico 2: Podemos avaliar a normalidade dos resíduos. A linha diagonal pontilhada representa a distribuição normal teórica, e os pontos a distribuição dos resíduos observada. Espera-se que não exista grande fuga dos pontos em relação à reta.

Gráfico 3: Pode ser avaliado da mesma maneira que o primeiro, observando a aleatoriedade e amplitude, desta vez dos resíduos padronizados.

Gráfico 4: E o último gráfico permite visualizar as Distâncias de Cook das observações, uma medida de influência que pode indicar a presença de outliers quando possui valor maior do que 1.

Conclusão da Análise:

Embora exista uma pequena tendência na reta a esquerda no gráfico 1(Residuals vs Fitted), e a direita no grafico 3 (Scale-Location) é possível notar a randomização dos resíduos, e sem um padrão significativo ou tendencioso.

Fazendo previsão

Aqui faremos a previsão dos dados de teste O modelo treinado até aqui, irá prever os valores da variável preco_arrematado dos dados de teste. com as variáveis preditoras que incluímos na construção do modelo.

predict1 <- predict(modelo1, t2)
previsto <- round(predict1, digits = 0)
result <- cbind(previsto, t2$preco_arrematado)
indexx <- c(1:271)
colnames(result) <- c("previsto","realizado")
result <- as.data.frame(result)
resultado <- cbind(indexx,result)
resultado_plot <- resultado%>%
  select(indexx, previsto, realizado) %>%
  gather(Type,value,-indexx)

Comparando Previsão do modelo com os dados de teste

Agora vamos comparar os dados previsto pelo nosso modelo de Regressão Linear Múltipla com os dados de teste, afim de termos uma vizualição gráfica quanto ao desempenho do modelo criado em relação aos dados de teste.

grafico8 = ggplot(data = resultado_plot, aes(x = indexx, y = value))+
  geom_line(aes(color = Type), size = 0.5) +
  scale_color_manual(values = c("darkred","black")) +
  ggtitle("8.Valor Previsto x Realizado")+
  xlab("Index") +
  ylab("Preço") +
  theme_light()
print(grafico8)

Gravaçao do novo dataset que utilizamos como dados de treino e teste

Feita a contrução e otimização do modelo, gravaremos o dataset com as modificações

write.csv(df, "/home/sandro/Documents/projetos_DS/projetos_ml/datasets/leilao.csv")
View(df)

Carregando dataset a ser previsto

Aqui carregaremos um novo dataset, onde consta o estoque de veículos da empresa cuja disponibilizará esses veículos para leilão no decorrer do ano de 2020. Aqui incluíremos nossa previsão a partir do que estudamos em nosso modelo.

newdf <- read.csv("/home/sandro/Documents/projetos_DS/projetos_ml/datasets/leilao2.csv")
newdf$X <- NULL

Modificação dos Metados e Gravação do resultado

newdf$representante <- as.character(newdf$representante)
newdf$cliente <- as.character(newdf$cliente)
newdf$ano_fat_cliente <- as.character(newdf$ano_fat_cliente)
newdf$modelo_veiculo <- as.character(newdf$modelo_veiculo)
newdf$ano_veiculo <- as.integer(newdf$ano_veiculo)
newdf$kmh_veiculo <- as.integer(newdf$kmh_veiculo)
newdf$cor_veiculo <- as.character(newdf$cor_veiculo)
newdf$transmissao_veiculo <- as.character(newdf$transmissao_veiculo)
newdf$mes_venda_veiculo <- as.integer(newdf$mes_venda_veiculo)
newdf$ano_venda_veiculo <- as.integer(newdf$ano_venda_veiculo)
newdf$uf_venda <- as.character(newdf$uf_venda)
predict2 <- predict(modelo1, newdata = newdf)
predict2.1 <- round(predict2)
resultado_newdf <- cbind(newdf, predict2.1)
write.csv(resultado_newdf, "/home/sandro/Documents/projetos_DS/projetos_ml/previsao.csv")