Previsão de demanda Guarulhos

Esse documento tem como objetivo gerar um previsor para a demanda de PAX no aeroporto de Guarulhos (GRU). Para isso, usaremos um modelo de regressão múltipla para obter as elasticidades para previsão de longo prazo.

Sumário

• Base de dados
• Pré processamento
• Demanda histórica do aeroporto
• Composição da demanda
• Market Share das companhias aéreas
• Tamanho médio das aeronaves
• Número de voos
• Load Factor agregado
• Modelagem
• Previsão

Base de dados

A base de dados é extraída da ANAC e os dados de PIB e Dólar vem do gerenciador de séries temporais do BACEN.

Pré processamento

Na parte de pré processamento foi realizada as seguintes ações:

• Renomeação das colunas
• Transformação das colunas em numerics
• Tratamento de valores NA
• Criação de função de agregação para o aeroporto escolhido

## Preparando base de dados

df1 <- df1 %>% select(-V1)

names(df1) <- gsub(" ","_",names(df1))
names(df1) <- gsub("\\)","",names(df1))
names(df1) <- gsub("\\(","",names(df1))

## Transformando em númericas

df1$PASSAGEIROS_PAGOS <- sub(",",".",df1$PASSAGEIROS_PAGOS)
df1$PASSAGEIROS_PAGOS <- as.numeric(df1$PASSAGEIROS_PAGOS)
df1 <- as.data.frame(df1)

for(i in c(22:27)){
  df1[,i] <- sub(",",".",df1[,i])
  df1[,i] <- as.numeric(df1[,i])
}

## Colocando zeros

df1[is.na(df1)] <- 0

## Dados de aeroportos agregados

Aero <- function(...){
  Origem <- df1 %>% 
    filter(AEROPORTO_DE_ORIGEM_SIGLA %in% c(...),
           ANO != 2019) %>%
    mutate(Aeroporto = AEROPORTO_DE_ORIGEM_SIGLA)
  Destino <- df1 %>%
    filter(AEROPORTO_DE_DESTINO_SIGLA %in% c(...),
           ANO != 2019) %>%
    mutate(Aeroporto = AEROPORTO_DE_DESTINO_SIGLA)
  
  Final <- bind_rows(Origem,Destino)
  return(Final)
  
}

Demanda histórica

Aero("SBGR") %>% group_by(ANO) %>% 
  summarise(PAX = sum(PASSAGEIROS_PAGOS)) %>%
  ggplot(aes(x = ANO,y = PAX)) +
  geom_bar(stat = "identity",fill = "darkblue") +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "Pax Aeroporto de Guarulhos",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Composição da demanda

Aero("SBGR") %>% group_by(ANO,NATUREZA) %>% 
  summarise(PAX = sum(PASSAGEIROS_PAGOS)) %>%
  ggplot(aes(x = ANO,y = PAX,fill = NATUREZA)) +
  geom_area() +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "Pax Aeroporto de Guarulhos por Natureza",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Market Share

Aero("SBGR")  %>%
  filter(EMPRESA_SIGLA %in% c("TAM","AZU","GLO")) %>%
  group_by(ANO,EMPRESA_NOME) %>% 
  summarise(PAX = sum(PASSAGEIROS_PAGOS)) %>%
  ggplot(aes(x = ANO,y = PAX,fill = EMPRESA_NOME)) +
  geom_area(position = "fill") +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "Share de mercado Aeroporto de Guarulhos",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Tamanho médio das aeronaves

Aero("SBGR") %>%
  group_by(ANO,NATUREZA) %>% 
  summarise(Capacidade_Media = sum(ASSENTOS)/sum(DECOLAGENS)) %>%
  ggplot(aes(x = ANO,y = Capacidade_Media)) +
  geom_line(aes(colour = NATUREZA),size = 1) +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "Capacidade média das aeronaves",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Número de Vôos

Aero("SBGR") %>%
  group_by(ANO) %>% 
  summarise(Decolagens = sum(DECOLAGENS)) %>%
  ggplot(aes(x = ANO,y = Decolagens)) +
  geom_bar(stat = "identity",fill = "darkblue") +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "N° de decolagens, Aeroporto de Guarulhos",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Load Factor

