Analise exploratória
A analise será feita no datasete bfd_2019.
O objetivo é analisar e falar sobre o que tem na base assim como detalhes importantes e descobertas, assim gerando perguntas sobre o tema
A base consiste em 983396 contendo 48 colunas, a documentação sobre os atributos estão em documentação
carregando a basse e as lib que serão utilizadas
dados <- get(load(url("https://raw.githubusercontent.com/eogasawara/datamining/main/data-work/bfd_2019.rdata")))obtendo algumas informações sobre a base
dim(dados)## [1] 983396 48str(dados)## 'data.frame': 983396 obs. of 48 variables:
## $ arrival : chr "CYUL" "CYUL" "CYUL" "CYUL" ...
## $ depart : chr "SBGR" "SBGR" "SBGR" "SBGR" ...
## $ route : chr "SBGR-CYUL" "SBGR-CYUL" "SBGR-CYUL" "SBGR-CYUL" ...
## $ company : chr "ACA" "ACA" "ACA" "ACA" ...
## $ flight : chr "0097" "0097" "0097" "0097" ...
## $ di : num 0 0 0 0 0 0 0 0 0 0 ...
## $ type : chr "I" "I" "I" "I" ...
## $ depart_day_period : Ord.factor w/ 7 levels "Night"<"Early Morning"<..: 2 2 2 2 2 2 2 2 2 7 ...
## $ arrival_day_period : Ord.factor w/ 7 levels "Night"<"Early Morning"<..: 6 6 6 6 6 6 6 6 6 2 ...
## $ expected_depart : POSIXlt, format: "2019-12-12 08:40:00" "2019-12-14 08:40:00" ...
## $ real_depart : POSIXlt, format: "2019-12-12 09:07:00" "2019-12-14 08:40:00" ...
## $ expected_arrival : POSIXlt, format: "2019-12-12 18:45:00" "2019-12-14 18:45:00" ...
## $ real_arrival : POSIXlt, format: "2019-12-12 19:34:00" "2019-12-14 18:45:00" ...
## $ status_depart : chr "Pontual" "Pontual" "Pontual" "Pontual" ...
## $ status_arrival : chr "Atraso 30-60" "Pontual" "Pontual" "Atraso 30-60" ...
## $ observation : chr "CONEXÃO DE AERONAVE" NA NA "CONEXÃO DE AERONAVE" ...
## $ delay_depart : num 27 0 0 15 7 0 0 0 -1 0 ...
## $ delay_arrival : num 49 0 0 38 34 0 0 0 2 0 ...
## $ expected_flight_length : num 605 605 605 605 605 605 605 605 605 615 ...
## $ real_flight_length : num 627 605 605 628 632 605 605 605 608 615 ...
## $ outlier_depart_delay : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ outlier_arrival_delay : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ outlier_expected_flight_consistency: logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ outlier_real_flight_consistency : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ outlier_expected_flight_length : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ outlier_real_flight_length : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ depart_air_temperature : num 21 23 26 21 24 20 23 23 20 23 ...
## $ depart_dew_point : num 19 19 18 20 19 20 20 20 19 23 ...
## $ depart_relative_humidity : num 88.3 78.2 61.4 94 73.6 ...
## $ depart_wind_direction : num 270 90 20 130 320 320 70 90 60 100 ...
## $ depart_wind_speed : num 2 5 9 5 13 2 6 3 9 3 ...
## $ depart_sky_coverage : chr NA "SCT" NA "OVC" ...
## $ depart_pressure : num 29.9 30.2 30 30.1 30 ...
## $ depart_visibility : num 6.21 6.21 6.21 6.21 6.21 4.97 6.21 6.21 5.59 6.21 ...
## $ depart_apparent_temperature : num 21 23 26 21 24 ...
## $ depart_wind_speed_scale : Ord.factor w/ 11 levels "Calm"<"Light Air"<..: 2 3 4 3 5 2 3 2 4 2 ...
## $ depart_wind_direction_cat : Ord.factor w/ 16 levels "N"<"NNE"<"NE"<..: 13 5 2 7 15 15 4 5 4 5 ...
## $ arrival_air_temperature : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_dew_point : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_relative_humidity : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_wind_direction : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_wind_speed : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_sky_coverage : chr NA NA NA NA ...
## $ arrival_pressure : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_visibility : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_apparent_temperature : num NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_wind_speed_scale : Ord.factor w/ 11 levels "Calm"<"Light Air"<..: NA NA NA NA NA NA NA NA NA NA ...
## $ arrival_wind_direction_cat : Ord.factor w/ 16 levels "N"<"NNE"<"NE"<..: NA NA NA NA NA NA NA NA NA NA ...À primeira vista, observamos que o conjunto de dados possui diversos pontos que podem ser explorados. Para seguir um caminho de análise, vamos examinar algumas colunas específicas e, a partir delas, destacar certos aspectos de forma mais detalhada.
Por exemplo, as colunas expected_depart,
real_depart, expected_arrival e
real_arrival são variáveis temporais. Elas indicam os
horários programados (expected_) e os horários reais
(real_) de partida e chegada dos voos.
As informações de atraso ou adiantamento estão refletidas nas colunas
delay_depart e delay_arrival. A coluna
delay_depart indica quanto tempo o voo partiu após ou antes
do horário previsto. Quando o valor é negativo, como por exemplo -7,
significa que o voo saiu 7 minutos adiantado. Já a coluna
delay_arrival mostra o tempo de atraso ou adiantamento na
chegada, com base na diferença entre expected_arrival e
real_arrival.
A lógica é que, quanto maior o atraso na saída, maior a probabilidade de ele impactar também o horário de chegada ao destino.
A coluna observation trás informações sobre o voo o que nos esclarece muitas coisas, sobre o que está acontecendo com o voo.
library(dplyr)##
## Anexando pacote: 'dplyr'## Os seguintes objetos são mascarados por 'package:stats':
##
## filter, lag## Os seguintes objetos são mascarados por 'package:base':
##
## intersect, setdiff, setequal, unionobs_mais_comuns <-dados %>%
filter(!is.na(observation)) %>%
count(observation, sort = TRUE)
head(obs_mais_comuns, 20)Note que temos cerca de 45 tipos de observações diferentes, para reduzir a dimenção por problemas semelhantes vamos criar uma variavel com o proposito de agregar dados semelhantes
summary(dados$delay_depart)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -525615.00 -5.00 0.00 -3.54 4.00 132895.00 18135como podemos observar temos valores outliers
summary(dados$delay_arrival)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## -525623.0 -10.0 0.0 -4.3 2.0 305314.0 18135vamos ver a distribuição geral
dados %>%
filter(delay_depart >= -500, delay_depart <= 500) %>%
summarise(
min = min(delay_depart, na.rm = TRUE),
max = max(delay_depart, na.rm = TRUE),
mean = mean(delay_depart, na.rm = TRUE),
median = median(delay_depart, na.rm = TRUE)
)A mediana = 0 indica que mais da metade dos voos não tiveram atraso (ou partiram no horário). A média positiva (4.79 min) mostra que, no geral, os voos atrasam levemente. Os valores extremos originais (como 305314 ou -525623) provavelmente são erros ou registros inválidos.
library(ggplot2)
library(dplyr)
library(tidyr)
tempo <- 100
# Filtrar valores extremos para visualização
dados_filtrados <- dados %>%
filter(
delay_depart >= - tempo, delay_depart <= tempo,
delay_arrival >= - tempo, delay_arrival <= tempo
)
# Transformar para formato longo
dados_long <- dados_filtrados %>%
pivot_longer(cols = c(delay_depart, delay_arrival),
names_to = "tipo_delay",
values_to = "delay")
# Plotar histograma com cores por tipo de atraso
ggplot(dados_long, aes(x = delay, fill = tipo_delay)) +
geom_histogram(alpha = 0.5, position = "identity", binwidth = 10, color = "white") +
scale_fill_manual(values = c("delay_depart" = "steelblue", "delay_arrival" = "darkred"),
labels = c("Partida", "Chegada")) +
labs(
title = "Distribuição dos Atrasos",
x = "Atraso (minutos)",
y = "Frequência",
fill = "Tipo de Atraso"
) +
theme_minimal()
Assim conseguimos agrupar a categorização
library(stringr)
dados <- dados %>%
mutate(obs_categoria = case_when(
str_detect(observation, regex("LIBERAÇÃO|PLANO DE VOO|ANTECIPAÇÃO|AUTORIZAD[AO]", ignore_case = TRUE)) ~ "Tráfego aéreo / Autorização",
str_detect(observation, regex("DEFEITO|TROCA DE AERONAVE|AVARIA|PANE|DEGELO", ignore_case = TRUE)) ~ "Problema na aeronave",
str_detect(observation, regex("CONEXÃO AERONAVE|VOO DE IDA", ignore_case = TRUE)) ~ "Conexão",
str_detect(observation, regex("METEOROLÓGICAS|ABAIXO LIMITES|GELO|NEVE|LAMA", ignore_case = TRUE)) ~ "Clima",
str_detect(observation, regex("AEROPORTO .*INTERDITADO|RESTRIÇÃO|FACILIDADES|DESTINO INTERDITADO|ALTERNATIVA", ignore_case = TRUE)) ~ "Infraestrutura Aeroportuária",
str_detect(observation, regex("EQUIPO|ABASTECIMENTO|DESTANQUEIO|OPERAÇÕES EM SOLO", ignore_case = TRUE)) ~ "Falha de equipamentos/apoio",
str_detect(observation, regex("SEGURANÇA|PAX|CARGA|ALFÂNDEGA|MIGRAÇÃO", ignore_case = TRUE)) ~ "Segurança / Passageiros / Alfândega",
str_detect(observation, regex("^CANCELAMENTO", ignore_case = TRUE)) ~ "Cancelamento técnico ou climático",
str_detect(observation, regex("FERIADO|VOO ESPECIAL|INCLUSÃO DE ETAPA", ignore_case = TRUE)) ~ "Outros específicos",
str_detect(observation, regex("ATRASOS NÃO ESPECÍFICOS", ignore_case = TRUE)) ~ "Outros não específicos",
TRUE ~ "Outros não específicos"
))
atrasos_por_categoria <- dados %>%
group_by(obs_categoria) %>%
summarise(
media_atraso_depart = mean((delay_arrival - delay_depart), na.rm = TRUE),
total_voos = n()
) %>%
arrange(desc(media_atraso_depart))
atrasos_por_categoriapara enteder melhor o que está acontecendo com esses voo com o tempo de viagem tão longo, podemos observar seus atributos de tempo
library(dplyr)
library(ggplot2)
# 1. Filtrar voos com delay_depart ou delay_arrival > 500 minutos
voos_extremos <- dados %>%
filter(delay_depart > 500 | delay_arrival > 500)
# 2. Ver as observações mais comuns
voos_extremos %>%
count(obs_categoria, sort = TRUE)voos_extremos %>%
count(obs_categoria, sort = TRUE) %>%
slice_head(n = 15) %>%
ggplot(aes(x = reorder(obs_categoria, n), y = n)) +
geom_col(fill = "#0072B2") +
coord_flip() +
labs(
title = "Principais observações em voos com atraso > 500 min",
x = "Observação",
y = "Número de voos"
) +
theme_minimal()
descrição de type: (N) Nacional, (I) Internacional, (R) Regional, (H) Sub-regional, (E) Especial, (c) frete/carga, (g) frete/carga internacional e (l) rede postal;
library(dplyr)
voos_atraso_chegada_grande <- dados %>%
filter(
delay_arrival > 60,
!type %in% c("C", "G", "L"),
abs(expected_flight_length - real_flight_length) > 60
) %>%
select(route, type, expected_flight_length, real_flight_length, observation)
head(voos_atraso_chegada_grande, 10)aqui podemos observar que mesmo com a demora para o voo sair e chegar a maior parte dos voos não tem tanta diferença de voo, porém se observamos os voos que tem uma janela de mais de 1 hora de expectativa de chegada temos o seguinte grafico
library(dplyr)
library(ggplot2)
obs_counts <- dados %>%
filter(
delay_arrival > 60,
!type %in% c("C", "G", "L"),
abs(expected_flight_length - real_flight_length) > 60
) %>%
count(obs_categoria, sort = TRUE) %>%
slice_head(n = 10)
ggplot(obs_counts, aes(x = reorder(obs_categoria, n), y = n)) +
geom_col(fill = "steelblue") +
geom_text(aes(label = n), hjust = -0.1, size = 3.5) +
coord_flip() +
labs(
title = "Observações para voos com grande discrepância de tempo",
x = "Observação",
y = "Contagem"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
axis.text.y = element_text(size = 10),
plot.margin = margin(t = 20, r = 20, b = 20, l = 20) # aumenta as margens
) +
scale_y_continuous(expand = expansion(mult = c(0, 0.1)))
library(ggplot2)
library(dplyr)
dados_plot <- atrasos_por_categoria %>%
filter(!is.na(media_atraso_depart), !is.nan(media_atraso_depart), is.finite(media_atraso_depart))
ggplot(dados_plot, aes(x = reorder(obs_categoria, media_atraso_depart), y = media_atraso_depart)) +
geom_col(fill = "steelblue") +
coord_flip() +
labs(x = "Categoria", y = "Média da Diferença de Atraso (chegada - partida)",
title = "Atraso Médio por Categoria de Observação") +
theme_minimal()
um detalhe muito interessante sobre as colunas status é que ela fala se o avião saiu no horário certo ou quando em qual ponto está o atraso do voo está em de 30 em 30 minutos
library(dplyr)
dados_contagem <- dados %>%
count(status_depart, status_arrival)
dados_contagempara ficar melhor de vizualizar
library(ggplot2)
niv <- c("Antecipado", "Pontual", "Atraso 30-60", "Atraso 60-120", "Atraso 120-240", "Atraso >240")
dados_contagem$status_depart <- factor(dados_contagem$status_depart, levels = niv)
dados_contagem$status_arrival <- factor(dados_contagem$status_arrival, levels = niv)
ggplot(dados_contagem, aes(x = status_depart, y = status_arrival)) +
geom_point(aes(size = n, color = n), alpha = 0.7) +
geom_text(aes(label = n), vjust = -0.8, size = 3.2) +
scale_size_continuous(range = c(2, 15)) +
scale_color_viridis_c() +
theme_minimal() +
labs(
x = "Status na Partida",
y = "Status na Chegada",
title = "Relação entre Status de Partida e Chegada",
size = "Contagem",
color = "Contagem"
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
vamos ver no mapa
library(shiny)
library(leaflet)
library(geosphere)##
## Anexando pacote: 'geosphere'## O seguinte objeto é mascarado por 'package:shiny':
##
## spanlibrary(readr)
library(dplyr)
aeroportos <- read_csv("https://ourairports.com/data/airports.csv", show_col_types = FALSE)
aeroportos_icao <- aeroportos %>%
select(ident, name, latitude_deg, longitude_deg)
get_cor_tipo <- function(tipo) {
if (tipo == "I") return("red")
if (tipo == "N") return("blue")
return("gray")
}nesse bloco conseguimos a latitude e longitude dos aeroportos, e vamos usar a escala de cor vermelhor para voos internacionais e N para voos nacionais.
library(leaflet)
library(dplyr)
rotas_df <- voos_atraso_chegada_grande %>%
mutate(
origem = sub("-.*", "", route),
destino = sub(".*-", "", route)
)
rotas_geo <- rotas_df %>%
left_join(aeroportos_icao, by = c("origem" = "ident")) %>%
rename(lat_origem = latitude_deg, lon_origem = longitude_deg, nome_origem = name) %>%
left_join(aeroportos_icao, by = c("destino" = "ident")) %>%
rename(lat_destino = latitude_deg, lon_destino = longitude_deg, nome_destino = name) %>%
mutate(diff = as.numeric(real_flight_length) - as.numeric(expected_flight_length))
df_filtrado <- rotas_geo %>% filter(diff > 100) %>% filter(type=='I') # I ou N
mapa <- leaflet(df_filtrado) %>%
addTiles()
for (i in 1:nrow(df_filtrado)) {
origem <- c(df_filtrado$lon_origem[i], df_filtrado$lat_origem[i])
destino <- c(df_filtrado$lon_destino[i], df_filtrado$lat_destino[i])
if (any(is.na(origem)) || any(is.na(destino))) next
cor_linha <- get_cor_tipo(df_filtrado$type[i])
rota <- geosphere::gcIntermediate(origem, destino, n = 100, addStartEnd = TRUE, sp = TRUE)
mapa <- mapa %>% addPolylines(data = rota, color = cor_linha, weight = 2)
}
mapa