Ao longo desta semana, você deverá desenvolver código em R, utilizando-se de tidyverse, ggplot, leaftlet, ggcal e outros pacotes disponibilizados em HTML Widgets para responder uma questão relacionada ao conjunto de dados flights. Para tanto, considere os seguintes fatos: • Cias Aéreas (AIRLINE) possuem diferentes aeronaves (codificadas em TAIL_NUMBER); • (Exemplo hipotético) No dia 01/01/2015, a aeronave N431WN viaja de BWI para JFK; • (Exemplo hipotético) No dia 02/01/2015, a aeronave N431WN viaja de JFK para ORD‘; • E assim sucessivamente… No caso apontado acima, pode-se ver que a aeronave N431WN realizou um trajeto (provavelmente único) durante todo o ano de 2015. Nos dias exemplificados, o trajeto foi BWI-JFK-ORD.
Parte 1: Crie uma função que: a. Receba um valor de TAIL_NUMBER (por exemplo, N431WN); b. Produza uma tabela (tidy) com todos os trajetos realizados pela aeronave (ordenadas por data e hora, contendo todas as colunas do arquivo flights.csv.zip); c. Produza um mapa que apresente todo o trajeto voado pela aeronave ao longo de todo o ano; o trajeto deve ser apresentado de maneira linear no tempo (i.e., segue a sequência do tempo, como no exemplo hipotético dado acima); d. O mapa deve ser decorado com estatísticas do seu interesse (por exemplo, velocidade média do vôo como espessura da linha que conecta os aeroportos envolvidos no trajeto);
# Carrega bibliotecas necessárias# Caso seja necessário, instale e carregue o pacote vroom #install.packages("vroom")#library(vroom)library(readr) # para leitura de arquivos (inclui read_csv e leitura em chunks)
Warning: package 'readr' was built under R version 4.3.3
library(dplyr) # manipulação de dados
Attaching package: 'dplyr'
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
library(lubridate) # trabalhar com datas
Attaching package: 'lubridate'
The following objects are masked from 'package:base':
date, intersect, setdiff, union
library(leaflet) # criar mapas interativoslibrary(RColorBrewer) # paletas de coreslibrary(scales) # funções de escalonamento (rescale)
Warning: package 'scales' was built under R version 4.3.3
Attaching package: 'scales'
The following object is masked from 'package:readr':
col_factor
# Função que analisa os voos de uma aeronave específica (tail_number) a partir de um arquivo zipanalisa_aeronave <-function(tail_number, arquivo_zip) {# ---- 1. Lê o arquivo de aeroportos ----# Importa o arquivo "airports.csv" e mantém apenas código IATA, latitude e longitude airports <-read_csv("airports.csv") %>%select(IATA_CODE, LATITUDE, LONGITUDE)# Cria um tibble vazio para armazenar os voos filtrados voos_filtrados <-tibble()# Função callback que será aplicada a cada chunk do flights.csv callback <-function(x, pos) { x %>%filter(TAIL_NUMBER == tail_number) %>%# filtra somente os voos da aeronave escolhidatransmute( # seleciona e renomeia colunas de interesse YEAR, MONTH, DAY, AIRLINE, FLIGHT_NUMBER, TAIL_NUMBER, ORIGIN_AIRPORT, DESTINATION_AIRPORT, DEPARTURE_TIME, ARRIVAL_TIME, DISTANCE, AIR_TIME,FLIGHT_DATE =make_date(YEAR, MONTH, DAY) # cria uma coluna de data completa ) %>%bind_rows(voos_filtrados, .) ->> voos_filtrados # acumula no objeto voos_filtrados }# Abre a conexão para ler flights.csv dentro do arquivo zip con <-unz(arquivo_zip, "flights.csv")# Lê o arquivo em chunks de 100.000 linhas, aplicando a função callbackread_csv_chunked( con,callback = SideEffectChunkCallback$new(callback),chunk_size =100000,progress =FALSE# mostra progresso na leitura )# Caso não tenha encontrado nenhum voo para o tail_number informadoif (nrow(voos_filtrados) ==0) {warning("Nenhum voo encontrado para a aeronave ", tail_number) # avisareturn(list(tabela = voos_filtrados, grafico =NULL)) # retorna vazio }# ---- 2. Ordenar e calcular estatísticas ---- voos_filtrados <- voos_filtrados %>%arrange(FLIGHT_DATE, DEPARTURE_TIME) %>%# ordena por data e horáriomutate(VELOCIDADE_MEDIA =ifelse(AIR_TIME >0, DISTANCE / (AIR_TIME /60), NA) # calcula velocidade média (milhas por hora) ) %>%mutate(espessura_linha = scales::rescale(VELOCIDADE_MEDIA, to =c(1, 6), na.rm =TRUE) # normaliza espessura da linha no mapa )# ---- 3. Paleta de cores (12 meses) ---- paleta <-brewer.pal(12, "Paired") # cria 12 cores distintas (uma para cada mês)# ---- 4. Criar mapa ---- mapa <-leaflet(voos_filtrados) %>%addTiles() # inicia mapa com fundo padrão# Adiciona linhas representando cada voofor (i in1:nrow(voos_filtrados)) {# Busca coordenadas do aeroporto de origem origem <- airports %>%filter(IATA_CODE == voos_filtrados$ORIGIN_AIRPORT[i])# Busca coordenadas do aeroporto de destino destino <- airports %>%filter(IATA_CODE == voos_filtrados$DESTINATION_AIRPORT[i])# Se encontrou as coordenadas de origem e destinoif (nrow(origem) >0&nrow(destino) >0) { mapa <- mapa %>%addPolylines(lng =c(origem$LONGITUDE, destino$LONGITUDE), # longitude da origem e destinolat =c(origem$LATITUDE, destino$LATITUDE), # latitude da origem e destinoweight = voos_filtrados$espessura_linha[i], # espessura da linha proporcional à velocidade médiacolor = paleta[voos_filtrados$MONTH[i]], # cor de acordo com o mês do vooopacity =0.7, # transparênciapopup =paste0( # caixa de informação quando clicar"Voo: ", voos_filtrados$ORIGIN_AIRPORT[i], " → ", voos_filtrados$DESTINATION_AIRPORT[i],"<br>Data: ", voos_filtrados$FLIGHT_DATE[i],"<br>Velocidade média: ", round(voos_filtrados$VELOCIDADE_MEDIA[i], 1), " mph" ) ) } }# Identifica todos os aeroportos visitados (origem e destino únicos) aeroportos_visitados <-unique(c(voos_filtrados$ORIGIN_AIRPORT, voos_filtrados$DESTINATION_AIRPORT)) coords_aero <- airports %>%filter(IATA_CODE %in% aeroportos_visitados)# Adiciona marcadores nos aeroportos visitados mapa <- mapa %>%addCircleMarkers(lng = coords_aero$LONGITUDE,lat = coords_aero$LATITUDE,radius =4,color ="red",popup = coords_aero$IATA_CODE ) %>%# ---- 5. Legenda de cores ----addLegend("bottomright",colors = paleta, # cores da legendalabels = month.name, # nomes dos mesestitle ="Mês do voo", # título da legendaopacity =0.9 )# Retorna a tabela de voos filtrados e o gráfico (mapa interativo)return(list(tabela = voos_filtrados,grafico = mapa ))}# ---------- Exemplo de uso ----------# Chama a função para analisar voos da aeronave "N431WN" no arquivo flights.csv.zipresultado <-analisa_aeronave("N431WN", "flights.csv.zip")
Rows: 322 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): IATA_CODE, AIRPORT, CITY, STATE, COUNTRY
dbl (2): LATITUDE, LONGITUDE
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
── Column specification ────────────────────────────────────────────────────────
cols(
.default = col_double(),
AIRLINE = col_character(),
TAIL_NUMBER = col_character(),
ORIGIN_AIRPORT = col_character(),
DESTINATION_AIRPORT = col_character(),
SCHEDULED_DEPARTURE = col_character(),
DEPARTURE_TIME = col_character(),
WHEELS_OFF = col_character(),
WHEELS_ON = col_character(),
SCHEDULED_ARRIVAL = col_character(),
ARRIVAL_TIME = col_character(),
CANCELLATION_REASON = col_character()
)
ℹ Use `spec()` for the full column specifications.
Warning in validateCoords(lng, lat, funcName): Data contains 1 rows with either
missing or invalid lat/lon values and will be ignored
# Abre a tabela resultante em uma aba do RStudioView(resultado$tabela)# Salva o mapa como arquivo HTML e abre no navegadorresultado$grafico %>% htmlwidgets::saveWidget("mapa.html")browseURL("mapa.html")