Aero("SBGR") %>%
  group_by(ANO) %>% 
  summarise(LoadFactor = sum(RPK)/sum(ASK)) %>%
  ggplot(aes(x = ANO,y = LoadFactor)) +
  geom_bar(stat = "identity",fill = "darkblue") +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 2000,to = 2018,by = 2)) +
  labs(title = "Load Factor, Aeroporto de Guarulhos",
       subtitle = "2000-2018",
       caption = "Fonte: ANAC")

Modelagem

-O modelo desenvolvido teve como variáveis de entrada o PIB em periodicidade mensal e o Dólar médio mensal. Aplicou se log para obter as elasticidades.

\[ log(PAX) = \beta_{0} + \beta_{1}log(PIB) + \beta_{2}log(Dólar) \]

-Os dados foram divididos em 2 para testar a aderencia do modelo. Os dados de treino vão de 2000 até 2016 e os dados de teste de 2017 a 2018.

# Previsão

library(rbcb)

# Pegando dados do PIB e Dolar

Produto <- get_series(c(PIB = 4380),start_date = "2000-01-01",
                      end_date = "2018-12-31")
Cambio <- get_series(c(DOLAR = 1),start_date = "2000-01-01",
                     end_date = "2018-12-31")

# Deflacionando PIB
library(deflateBR)


Produto$PIB <- deflate(Produto$PIB,Produto$date,"01/2000")

# Pegando média mensal do dólar

Cambio <- Cambio %>%
  group_by(year(date),month(date)) %>%
  summarise(Media_Dolar = mean(DOLAR)) %>%
  mutate(date = ymd(paste(`year(date)`,`month(date)`,"01",sep = "-"))) %>%
  select(date,Media_Dolar) %>% ungroup() %>% slice(-1)

Cambio <- Cambio %>% ungroup() %>% select(date,Media_Dolar)

# Juntando os dados

Demanda <- Aero("SBGR") %>% 
  mutate(date = ymd(paste(ANO,MÊS,"01",sep = "-"))) %>%
  group_by(date) %>%
  summarise(PAX = sum(PASSAGEIROS_PAGOS))

df2 <- Demanda %>%
  left_join(Produto,by = "date") %>%
  left_join(Cambio,by = "date") 


# Dados de Treino e Teste

treino <- df2 %>% filter(year(date) <= 2016)
teste <- df2 %>% filter(year(date) > 2016)

# Fazendo regressão

modelo_1 <- lm(log(PAX) ~ log(PIB) + log(Media_Dolar),treino)

Sumário do Modelo

library(sjPlot)

tab_model(modelo_1)

	log(PAX)
Predictors	Estimates	CI	p
(Intercept)	-8.57	-9.48 – -7.67	<0.001
PIB [log]	1.94	1.86 – 2.02	<0.001
Media_Dolar [log]	-0.02	-0.10 – 0.05	0.527
Observations	204
R2 / R2 adjusted	0.928 / 0.927

A elasticidade - PAX/Produto retornou em 1.94, de acordo com o que se espera de um grande aeroporto em um país em desenvolvimento. A variável do Dólar não foi estatisticamente significante.

Previsão

Indicadores de acurácia

# Aplicando o modelo

previsao <- exp(predict(modelo_1,teste))

# Acurácia

forecast::accuracy(previsao,teste$PAX)

##                ME     RMSE      MAE      MPE     MAPE
## Test set 671248.1 729136.8 671248.1 18.20063 18.20063

Em percentual, nosso modelo errou 18% aproximadamente. Para objetivos de previsão de longo prazo, a diferença não há de ser significativa. Porém para objetivos de curto prazo, há de se tomar cuidade e procurar embasar a previsão com outros métodos.

Gráfico

comp <- data.frame(REAL = teste$PAX,
                   Previsto = previsao,
                   Data = teste$date) 

comp %>%
  ggplot(aes(x = REAL,xend = Previsto,y = Data,group = Data)) +
  geom_dumbbell(color="#a3c4dc", 
                size_x =3,
                size_xend = 3,
                colour_x="red",
                colour_xend = "blue",
                show.legend = T) +
  coord_flip() +
  theme_fivethirtyeight() +
  labs(title = "Real x Previsto",
       subtitle = "2017-2018")