In euctrl-pru/international-BRA-EUR: Does not matter.

(PART*) Part A - Demand/Traffic Development
during COVID19 {#partA -}

COVID Briefing {- #covidh1}

The present section aims to compare the impact of COVID-19 crisis on air traffic in Brazil and Europe

#Load relevant packages
library(tidyverse)
library(readr)
library(dplyr)
library(ggplot2)
library(ggrepel)
library(maps)
library(patchwork)
library(flextable)
library(lubridate)
library(zoo)

#Read relevant data
bra_count_airport <- read_csv("../PBWG-2021/data/PBWG-BRA-airport-traffic.csv") %>%
  mutate(APT_ICAO = as.factor(APT_ICAO))
eur_count_airport <- read_csv("../PBWG-2021/data/PBWG-EUR-airport-traffic.csv") %>% mutate(APT_ICAO = as.factor(ICAO), .before = DATE, .keep = "unused")

Scope {-}

This briefing includes data from the following airports:

#useful filters
bra_10_apts <- c("SBBR", "SBGR", "SBSP", "SBKP", "SBRJ", "SBGL", "SBCF", "SBSV", "SBPA", "SBCT")
eur_apts <- c("EHAM","LFPG","EGLL","EDDF","EDDM","LEMD","LIRF","LEBL","EGKK","LSZH")

scope_function <- . %>% filter(year(DATE) %in% 2019:2021 & APT_ICAO %in% c(bra_10_apts, eur_apts)) %>% drop_na()

bra_count_airport <- bra_count_airport %>% scope_function()
eur_count_airport <- eur_count_airport %>% scope_function()
#head(bra_count_airport)
#head(eur_count_airport)

Brazil {-}

print(unique(bra_count_airport$APT_ICAO))

SBBR, SBCF, SBCT, SBGL, SBGR, SBKP, SBPA, SBRJ, SBSP, and SBSV

Europe {-}

unique(eur_count_airport$APT_ICAO)
#####---THERE ARE MISSING AIRPORTS COMPARED TO THE FULL REPORT---#####

European airports are EDDF, EDDM, EGLL, EHAM, LEMD, LFPG, LIRF, and LSZH

2020 in Review {-}

The COVID-19 pandemic hit all countries worldwide, but at different moments. In Europe, the first case was registered in January 24, 2020, in France. Approximately one month later, the first patient in Brazil was officially announced in February 26, 2020. In March 11, 2020, the World Health Organization declared the crisis a "global pandemic".

As a result, the air transport industry suffered a severe drop in demand, in Brazil and Europe. Figures REFERENCE1 and REFERENCE2 below shows the daily traffic for the both regions.

Overall impacts

ds4 <- counts_norm %>% group_by(REG, YR = as.factor(year(DATE))) %>% summarise(MVTS = sum(MVTS), MVTS_INT = sum(MVTS_INT)) %>% mutate(VAR_TO_2019 = round((MVTS-MVTS[YR==2019])/MVTS[YR==2019], 2))
#ds4

g1 <- ds4[ds4$YR %in% 2019:2020,] %>% ggplot() + aes(x = REG) +
  geom_col(position = position_dodge()) + aes(y = MVTS, fill = YR) +
  geom_text(position = position_dodge(0.9), vjust = 1.3) + aes(label =  scales::number(MVTS), y = MVTS) +
  scale_y_continuous(labels = scales::number_format(), limits = c(0, 4500000)) +
  scale_fill_brewer(palette = "Paired") +
  labs(title = "Total movements in 2019 and 2020",
       subtitle = "Departures and landings in selected airports",
       x = "Region", y = NULL, fill = "Year") +
  theme_minimal() +
  theme(legend.position = "top",
        legend.title = element_blank(),
        axis.title.x = element_blank())
#g1

g2 <- ds4[ds4$YR %in% 2019:2020,] %>% ggplot(aes(x = REG)) +
  geom_col(aes(y = VAR_TO_2019), fill = "red2") +
  geom_text(data = ds4[ds4$YR == 2020,], aes(y = VAR_TO_2019, label = scales::percent(VAR_TO_2019, accuracy = 1)), nudge_y = 0.1, color = "white") +
  labs(x = "Region") +
  theme_minimal() +
  theme(axis.title = element_blank(),
        axis.ticks.y = element_blank(),
        axis.text.y = element_blank(),
        panel.grid = element_blank(),
        plot.background = element_rect(fill = "white")
        )
#g2

g1 + inset_element(g2, left = 0.85, bottom = 0.7, right = 1, top = 1)

#option 2
#ds4 %>% ggplot(aes(x = YR)) +
#  geom_line(aes(y = MVTS, group = REG, #color = REG)) +
#  scale_y_continuous(limits = c(0, #4500000), labels = scales::label_number())

Both regions registered a severe drop in traffic. In Brazil, the pandemic caused a decrease of 48% in total annual traffic, from 2019 to 2020. In Europe, the reduction was even deeper: 2020 traffic decreased -60% in comparison to 2019 total annual traffic.

Daily Traffic {-}

#defining reference percentile
ref_pct   <- 0.5

#utility function
daily_reg_count <- . %>% 
  group_by(DATE) %>% 
  summarize(MVTS = sum(ARRS, DEPS),
            MVTS_INT = sum(ARRS-ARRS_DOM, DEPS-DEPS_DOM)) %>%
  mutate(MVTS_NORM = MVTS / quantile(MVTS[year(DATE)==2019], probs = ref_pct),
         MVTS_INT_NORM = MVTS_INT / quantile(MVTS_INT[year(DATE)==2019], probs = ref_pct) )

eur_count_norm <- eur_count_airport %>% daily_reg_count() %>% mutate(REG = "EUR")
#creating eur rolling avgs
eur_count_norm <- eur_count_norm %>%
  mutate(MVTS_ROLLAVG = rollmean(MVTS, k = 7, fill = NA),
         MVTS_NORM_ROLLAVG = rollmean(MVTS_NORM, k = 7, fill = NA),
         MVTS_INT_ROLLAVG = rollmean(MVTS_INT, k = 7, fill = NA),
         MVTS_INT_NORM_ROLLAVG = rollmean(MVTS_INT_NORM, k = 7, fill = NA))

bra_count_norm <- bra_count_airport %>% daily_reg_count() %>% mutate(REG = "BRA")
#creating bra rolling avgs
bra_count_norm <- bra_count_norm %>%
  mutate(MVTS_ROLLAVG = rollmean(MVTS, k = 7, fill = NA),
         MVTS_NORM_ROLLAVG = rollmean(MVTS_NORM, k = 7, fill = NA),
         MVTS_INT_ROLLAVG = rollmean(MVTS_INT, k = 7, fill = NA),
         MVTS_INT_NORM_ROLLAVG = rollmean(MVTS_INT_NORM, k = 7, fill = NA))

counts_norm <- bind_rows(bra_count_norm, eur_count_norm)

counts_norm[year(counts_norm$DATE) <= 2020,] %>% ggplot(aes(x = DATE)) +
  geom_point(aes(y = MVTS, colour = REG), alpha = 0.2, size = 0.1) +
  geom_line(aes(y = MVTS_ROLLAVG, colour = REG), size = 1.5) +
  theme_minimal() +
  labs( title    = "Daily Traffic"
       ,subtitle = "Total departures and landings for selected airports"
       ,x = NULL, y = NULL, colour = "Region"
       ,caption = "The points indicate the real number, while the line indicates the 7-day rolling average") +
  scale_colour_manual(values = c("forestgreen", "royalblue")) +
  scale_x_date(date_labels = "%b-%y")

counts_norm[year(counts_norm$DATE) <= 2020,] %>% ggplot(aes(x = DATE)) +
  #geom_point(aes(y = MVTS_NORM, colour = REG), alpha = 0.2, size = 0.1) +
  geom_line(aes(y = MVTS_NORM_ROLLAVG, colour = REG), size = 1.5) +
  theme_minimal() +
  labs( title    = "Daily Traffic - Comparison"
       ,subtitle = "Total movements, normalized by the respective median"
       ,x = NULL, y = NULL, colour = "Region"
       ,caption = "The line indicates the 7-day rolling average") +
  scale_colour_manual(values = c("forestgreen", "royalblue")) +
  scale_x_date(date_labels = "%b-%y")

The initial drop happened first in Europe, but quickly followed by Brazil. During the recovery, Brazil registered a more constant increase in traffic, while Europe had a wider variation, especially during the summer season in the northern hemisphere. At the end of the year, Brazil displayed a relatively higher level of traffic than Europe.

International traffic {-}

## TODO 
#1.explain the definitions of Internationl for Br and EUR
#2.check the connections BR-EUR, via ANAC database
#3. make an alternative graph with reduced timeline? check

counts_norm[year(counts_norm$DATE) <= 2020,] %>% ggplot(aes(x = DATE)) +
  geom_point(aes(y = MVTS_INT, colour = REG), alpha = 0.2, size = 0.1) +
  geom_line(aes(y = MVTS_INT_ROLLAVG, colour = REG), size = 1.5) +
  theme_minimal() +
  labs( title    = "Daily International Traffic"
       ,subtitle = "Total departures and landings for selected airports"
       ,x = NULL, y = NULL, colour = "Region"
       ,caption = "The points indicate the real number, while the line indicates the 7-day rolling average") +
  scale_colour_manual(values = c("forestgreen", "royalblue")) +
  scale_x_date(date_labels = "%b-%y")

counts_norm[year(counts_norm$DATE) <= 2020,] %>% ggplot(aes(x = DATE)) +
  #geom_point(aes(y = MVTS_INT_NORM, colour = REG), alpha = 0.2, size = 0.1) +
  geom_line(aes(y = MVTS_INT_NORM_ROLLAVG, colour = REG), size = 1.5) +
  theme_minimal() +
  labs( title    = "Daily International Traffic - Comparison"
       ,subtitle = "Total movements, normalized by the respective median"
       ,x = NULL, y = NULL, colour = "Region"
       ,caption = "The line indicates the 7-day rolling average") +
  scale_colour_manual(values = c("forestgreen", "royalblue")) +
  scale_x_date(date_labels = "%b-%y")

Impacts on airport level {-}

#-----TO DO: AIRPORT BREAKDOWN
#utility function
annual_count <- . %>% group_by(APT_ICAO, YR = year(DATE)) %>% summarise(MVTS = sum(ARRS, DEPS), MVTS_INT = sum(ARRS - ARRS_DOM, DEPS - DEPS_DOM))

multiple_counts <- . %>% mutate(INT_SHARE = round(MVTS_INT / MVTS, 2), VAR_TO_2019 = round((MVTS-MVTS[YR==2019])/MVTS[YR==2019], 2))

ds1 <- eur_count_airport %>% annual_count() %>% multiple_counts() %>% mutate(REG = "EUR")
ds2 <- bra_count_airport %>% annual_count() %>% multiple_counts() %>% mutate(REG = "BRA")
ds3 <- bind_rows(ds1, ds2)
#ds3

#ds3 %>% ggplot(aes(x = reorder(APT_ICAO, #MVTS))) +
#  geom_col(aes(y = MVTS, fill = factor(YR)), #position = "dodge") +
#  facet_grid(.~REG, scales = "free_x") +
#  scale_y_continuous(labels = #scales::label_number()) +
#  theme(axis.text.x = element_text(angle = #90, vjust = 0.5), axis.ticks = #element_blank())

ds3 %>% filter(YR == 2020) %>%
  ggplot(aes(x = reorder(APT_ICAO, VAR_TO_2019))) +
  geom_col(aes(y = VAR_TO_2019, fill = REG), width = 0.8) +
  geom_text(aes(y = VAR_TO_2019,
                 label = scales::percent(VAR_TO_2019, accuracy = 1),
                 ),
             size = 2.8,
             nudge_y = 0.04,
             show.legend = FALSE,
             color = "white") +
  scale_y_continuous(labels = scales::percent_format(), limits = c(-0.8,0)) +
  theme_minimal() +
  labs(title = "Impacts on airports",
       subtitle = "Variation to 2019 traffic",
       fill = NULL) +
  coord_flip() +
  theme(axis.title = element_blank(),
        legend.position = "top", aspect.ratio = 1) +
  scale_fill_manual(values = c("forestgreen", "royalblue"))

2021 and recent trends

TODO - same, but for jan-apr21 / jan-apr2019

euctrl-pru/international-BRA-EUR documentation built on May 12, 2022, 6:45 p.m.