Prevendo demanda de estoque - Bimbo
PROBLEMA DE NEGÓCIO
Prevendo demanda de estoque com base em vendas:
O Grupo Bimbo (https:\\www.grupobimbo.com), se esforça para atender a demanda diária dos consumidores por produtos frescos de panificação nas prateleiras de mais de 1 milhão de lojas ao longo das suas 45.000 lojas em todo o México. Atualmente, os cálculos diários de estoque são realizados por funcionários de vendas de entregas diretas, que devem, sozinhos, prever a necessidade de estoque dos produtos e demanda com base em suas experiências pessoais em cada loja. Como alguns pães têm uma vida útil de uma semana, a margem aceitável para o erro é pequena. Neste projeto de aprendizado de máquina, vamos desenvolver um modelo para prever com precisão a demanda de estoque com base nos dados históricos de vendas. Isso fará com que os consumidores dos mais de 100 produtos de panificação não fiquem olhando para as prateleiras vazias, além de reduzir o valor gasto com reembolsos para os proprietários de lojas com produtos excedentes impróprios para venda.
Dataset utilizado: https://www.kaggle.com/c/grupo-bimbo-inventory-demand
LIBRARYS
pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales)DICIONÁRIO DE DADOS
- Semana: Numero da semana (de quinta a quarta-feira)
- AGENCIA_ID: Deposito de vendas ID
- CANAL_ID: Canal de vendas ID
- RUTA_SAK: ID de rota (Várias rotas = Depósito de Vendas)
- CLIENTE_ID: ID do cliente
- NOMBRECLIENTE: Nome do cliente
- PRODUCTOID: ID do produto
- NOMBREPRODUCTO: Nome do produto
- VENTA_UNI_HOY: Unidades de vendas esta semana (integer)
- VENTA_HOY: Vendas esta semana em pesos
- DEV_UNI_PROXIMA: Unidades retornadas na proxima semana (integer)
- DEV_PROXIMA: Retornos na proxima semana em pesos
- DEMANDA_UNI_EQUIL: Demanda ajustada (integer) (This is the target you will predict)
DIRETÓRIO DE TRABALHO
setwd("E:/projetos/prevendo_demanda_de_estoque")CARREGANDO O DATASET
list.files()## [1] "cliente_tabla.csv" "df_cliente.csv"
## [3] "df_produto.csv" "df_town.csv"
## [5] "df_treino.csv" "prevendo_demanda_de_estoque.html"
## [7] "prevendo_demanda_de_estoque.nb.html" "prevendo_demanda_de_estoque.r"
## [9] "prevendo_demanda_de_estoque.Rmd" "producto_tabla.csv"
## [11] "Projeto2.pdf" "sample_submission.csv"
## [13] "test.csv" "testando.csv"
## [15] "teste.csv" "town_state.csv"
## [17] "train.csv" "treino.csv"treino <- fread('train.csv', stringsAsFactors = FALSE, encoding = "UTF-8")PRÉ-VISUALIZANDO OS DADOS CARREGADOS
glimpse(treino)## Rows: 74,180,464
## Columns: 11
## $ Semana <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3...
## $ Agencia_ID <int> 1110, 1110, 1110, 1110, 1110, 1110, 1110, 1110, 1...
## $ Canal_ID <int> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7...
## $ Ruta_SAK <int> 3301, 3301, 3301, 3301, 3301, 3301, 3301, 3301, 3...
## $ Cliente_ID <int> 15766, 15766, 15766, 15766, 15766, 15766, 15766, ...
## $ Producto_ID <int> 1212, 1216, 1238, 1240, 1242, 1250, 1309, 3894, 4...
## $ Venta_uni_hoy <int> 3, 4, 4, 4, 3, 5, 3, 6, 4, 6, 8, 4, 12, 7, 10, 5,...
## $ Venta_hoy <dbl> 25.14, 33.52, 39.32, 33.52, 22.92, 38.20, 20.28, ...
## $ Dev_uni_proxima <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ Dev_proxima <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ Demanda_uni_equil <int> 3, 4, 4, 4, 3, 5, 3, 6, 4, 6, 8, 4, 12, 7, 10, 5,...PRÉ-PROCESSAMENTO DOS DADOS
Ajustando variáveis dos datasets carregados:
Após os ajustes e gravação em cada um dos datasets carregados, vamos fazer o clean de memoria e exclusao dos datasets. Os datasets ajustados serão utilizados para os joins e para o processo de análise exploratória dos dados e também para construção do modelo de machine learning logo mais a frente.
RemoveAcentos <- function(textoComAcentos) {
if(!is.character(textoComAcentos)){
on.exit()
}
letrasComAcentos <- "áéíóúÁÉÍÓÚýÝàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛãõÃÕñÑäëïöüÄËÏÖÜÿçÇ´`^~¨"
letrasSemAcentos <- "aeiouAEIOUyYaeiouAEIOUaeiouAEIOUaoAOnNaeiouAEIOUycC "
textoSemAcentos <- chartr(
old = letrasComAcentos,
new = letrasSemAcentos,
x = textoComAcentos
)
return(textoSemAcentos)
}df_treino <- treino %>%
mutate(SEMANA = Semana,
ID_AGENCIA = Agencia_ID,
ID_CANAL = Canal_ID,
ID_ROTA = Ruta_SAK,
ID_CLIENTE = Cliente_ID,
ID_PRODUTO = Producto_ID,
UNID_VENDAS_SEMANA = Venta_uni_hoy,
VENDAS_SEMANA = Venta_hoy,
DEV_UNID_PROX_SEMANA = Dev_uni_proxima,
DEV_PROX_SEMANA_PESOS = Dev_proxima,
DEMANDA_AJUSTADA = Demanda_uni_equil) %>%
mutate_if(is.character, toupper) %>%
mutate_if(is.character, RemoveAcentos) %>%
mutate_if(is.character,as.factor) %>%
dplyr::select(12:22);glimpse(df_treino)## Rows: 74,180,464
## Columns: 11
## $ SEMANA <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, ...
## $ ID_AGENCIA <int> 1110, 1110, 1110, 1110, 1110, 1110, 1110, 111...
## $ ID_CANAL <int> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ...
## $ ID_ROTA <int> 3301, 3301, 3301, 3301, 3301, 3301, 3301, 330...
## $ ID_CLIENTE <int> 15766, 15766, 15766, 15766, 15766, 15766, 157...
## $ ID_PRODUTO <int> 1212, 1216, 1238, 1240, 1242, 1250, 1309, 389...
## $ UNID_VENDAS_SEMANA <int> 3, 4, 4, 4, 3, 5, 3, 6, 4, 6, 8, 4, 12, 7, 10...
## $ VENDAS_SEMANA <dbl> 25.14, 33.52, 39.32, 33.52, 22.92, 38.20, 20....
## $ DEV_UNID_PROX_SEMANA <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ DEV_PROX_SEMANA_PESOS <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ DEMANDA_AJUSTADA <int> 3, 4, 4, 4, 3, 5, 3, 6, 4, 6, 8, 4, 12, 7, 10...write.csv2(df_treino, "E:/projetos/prevendo_demanda_de_estoque/df_treino.csv", fileEncoding = "UTF-8", row.names = FALSE)
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2494962 133.3 4388708 234.4 4388708 234.4
## Vcells 52684688 402.0 906767408 6918.1 1054432506 8044.7pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales)RemoveAcentos <- function(textoComAcentos) {
if(!is.character(textoComAcentos)){
on.exit()
}
letrasComAcentos <- "áéíóúÁÉÍÓÚýÝàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛãõÃÕñÑäëïöüÄËÏÖÜÿçÇ´`^~¨"
letrasSemAcentos <- "aeiouAEIOUyYaeiouAEIOUaeiouAEIOUaoAOnNaeiouAEIOUycC "
textoSemAcentos <- chartr(
old = letrasComAcentos,
new = letrasSemAcentos,
x = textoComAcentos
)
return(textoSemAcentos)
}produto <- fread('producto_tabla.csv', stringsAsFactors = FALSE, encoding = "UTF-8")
df_produto <- produto %>%
summarize(ID_PRODUTO = Producto_ID,
NOME_PRODUTO = NombreProducto) %>%
mutate_if(is.character, toupper) %>%
mutate_if(is.character, RemoveAcentos) %>%
mutate_if(is.character,as.factor);glimpse(df_produto)## Rows: 2,592
## Columns: 2
## $ ID_PRODUTO <int> 0, 9, 41, 53, 72, 73, 98, 99, 100, 106, 107, 108, 109,...
## $ NOME_PRODUTO <fct> NO IDENTIFICADO 0, CAPUCCINO MOKA 750G NES 9, BIMBOLLO...write.csv2(df_produto, "E:/projetos/prevendo_demanda_de_estoque/df_produto.csv", fileEncoding = "UTF-8", row.names = FALSE)
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2496551 133.4 4388708 234.4 4388708 234.4
## Vcells 52686231 402.0 725413927 5534.5 1054432506 8044.7pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales)# Função para remocao de acentos
RemoveAcentos <- function(textoComAcentos) {
if(!is.character(textoComAcentos)){
on.exit()
}
letrasComAcentos <- "áéíóúÁÉÍÓÚýÝàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛãõÃÕñÑäëïöüÄËÏÖÜÿçÇ´`^~¨"
letrasSemAcentos <- "aeiouAEIOUyYaeiouAEIOUaeiouAEIOUaoAOnNaeiouAEIOUycC "
textoSemAcentos <- chartr(
old = letrasComAcentos,
new = letrasSemAcentos,
x = textoComAcentos
)
return(textoSemAcentos)
}cliente <- fread('cliente_tabla.csv', stringsAsFactors = FALSE, encoding = "UTF-8")
df_cliente <- cliente %>%
summarize(ID_CLIENTE = Cliente_ID,
NOME_CLIENTE = NombreCliente) %>%
mutate_if(is.character, RemoveAcentos) %>%
mutate_if(is.character, toupper) %>%
mutate_if(is.character, as.factor);glimpse(df_cliente)## Rows: 935,362
## Columns: 2
## $ ID_CLIENTE <int> 0, 1, 2, 3, 4, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1...
## $ NOME_CLIENTE <fct> SIN NOMBRE, OXXO XINANTECATL, SIN NOMBRE, EL MORENO, S...write.csv2(df_cliente, "E:/projetos/prevendo_demanda_de_estoque/df_cliente.csv", fileEncoding = "UTF-8", row.names = FALSE)
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2496774 133.4 4388708 234.4 4388708 234.4
## Vcells 54247357 413.9 580331142 4427.6 1054432506 8044.7pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales)# Função para remocao de acentos
RemoveAcentos <- function(textoComAcentos) {
if(!is.character(textoComAcentos)){
on.exit()
}
letrasComAcentos <- "áéíóúÁÉÍÓÚýÝàèìòùÀÈÌÒÙâêîôûÂÊÎÔÛãõÃÕñÑäëïöüÄËÏÖÜÿçÇ´`^~¨"
letrasSemAcentos <- "aeiouAEIOUyYaeiouAEIOUaeiouAEIOUaoAOnNaeiouAEIOUycC "
textoSemAcentos <- chartr(
old = letrasComAcentos,
new = letrasSemAcentos,
x = textoComAcentos
)
return(textoSemAcentos)
}
town_state <- fread('town_state.csv', stringsAsFactors = FALSE,encoding = "UTF-8")
df_town <- town_state %>%
summarise(ID_AGENCIA = Agencia_ID,
CIDADE = Town,
ESTADO = State) %>%
mutate_if(is.character, RemoveAcentos) %>%
mutate_if(is.character,toupper) %>%
mutate_if(is.character,as.factor);glimpse(df_town)## Rows: 790
## Columns: 3
## $ ID_AGENCIA <int> 1110, 1111, 1112, 1113, 1114, 1116, 1117, 1118, 1119, 11...
## $ CIDADE <fct> 2008 AG. LAGO FILT, 2002 AG. AZCAPOTZALCO, 2004 AG. CUAU...
## $ ESTADO <fct> "MEXICO, D.F.", "MEXICO, D.F.", "ESTADO DE MEXICO", "MEX...write.csv2(df_town, "E:/projetos/prevendo_demanda_de_estoque/df_town.csv", fileEncoding = "UTF-8", row.names = FALSE)
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2497091 133.4 4388708 234.4 4388708 234.4
## Vcells 54249367 413.9 464264914 3542.1 1054432506 8044.7ANÁLISE EXPLORATÓRIA:
Aqui nós teremos uma base inicial de como estão as distribuições dos dados. Há várias perguntas que podem ser respondidas nessa etapa. Faremos uma breve avaliação das variáveis com a utilização do ggplot. Uma análise mais aprofundada reservaremos para uma ferramenta de dataviz. Nesse caso, utilizaremos o Tableau, isso também nos ajudará a criar um self-service BI para análises mais personalizáveis para o usuário final.
PRODUTOS:
Inicialmente, vamos carregar os pacotes, definir o diretório de trabalho, e fazer algumas modificações nos metadados do dataset.
pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales, plotly, grid)
setwd("E:/projetos/prevendo_demanda_de_estoque")
df <- fread("df_treino.csv", encoding = "UTF-8")
produto <- fread("df_produto.csv", encoding = "UTF-8")
df$VENDAS_SEMANA <- sub(" ","",df$VENDAS_SEMANA)
df$VENDAS_SEMANA <- sub("\\,",".",df$VENDAS_SEMANA)
df$DEV_PROX_SEMANA_PESOS <- sub(" ","",df$DEV_PROX_SEMANA_PESOS)
df$DEV_PROX_SEMANA_PESOS <- sub("\\,",".",df$DEV_PROX_SEMANA_PESOS)
df$UNIDADES_DEVOLVIDAS <- as.double(df$UNIDADES_DEVOLVIDAS)df <- df %>%
dplyr::select(c(-ID_AGENCIA,-ID_CANAL,-ID_ROTA,-ID_CLIENTE,-SEMANA)) %>%
mutate(VENDAS_SEMANA = as.double(VENDAS_SEMANA),
DEV_PROX_SEMANA_PESOS = as.double(DEV_PROX_SEMANA_PESOS)) %>%
group_by(ID_PRODUTO) %>%
summarise(UNIDADES = sum(UNID_VENDAS_SEMANA),
VENDAS_PESOS = sum(VENDAS_SEMANA),
UNIDADES_DEVOLVIDAS = sum(DEV_UNID_PROX_SEMANA),
PESOS_DEVOLVIDOS = sum(DEV_PROX_SEMANA_PESOS)) %>%
inner_join(produto, by = "ID_PRODUTO");glimpse(df)## `summarise()` ungrouping output (override with `.groups` argument)## Rows: 1,799
## Columns: 6
## $ ID_PRODUTO <int> 41, 53, 72, 73, 100, 106, 107, 108, 122, 123, 1...
## $ UNIDADES <int> 22452, 33185, 722938, 715069, 1166, 17646, 133,...
## $ VENDAS_PESOS <dbl> 406469.25, 474559.71, 2668400.26, 15347261.91, ...
## $ UNIDADES_DEVOLVIDAS <int> 227, 1, 11795, 17442, 961, 307, 92, 0, 3, 1129,...
## $ PESOS_DEVOLVIDOS <dbl> 4115.51, 14.30, 43550.50, 372596.12, 20808.93, ...
## $ NOME_PRODUTO <chr> "BIMBOLLOS EXT SAJONJOLI 6P 480G BIM 41", "BURR...options(scipen = 999)
p1 <- ggplot(df, aes(x = UNIDADES, y = UNIDADES_DEVOLVIDAS))+
geom_point(colour = "#0c4c8a", alpha = 0.6, size = 4)+
theme_minimal()+
labs(title = "Análise de correlação - Unidades x Unidades Devolvidas");p1
Aqui é possível ver que, o número de unidades devolvidas está inteiramente ligada ao numero de unidades (demanda). Contudo, há produtos outliers que não seguem esse padrão.
cor(df$UNIDADES,df$UNIDADES_DEVOLVIDAS)## [1] 0.8289136Como citado anteriormente, e como indicado pelo coeficiente de correlação de pearson, há forte correlação positiva entre o número de unidades (demanda) e unidades devolvidas.
df_unidades <- df %>%
dplyr::arrange(desc(UNIDADES)) %>%
head()
df_unidades_dev <- df %>%
dplyr::arrange(desc(UNIDADES_DEVOLVIDAS)) %>%
head()
p2 <- ggplot(df_unidades, aes(x = reorder(NOME_PRODUTO, UNIDADES),UNIDADES))+
geom_bar(stat = "identity", fill = "lightblue")+
coord_flip()+
theme_minimal()+
labs(title = "6 produtos com mais unidades",
y = "UNIDADES",
x = "PRODUTO")
p3 <- ggplot(df_unidades_dev, aes(x = reorder(NOME_PRODUTO, UNIDADES_DEVOLVIDAS),UNIDADES_DEVOLVIDAS))+
geom_bar(stat = "identity", fill = "lightgreen")+
coord_flip()+
theme_minimal()+
labs(title = "6 produtos que mais tem unidades retornadas",
y = "UNIDADES",
x = "PRODUTO")
gridExtra::grid.arrange(p2,p3,nrow=2)
Podemos ver aqui que, embora o produto NITO 1P 62G seja o produto que mais tem demanda de unidades, isso não se repete quando vemos por unidades devolvidas.
df_vendas <- df %>%
dplyr::arrange(desc(VENDAS_PESOS)) %>%
head()
df_vendas_dev <- df %>%
dplyr::arrange(desc(PESOS_DEVOLVIDOS)) %>%
head()
p4 <- ggplot(df_vendas, aes(x = reorder(NOME_PRODUTO, VENDAS_PESOS), VENDAS_PESOS))+
geom_bar(stat = "identity", fill = "lightblue")+
coord_flip()+
theme_minimal()+
labs(title = "6 produtos mais rentáveis em pesos",
x = "PRODUTO",
y = "UNIDADE")
p5 <- ggplot(df_vendas_dev, aes(x = reorder(NOME_PRODUTO,PESOS_DEVOLVIDOS), PESOS_DEVOLVIDOS))+
geom_bar(stat = "identity", fill = "lightgreen")+
coord_flip()+
theme_minimal()+
labs(title = "6 produtos que mais retornam em pesos",
x = "PRODUTO",
y = "UNIDADE")
gridExtra::grid.arrange(p4,p5, nrow=2)
PAN BLANCO é o produto mais rentável em pesos, contudo, também é o produto que mais sofre com devoluções de pesos (reembolsos).
p6 <- ggplot(df, aes(x = VENDAS_PESOS, y = PESOS_DEVOLVIDOS))+
geom_point(colour = "#0c4c8a", alpha = 0.6, size = 4)+
theme_minimal()+
labs(title = "Análise de correlação - Vendas x Pesos Devolvidos");p6
cor(df$VENDAS_PESOS,df$PESOS_DEVOLVIDOS)## [1] 0.9023761Existe forte correlação positiva entre Vendas e Pesos devolvidos (reembolso), ou seja, a medida que as vendas aumentam, os reembolsos tendem a aumentar.
CIDADE / ESTADO:
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2628035 140.4 4388708 234.4 4388708 234.4
## Vcells 102784952 784.2 1168398263 8914.2 1460481196 11142.6pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales, plotly, grid)
setwd("E:/projetos/prevendo_demanda_de_estoque")
df <- fread("df_treino.csv", encoding = "UTF-8")
cidade <- fread("df_town.csv", encoding = "UTF-8")
df$VENDAS_SEMANA <- sub(" ","",df$VENDAS_SEMANA)
df$VENDAS_SEMANA <- sub("\\,",".",df$VENDAS_SEMANA)
df$DEV_PROX_SEMANA_PESOS <- sub(" ","",df$DEV_PROX_SEMANA_PESOS)
df$DEV_PROX_SEMANA_PESOS <- sub("\\,",".",df$DEV_PROX_SEMANA_PESOS)
df$UNIDADES_DEVOLVIDAS <- as.double(df$UNIDADES_DEVOLVIDAS)
df <- df %>%
dplyr::select(c(-ID_CANAL,-ID_ROTA,-ID_CLIENTE,-SEMANA)) %>%
mutate(VENDAS_SEMANA = as.double(VENDAS_SEMANA),
DEV_PROX_SEMANA_PESOS = as.double(DEV_PROX_SEMANA_PESOS)) %>%
group_by(ID_AGENCIA) %>%
summarise(UNIDADES = sum(UNID_VENDAS_SEMANA),
VENDAS_PESOS = sum(VENDAS_SEMANA),
UNIDADES_DEVOLVIDAS = sum(DEV_UNID_PROX_SEMANA),
PESOS_DEVOLVIDOS = sum(DEV_PROX_SEMANA_PESOS)) %>%
inner_join(cidade, by = "ID_AGENCIA");glimpse(df)## `summarise()` ungrouping output (override with `.groups` argument)## Rows: 552
## Columns: 7
## $ ID_AGENCIA <int> 1110, 1111, 1112, 1113, 1114, 1116, 1117, 1118,...
## $ UNIDADES <int> 877675, 2720400, 1959534, 1442999, 3498170, 312...
## $ VENDAS_PESOS <dbl> 9274674, 24070592, 16591688, 12094484, 62420320...
## $ UNIDADES_DEVOLVIDAS <int> 39900, 25231, 23924, 11865, 150779, 37022, 5114...
## $ PESOS_DEVOLVIDOS <dbl> 214072.77, 264672.43, 231897.39, 117754.38, 248...
## $ CIDADE <chr> "2008 AG. LAGO FILT", "2002 AG. AZCAPOTZALCO", ...
## $ ESTADO <chr> "MEXICO, D.F.", "MEXICO, D.F.", "ESTADO DE MEXI...df_estados_unid_top <- df %>%
dplyr::select(UNIDADES,ESTADO) %>%
group_by(ESTADO) %>%
summarize(UNIDADES = sum(UNIDADES)) %>%
arrange(desc(UNIDADES)) %>%
head()## `summarise()` ungrouping output (override with `.groups` argument)df_estados_unid_dev_top <- df %>%
dplyr::select(UNIDADES_DEVOLVIDAS,ESTADO) %>%
group_by(ESTADO) %>%
summarize(UNIDADES_DEVOLVIDAS = sum(UNIDADES_DEVOLVIDAS)) %>%
arrange(desc(UNIDADES_DEVOLVIDAS)) %>%
head()## `summarise()` ungrouping output (override with `.groups` argument)p6 <- ggplot(df_estados_unid_top, aes(x = reorder(as.factor(ESTADO),UNIDADES), UNIDADES))+
geom_bar(stat = "identity", fill = "steelblue")+
coord_flip()+
theme_minimal()+
labs(title = "Top estados em unidades",
y = "UNIDADE",
x = "")
p7 <- ggplot(df_estados_unid_dev_top, aes(x = reorder(ESTADO, UNIDADES_DEVOLVIDAS), UNIDADES_DEVOLVIDAS))+
geom_bar(stat = "identity",fill = "lightgreen")+
coord_flip()+
theme_minimal()+
labs(title = "Top estados em retorno de unidades",
y = "UNIDADES DEVOLVIDAS",
x = "")
gridExtra::grid.arrange(p6,p7,nrow = 2) 
Analisando os plots acima, é possível afirmar que os estados que possuem mais unidades são proporcionalmente os mesmo com maior taxa de retorno.
df_estados_vendas_top <- df %>%
dplyr::select(VENDAS_PESOS,ESTADO) %>%
group_by(ESTADO) %>%
summarize(VENDAS_PESOS = sum(VENDAS_PESOS)) %>%
arrange(desc(VENDAS_PESOS)) %>%
head()## `summarise()` ungrouping output (override with `.groups` argument)df_estados_pesos_dev_top <- df %>%
dplyr::select(PESOS_DEVOLVIDOS,ESTADO) %>%
group_by(ESTADO) %>%
summarize(PESOS_DEVOLVIDOS = sum(PESOS_DEVOLVIDOS)) %>%
arrange(desc(PESOS_DEVOLVIDOS)) %>%
head()## `summarise()` ungrouping output (override with `.groups` argument)p8 <- ggplot(df_estados_vendas_top, aes(x = reorder(as.factor(ESTADO),VENDAS_PESOS), VENDAS_PESOS))+
geom_bar(stat = "identity", fill = "steelblue")+
coord_flip()+
theme_minimal()+
labs(title = "Top estados em Vendas de produtos",
y = "Vendas",
x = "")
p9 <- ggplot(df_estados_pesos_dev_top, aes(x = reorder(ESTADO, PESOS_DEVOLVIDOS), PESOS_DEVOLVIDOS))+
geom_bar(stat = "identity",fill = "lightgreen")+
coord_flip()+
theme_minimal()+
labs(title = "Top estados em pesos devolvidos",
y = "Pesos",
x = "")
gridExtra::grid.arrange(p8,p9,nrow = 2)
O mesmo se repete quando falamos em vendas e pesos devolvidos. Os Estados que mais vendem são também os que mais devolvem pesos (reembolsos).
CLIENTES:
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2626166 140.3 4388708 234.4 4388708 234.4
## Vcells 151024177 1152.3 1143741862 8726.1 1460481196 11142.6pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales, plotly, grid)
setwd("E:/projetos/prevendo_demanda_de_estoque")
df <- fread("df_treino.csv", encoding = "UTF-8")
cliente <- fread("df_cliente.csv", encoding = "UTF-8")
df$VENDAS_SEMANA <- sub(" ","",df$VENDAS_SEMANA)
df$VENDAS_SEMANA <- sub("\\,",".",df$VENDAS_SEMANA)
df$DEV_PROX_SEMANA_PESOS <- sub(" ","",df$DEV_PROX_SEMANA_PESOS)
df$DEV_PROX_SEMANA_PESOS <- sub("\\,",".",df$DEV_PROX_SEMANA_PESOS)
df$UNIDADES_DEVOLVIDAS <- as.double(df$UNIDADES_DEVOLVIDAS)df <- df %>%
dplyr::select(c(-ID_CANAL,-ID_ROTA,-SEMANA)) %>%
mutate(VENDAS_SEMANA = as.double(VENDAS_SEMANA),
DEV_PROX_SEMANA_PESOS = as.double(DEV_PROX_SEMANA_PESOS)) %>%
group_by(ID_CLIENTE) %>%
summarise(UNIDADES = sum(UNID_VENDAS_SEMANA),
VENDAS_PESOS = sum(VENDAS_SEMANA),
UNIDADES_DEVOLVIDAS = sum(DEV_UNID_PROX_SEMANA),
PESOS_DEVOLVIDOS = sum(DEV_PROX_SEMANA_PESOS)) %>%
inner_join(cliente, by = "ID_CLIENTE");glimpse(df)## `summarise()` ungrouping output (override with `.groups` argument)## Rows: 885,416
## Columns: 6
## $ ID_CLIENTE <int> 26, 60, 65, 101, 105, 106, 107, 215, 262, 262, ...
## $ UNIDADES <int> 6845, 46830, 68743, 1224, 17373, 3614, 6884, 34...
## $ VENDAS_PESOS <dbl> 128149.26, 2148013.48, 1113131.54, 27353.88, 31...
## $ UNIDADES_DEVOLVIDAS <int> 531, 0, 8, 0, 0, 0, 430, 0, 0, 0, 0, 0, 11, 2, ...
## $ PESOS_DEVOLVIDOS <dbl> 6969.72, 0.00, 197.60, 0.00, 0.00, 0.00, 6368.5...
## $ NOME_CLIENTE <chr> "BODEGA COMERCIAL MEXICANA TOLUCA", "SAMS CLUB ...df_clientes_vendas <- df %>%
select(NOME_CLIENTE,VENDAS_PESOS) %>%
arrange(desc(VENDAS_PESOS)) %>%
head()
p10 <- ggplot(df_clientes_vendas, aes(x = reorder(as.factor(NOME_CLIENTE), VENDAS_PESOS), VENDAS_PESOS))+
geom_bar(stat = "identity",fill = "steelblue")+
coord_flip()+
theme_minimal()+
labs(title = "Top clientes em vendas",
y = "Vendas",
x = "")
df_clientes_unid_dev <- df %>%
select(NOME_CLIENTE,UNIDADES_DEVOLVIDAS) %>%
arrange(desc(UNIDADES_DEVOLVIDAS)) %>%
head()
p11 <- ggplot(df_clientes_unid_dev, aes(x = reorder(as.factor(NOME_CLIENTE), UNIDADES_DEVOLVIDAS), UNIDADES_DEVOLVIDAS))+
geom_bar(stat = "identity",fill = "lightblue")+
coord_flip()+
theme_minimal()+
labs(title = "Top clientes em retorno de unidades",
y = "Unidades",
x = "")
gridExtra::grid.arrange(p10,p11,nrow=2)
Aqui há alguns insights interessantes quanto aos clientes:
PUEBLA REMISSION, embora seja disparadamente o cliente que mais vende, é também o que mais tem retorno de unidades.
Também é possível notar aqui que, o Mcdonald’s que é o terceiro maior cliente em número de vendas em pesos, sequer aparece entre os clientes que mais retornam unidades. Vale cogitar uma análise mais aprofundada sobre o tipo de produto que é vendido nesse estabelecimento, e se o fato de de haver poucas devoluçoes está inteiramente ligado ao tipo de produto, cidade e estado.
PREPARACAO PARA O MODELO PREDITIVO
rm(list = ls(all.names = TRUE));gc()## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 2626111 140.3 17161850 916.6 16755060 894.9
## Vcells 200915449 1532.9 1389815902 10603.5 1460481196 11142.6pacman::p_load(tidyverse,caTools,knitr,corrplot,car,olsrr,moments,MASS,caret,klaR, data.table, scales, plotly, grid)
setwd("E:/projetos/prevendo_demanda_de_estoque")df <- fread("df_treino.csv", encoding = "UTF-8")df$VENDAS_SEMANA <- sub(" ","",df$VENDAS_SEMANA)
df$VENDAS_SEMANA <- sub("\\,",".",df$VENDAS_SEMANA)
df$VENDAS_SEMANA <- as.double(df$VENDAS_SEMANA)
df$DEV_PROX_SEMANA_PESOS <- sub(" ","",df$DEV_PROX_SEMANA_PESOS)
df$DEV_PROX_SEMANA_PESOS <- sub("\\,",".",df$DEV_PROX_SEMANA_PESOS)
df$DEV_PROX_SEMANA_PESOS <- as.double(df$DEV_PROX_SEMANA_PESOS)df2 <- df %>%
sample_frac(0.002) %>%
mutate_if(is.integer, as.double);glimpse(df2)## Rows: 148,361
## Columns: 11
## $ SEMANA <dbl> 8, 7, 5, 4, 3, 8, 7, 4, 7, 3, 5, 5, 3, 7, 8, ...
## $ ID_AGENCIA <dbl> 4010, 2012, 2012, 1472, 1126, 2237, 3221, 201...
## $ ID_CANAL <dbl> 1, 1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 1, ...
## $ ID_ROTA <dbl> 2110, 2002, 1219, 4918, 1444, 1225, 1606, 121...
## $ ID_CLIENTE <dbl> 1087255, 2465239, 1967190, 1034650, 920826, 2...
## $ ID_PRODUTO <dbl> 30569, 43316, 32819, 43185, 1240, 1309, 40217...
## $ UNID_VENDAS_SEMANA <dbl> 2, 2, 3, 8, 6, 1, 6, 1, 3, 2, 5, 12, 8, 320, ...
## $ VENDAS_SEMANA <dbl> 14.08, 16.30, 26.67, 150.88, 50.28, 6.76, 53....
## $ DEV_UNID_PROX_SEMANA <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ DEV_PROX_SEMANA_PESOS <dbl> 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, ...
## $ DEMANDA_AJUSTADA <dbl> 2, 2, 3, 8, 6, 1, 6, 1, 3, 2, 5, 12, 8, 320, ...dados_nao_padronizados <- df2[,1:6]
dados_padronizados <- scale(df2[,7:10]);head(dados_padronizados)## UNID_VENDAS_SEMANA VENDAS_SEMANA DEV_UNID_PROX_SEMANA
## [1,] -0.24531323 -0.18899328 -0.06356877
## [2,] -0.24531323 -0.18132807 -0.06356877
## [3,] -0.19955458 -0.14552257 -0.06356877
## [4,] 0.02923864 0.28334936 -0.06356877
## [5,] -0.06227865 -0.06400203 -0.06356877
## [6,] -0.29107187 -0.21426776 -0.06356877
## DEV_PROX_SEMANA_PESOS
## [1,] -0.07111788
## [2,] -0.07111788
## [3,] -0.07111788
## [4,] -0.07111788
## [5,] -0.07111788
## [6,] -0.07111788df3 <- cbind(dados_nao_padronizados,dados_padronizados)Aqui vamos selecionar somente a variável target, cuja não faz do processo de padronização Em seguida, vamos unificar os datasets criados.
target <- df2[,11];df4 <- cbind(df3,target);glimpse(df4)## Rows: 148,361
## Columns: 11
## $ SEMANA <dbl> 8, 7, 5, 4, 3, 8, 7, 4, 7, 3, 5, 5, 3, 7, 8, ...
## $ ID_AGENCIA <dbl> 4010, 2012, 2012, 1472, 1126, 2237, 3221, 201...
## $ ID_CANAL <dbl> 1, 1, 1, 4, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 1, ...
## $ ID_ROTA <dbl> 2110, 2002, 1219, 4918, 1444, 1225, 1606, 121...
## $ ID_CLIENTE <dbl> 1087255, 2465239, 1967190, 1034650, 920826, 2...
## $ ID_PRODUTO <dbl> 30569, 43316, 32819, 43185, 1240, 1309, 40217...
## $ UNID_VENDAS_SEMANA <dbl> -0.24531323, -0.24531323, -0.19955458, 0.0292...
## $ VENDAS_SEMANA <dbl> -0.188993282, -0.181328073, -0.145522567, 0.2...
## $ DEV_UNID_PROX_SEMANA <dbl> -0.06356877, -0.06356877, -0.06356877, -0.063...
## $ DEV_PROX_SEMANA_PESOS <dbl> -0.07111788, -0.07111788, -0.07111788, -0.071...
## $ DEMANDA_AJUSTADA <dbl> 2, 2, 3, 8, 6, 1, 6, 1, 3, 2, 5, 12, 8, 320, ...df4 <- as.data.frame(df4)
# Matriz de correlação
num_vars <- sapply(df4,is.numeric)
corr <- cor(df4[num_vars])
corrplot(corr,method = "color")
É possível notar aqui que, há algumas variáveis que estão fortemente correlacionadas. Vamos cogitar a hipótese de dropar algumas delas para evitarmos problemas de multicolinearidade ou instabilidade no modelo. Uma maneira de seleção de variáveis relevantes, é utilizar o algoritmo de Step AIC
DADOS DE TREINO E TESTE:
A partir dos dados padronizados, vamos reservar 70% do dataset para os dados de treino e 30% para os dados de teste. Vamos também gravar os datasets, e fazer o clean da memoria do Rstudio.
sample <- sample.split(df4$SEMANA, SplitRatio = 0.7)
treino <- subset(df4, sample == TRUE);dim(treino)## [1] 103853 11teste <- subset(df4, sample == FALSE);dim(teste)## [1] 44508 11rm(sample)
rm(target)
rm(dados_padronizados)
rm(df)
rm(df2)
rm(df3)
rm(df4)
rm(dados_nao_padronizados)
rm(corr)
glimpse(treino);dim(treino)## Rows: 103,853
## Columns: 11
## $ SEMANA <dbl> 8, 7, 5, 4, 3, 8, 7, 3, 5, 5, 7, 8, 7, 7, 7, ...
## $ ID_AGENCIA <dbl> 4010, 2012, 2012, 1472, 1126, 2237, 3221, 122...
## $ ID_CANAL <dbl> 1, 1, 1, 4, 1, 1, 1, 1, 1, 1, 5, 1, 2, 1, 1, ...
## $ ID_ROTA <dbl> 2110, 2002, 1219, 4918, 1444, 1225, 1606, 162...
## $ ID_CLIENTE <dbl> 1087255, 2465239, 1967190, 1034650, 920826, 2...
## $ ID_PRODUTO <dbl> 30569, 43316, 32819, 43185, 1240, 1309, 40217...
## $ UNID_VENDAS_SEMANA <dbl> -0.24531323, -0.24531323, -0.19955458, 0.0292...
## $ VENDAS_SEMANA <dbl> -0.188993282, -0.181328073, -0.145522567, 0.2...
## $ DEV_UNID_PROX_SEMANA <dbl> -0.06356877, -0.06356877, -0.06356877, -0.063...
## $ DEV_PROX_SEMANA_PESOS <dbl> -0.07111788, -0.07111788, -0.07111788, -0.071...
## $ DEMANDA_AJUSTADA <dbl> 2, 2, 3, 8, 6, 1, 6, 2, 5, 12, 320, 1, 439, 6...## [1] 103853 11CONSTRUÇÃO DO MODELO E STEPAIC
Vamos construir o primeiro modelo de machine learning de regressão linear. Também iremos avaliar as melhores variáveis para o modelo utilizando o algoritmo STEPAIC, isso nos auxiliará a evitar problemas como a multicolinearidade que ja identificamos anteriormente.
modelo1 <- lm(DEMANDA_AJUSTADA~.,treino);summary(modelo1) # 0.998##
## Call:
## lm(formula = DEMANDA_AJUSTADA ~ ., data = treino)
##
## Residuals:
## Min 1Q Median 3Q Max
## -108.215 -0.005 0.005 0.024 66.638
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 7.261476214973 0.008500682825 854.223
## SEMANA 0.000067697471 0.001145526533 0.059
## ID_AGENCIA 0.000000065009 0.000000566380 0.115
## ID_CANAL 0.007617755167 0.001826317587 4.171
## ID_ROTA 0.000002922650 0.000001861956 1.570
## ID_CLIENTE 0.000000001272 0.000000001263 1.007
## ID_PRODUTO -0.000000100065 0.000000130429 -0.767
## UNID_VENDAS_SEMANA 21.681396165112 0.004712375972 4600.948
## VENDAS_SEMANA 0.065034000319 0.004611072132 14.104
## DEV_UNID_PROX_SEMANA -0.497839164596 0.004701970326 -105.879
## DEV_PROX_SEMANA_PESOS -0.338631818447 0.004532104345 -74.718
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## SEMANA 0.953
## ID_AGENCIA 0.909
## ID_CANAL 0.0000303 ***
## ID_ROTA 0.116
## ID_CLIENTE 0.314
## ID_PRODUTO 0.443
## UNID_VENDAS_SEMANA < 0.0000000000000002 ***
## VENDAS_SEMANA < 0.0000000000000002 ***
## DEV_UNID_PROX_SEMANA < 0.0000000000000002 ***
## DEV_PROX_SEMANA_PESOS < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7435 on 103842 degrees of freedom
## Multiple R-squared: 0.9987, Adjusted R-squared: 0.9987
## F-statistic: 8.264e+06 on 10 and 103842 DF, p-value: < 0.00000000000000022step(modelo1, direction = 'both')## Start: AIC=-61556.59
## DEMANDA_AJUSTADA ~ SEMANA + ID_AGENCIA + ID_CANAL + ID_ROTA +
## ID_CLIENTE + ID_PRODUTO + UNID_VENDAS_SEMANA + VENDAS_SEMANA +
## DEV_UNID_PROX_SEMANA + DEV_PROX_SEMANA_PESOS
##
## Df Sum of Sq RSS AIC
## - SEMANA 1 0 57400 -61559
## - ID_AGENCIA 1 0 57400 -61559
## - ID_PRODUTO 1 0 57400 -61558
## - ID_CLIENTE 1 1 57400 -61558
## <none> 57400 -61557
## - ID_ROTA 1 1 57401 -61556
## - ID_CANAL 1 10 57409 -61541
## - VENDAS_SEMANA 1 110 57510 -61360
## - DEV_PROX_SEMANA_PESOS 1 3086 60486 -56120
## - DEV_UNID_PROX_SEMANA 1 6197 63596 -50912
## - UNID_VENDAS_SEMANA 1 11701192 11758591 491179
##
## Step: AIC=-61558.58
## DEMANDA_AJUSTADA ~ ID_AGENCIA + ID_CANAL + ID_ROTA + ID_CLIENTE +
## ID_PRODUTO + UNID_VENDAS_SEMANA + VENDAS_SEMANA + DEV_UNID_PROX_SEMANA +
## DEV_PROX_SEMANA_PESOS
##
## Df Sum of Sq RSS AIC
## - ID_AGENCIA 1 0 57400 -61561
## - ID_PRODUTO 1 0 57400 -61560
## - ID_CLIENTE 1 1 57400 -61560
## <none> 57400 -61559
## - ID_ROTA 1 1 57401 -61558
## + SEMANA 1 0 57400 -61557
## - ID_CANAL 1 10 57409 -61543
## - VENDAS_SEMANA 1 110 57510 -61362
## - DEV_PROX_SEMANA_PESOS 1 3086 60486 -56122
## - DEV_UNID_PROX_SEMANA 1 6197 63596 -50914
## - UNID_VENDAS_SEMANA 1 11701193 11758592 491177
##
## Step: AIC=-61560.57
## DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + ID_CLIENTE + ID_PRODUTO +
## UNID_VENDAS_SEMANA + VENDAS_SEMANA + DEV_UNID_PROX_SEMANA +
## DEV_PROX_SEMANA_PESOS
##
## Df Sum of Sq RSS AIC
## - ID_PRODUTO 1 0 57400 -61562
## - ID_CLIENTE 1 1 57400 -61562
## <none> 57400 -61561
## - ID_ROTA 1 1 57401 -61560
## + ID_AGENCIA 1 0 57400 -61559
## + SEMANA 1 0 57400 -61559
## - ID_CANAL 1 10 57409 -61545
## - VENDAS_SEMANA 1 110 57510 -61364
## - DEV_PROX_SEMANA_PESOS 1 3086 60486 -56124
## - DEV_UNID_PROX_SEMANA 1 6197 63596 -50916
## - UNID_VENDAS_SEMANA 1 11701437 11758837 491177
##
## Step: AIC=-61561.99
## DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + ID_CLIENTE + UNID_VENDAS_SEMANA +
## VENDAS_SEMANA + DEV_UNID_PROX_SEMANA + DEV_PROX_SEMANA_PESOS
##
## Df Sum of Sq RSS AIC
## - ID_CLIENTE 1 1 57400 -61563
## - ID_ROTA 1 1 57401 -61562
## <none> 57400 -61562
## + ID_PRODUTO 1 0 57400 -61561
## + ID_AGENCIA 1 0 57400 -61560
## + SEMANA 1 0 57400 -61560
## - ID_CANAL 1 10 57410 -61545
## - VENDAS_SEMANA 1 110 57510 -61364
## - DEV_PROX_SEMANA_PESOS 1 3086 60486 -56125
## - DEV_UNID_PROX_SEMANA 1 6197 63597 -50917
## - UNID_VENDAS_SEMANA 1 11733215 11790615 491455
##
## Step: AIC=-61562.94
## DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + UNID_VENDAS_SEMANA +
## VENDAS_SEMANA + DEV_UNID_PROX_SEMANA + DEV_PROX_SEMANA_PESOS
##
## Df Sum of Sq RSS AIC
## <none> 57400 -61563
## - ID_ROTA 1 1 57402 -61563
## + ID_CLIENTE 1 1 57400 -61562
## + ID_PRODUTO 1 0 57400 -61562
## + ID_AGENCIA 1 0 57400 -61561
## + SEMANA 1 0 57400 -61561
## - ID_CANAL 1 10 57411 -61546
## - VENDAS_SEMANA 1 110 57511 -61365
## - DEV_PROX_SEMANA_PESOS 1 3086 60487 -56126
## - DEV_UNID_PROX_SEMANA 1 6198 63598 -50917
## - UNID_VENDAS_SEMANA 1 11734860 11792260 491467##
## Call:
## lm(formula = DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + UNID_VENDAS_SEMANA +
## VENDAS_SEMANA + DEV_UNID_PROX_SEMANA + DEV_PROX_SEMANA_PESOS,
## data = treino)
##
## Coefficients:
## (Intercept) ID_CANAL ID_ROTA
## 7.26263971 0.00787196 0.00000257
## UNID_VENDAS_SEMANA VENDAS_SEMANA DEV_UNID_PROX_SEMANA
## 21.68115212 0.06513094 -0.49786644
## DEV_PROX_SEMANA_PESOS
## -0.33864097# Modelo indicado pelo step AIC
modelo2 <-lm(formula = DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + ID_PRODUTO +
UNID_VENDAS_SEMANA + VENDAS_SEMANA + DEV_UNID_PROX_SEMANA +
DEV_PROX_SEMANA_PESOS, data = treino);summary(modelo2) # 0.998##
## Call:
## lm(formula = DEMANDA_AJUSTADA ~ ID_CANAL + ID_ROTA + ID_PRODUTO +
## UNID_VENDAS_SEMANA + VENDAS_SEMANA + DEV_UNID_PROX_SEMANA +
## DEV_PROX_SEMANA_PESOS, data = treino)
##
## Residuals:
## Min 1Q Median 3Q Max
## -108.213 -0.005 0.005 0.024 66.639
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.2640669380 0.0044774967 1622.350 < 0.0000000000000002
## ID_CANAL 0.0076889104 0.0018229779 4.218 0.0000247
## ID_ROTA 0.0000030249 0.0000018589 1.627 0.104
## ID_PRODUTO -0.0000001023 0.0000001304 -0.785 0.433
## UNID_VENDAS_SEMANA 21.6813459307 0.0047119930 4601.311 < 0.0000000000000002
## VENDAS_SEMANA 0.0650128232 0.0046109145 14.100 < 0.0000000000000002
## DEV_UNID_PROX_SEMANA -0.4978634388 0.0047018289 -105.887 < 0.0000000000000002
## DEV_PROX_SEMANA_PESOS -0.3386195927 0.0045320317 -74.717 < 0.0000000000000002
##
## (Intercept) ***
## ID_CANAL ***
## ID_ROTA
## ID_PRODUTO
## UNID_VENDAS_SEMANA ***
## VENDAS_SEMANA ***
## DEV_UNID_PROX_SEMANA ***
## DEV_PROX_SEMANA_PESOS ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7435 on 103845 degrees of freedom
## Multiple R-squared: 0.9987, Adjusted R-squared: 0.9987
## F-statistic: 1.181e+07 on 7 and 103845 DF, p-value: < 0.00000000000000022par(mfrow = c(2,2))
plot(modelo2)
INTERPRETANDO OS GRÁFICOS:
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.
par(mfrow = c(1,1))
hist(modelo2$residuals, labels = TRUE, ylim = c(0,100000))
Aqui também podemos ver que os residuos estão em sua maioria em torno de zero. O que é muito bom.
AJUSTANDO O DATASET DE TESTE:
teste2 <- teste %>%
dplyr::select(c(-ID_AGENCIA,-SEMANA,-ID_CLIENTE));glimpse(teste2)## Rows: 44,508
## Columns: 8
## $ ID_CANAL <dbl> 1, 1, 2, 4, 7, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
## $ ID_ROTA <dbl> 1213, 1227, 1542, 4803, 3335, 1442, 1095, 122...
## $ ID_PRODUTO <dbl> 3631, 41938, 43220, 30416, 1212, 972, 45407, ...
## $ UNID_VENDAS_SEMANA <dbl> -0.29107187, -0.19955458, 0.02923864, 0.21227...
## $ VENDAS_SEMANA <dbl> -0.181155433, -0.134957007, 0.279482231, 0.11...
## $ DEV_UNID_PROX_SEMANA <dbl> -0.06356877, -0.06356877, -0.06356877, -0.063...
## $ DEV_PROX_SEMANA_PESOS <dbl> -0.07111788, -0.07111788, -0.07111788, -0.071...
## $ DEMANDA_AJUSTADA <dbl> 1, 3, 8, 12, 15, 1, 25, 5, 3, 1, 4, 8, 1, 1, ...Podemos ainda avaliar a acurácia do modelo, comparando as médias de previsões vs a média dos valores observados:
previsao <- predict(modelo2, teste2)
mean(previsao)## [1] 7.27484mean(teste2$DEMANDA_AJUSTADA)## [1] 7.275434Comparado ao nossos dados de teste, a média da previsão do modelo ficou bem próxima às observaçoes presentes no dataset de teste. O que é muito bom.
previsto <- round(previsao,digits = 0)
result <- cbind(teste2,previsto)linkedin/in/sandropenha
github.com/sandropenha