University of Iowa

College of Liberal Arts and Sciences

• STAT:4580
• Syllabus
• Outline
• Homework
• Notes
• Resources
-->

Assignment 6 Notes

1. Highway Fuel Economy Over the Years, Revisited

library(readr)
if (! file.exists("vehicles.csv.zip"))
    download.file("http://www.stat.uiowa.edu/~luke/data/vehicles.csv.zip",
                  "vehicles.csv.zip")
newmpg <- read_csv("vehicles.csv.zip", guess_max = 100000)
newmpg3 <- filter(newmpg, year <= 2025, year >= 2000) |>
    mutate(year = factor(year))

All four approaches, with only minimal tuning for the three new ones:

alpha <- 0.2
size <- 0.3
thm <- theme_minimal() + theme(text = element_text(size = 16))
library(ggridges)
library(patchwork)
p1 <- ggplot(newmpg3, aes(x = highway08, y = year)) +
    geom_point(position = "jitter", size = size, alpha = alpha) +
    ylab(NULL) +
    thm
p2 <- ggplot(newmpg3, aes(y = highway08, x = year)) +
    geom_boxplot() +
    thm +
    coord_flip()
p3 <- ggplot(newmpg3, aes(y = highway08, x = year)) +
    geom_violin() +
    thm +
    coord_flip()
p4 <- ggplot(newmpg3, aes(x = highway08, y = year)) +
    geom_density_ridges() +
    thm

(p1 | p2) / (p3 | p4)
## Picking joint bandwidth of 1.43

The three new approaches do a better job of conveying the increase in fuel economy for the bulk of the vehicles. Both violin and ridgeline plots show the slight bimodal structure in the early years; box plots cannot reflect this. Box plots put a high emphasis on the electric vehicles; this can be reduced by adjusting the point size used. Strip plots also allow the emerging electric vehicles to be seen. Violin plots and ridgeline plots do not show these very well as they are still too small a proportion of the total. The fact that violin plots stop at the maximum helps somewhat. The current geom_density_ridges implementation does not do this but could in principle be modified to do so.

2. Top Fleet Highway Gas Mileages

The following table shows the manufacturers with top five fleet average highway gas mileage values and the corresponging average city gas mileages:

library(readr)
if (! file.exists("vehicles.csv.zip"))
    download.file("http://www.stat.uiowa.edu/~luke/data/vehicles.csv.zip",
                  "vehicles.csv.zip")
newmpg <- read_csv("vehicles.csv.zip", guess_max = 100000)

tbl <- filter(newmpg, year == 2025) |>
    group_by(make) |>
    summarize(avg_hwy = mean(highway08),
              avg_cty = mean(city08)) |>
    ungroup() |>
    slice_max(avg_hwy, n = 5) |>
    arrange(desc(avg_hwy))
names(tbl) <- c("Make", "Highway", "City")
kbl <- knitr::kable(tbl, format = "html", digits = 1)
kableExtra::kable_styling(kbl, full_width = FALSE)

Make	Highway	City
Lucid	110.1	116.5
Fiat	102.0	124.0
Tesla	99.0	112.2
Polestar	86.6	98.3
Vinfast	73.4	77.6

3. Top Destinations

The top four destinations are shown in the following table:

top_nyc_dest <- count(flights, dest) |> slice_max(n, n = 4)
kbl <- knitr::kable(top_nyc_dest, format = "html")
kableExtra::kable_styling(kbl, full_width = FALSE)

dest	n
ORD	17283
ATL	17215
LAX	16174
BOS	15508

The flights to these locations can be selected using semi_join. After using count to compute the number of flights to each origin/destination the counts for each destination can be converted to proportion with a grouped mutate. The resulting faceted bar chart:

top_nyc_dest <- count(flights, dest) |> slice_max(n, n = 4)

semi_join(flights, top_nyc_dest, "dest") |>
    count(origin, dest) |>
    group_by(dest) |>
    mutate(prop = n / sum(n)) |>
    ungroup() |>
    ggplot() +
    geom_col(aes(x = origin, y = prop), fill = "deepskyblue3") +
    facet_wrap(~ dest, ncol = 1) +
    thm +
    labs(x = "Origin", y = "Proportion")

There are no flights from LGA to LAX and few from JFK to either ATL or ORD.

4. Summer-Only Destinations

fs <- filter(flights, month %in% 6 : 8) |> select(dest) |> unique()
fn <- filter(flights, ! (month %in% 6 : 8)) |> select(dest) |> unique()
summer_only <- anti_join(fs, fn, "dest")
summer_dest <- semi_join(airports, summer_only, c(faa = "dest")) |>
   select(faa, name)
flight_counts <- count(flights, dest)
summer_dest <- left_join(summer_dest, flight_counts, c("faa" = "dest"))

There were 3 destinations with flights only in June through August:

knitr::kable(summer_dest, format = "html") |>
    kableExtra::kable_styling(full_width = FALSE)

faa	name	n
ANC	Ted Stevens Anchorage Intl	8
LGA	La Guardia	1
TVC	Cherry Capital Airport	101

Apparently there was a flight on US Airways from EWR to LGA on July 27.

5. High Altitude Destinations

The destinations at altitudes above 5,000 feet and the number of flights in 2013 from New York City to these destinations were:

airports1 <- select(airports, faa, name, alt)
left_join(flights, airports1, c("dest" = "faa")) |>
    filter(alt > 5000) |>
    count(dest, name, alt) |>
    select(FAA = dest, Name = name, Altitude = alt, Flights = n) |>
    knitr::kable(format = "html") |>
    kableExtra::kable_styling(full_width = FALSE)

FAA	Name	Altitude	Flights
ABQ	Albuquerque International Sunport	5355	254
DEN	Denver Intl	5431	7266
EGE	Eagle Co Rgnl	6540	213
HDN	Yampa Valley	6602	15
JAC	Jackson Hole Airport	6451	25
MTJ	Montrose Regional Airport	5759	15

This work is licensed under the CC BY-NC 3.0 Creative Commons License.