5 Who Invited a Map to the Table Contest?

I did. Guilty as charged. It’s time to actually make some tables!

5.1 The Map Table Function

Spoiler: we’re going to write a function that’ll produce gt tables for each aircraft in our dataset. Why? Well, it has to do a little bit with how mapgl works.

Sidebar that mapgl is a very cool package that brings Maplibre and Mapbox mapping capabilities to R, specifically for Quarto and Shiny apps. Maplibre and Mapbox provide functionality for tables that show up on-hover and on-click over geometric features. Maybe I haven’t scoured the internet long enough, but, generally, when I see a table in a mapgl map, it looks something like this:

Nothing wrong with this table. It just doesn’t fully utilize the capabilities Maplibre has to offer. If we look at the reprex that the author of mapgl, Kyle Walker, provides for producing these pop-ups:

fl_age$popup <- glue::glue(
  "<strong>GEOID: </strong>{fl_age$GEOID}<br><strong>Median age: </strong>{fl_age$estimate}"
)

Interesting… it’s HTML. Wait. Aren’t gt tables HTML? Sure are! Especially when we pass as_raw_html() after creating them. Turns out, mapgl does a great job at rendering these tables for use in maps!

Back to the reason about why we’re producing a function to make gt tables on a per-row basis. We’re going to use this function, in combination with map and mutate, to contain the HTML needed to render the table in a column. We’ll then call that column inside our Maplibre functions. Simple enough, hopefully.

Alright, well it’s probably easiest if we build an initial draft of the table first, then worry about the function part.

First, let’s get the data we actually want to map. We have fleet info, we have an aircraft’s state vector (which includes the aircraft’s present callsign), and we have a way to get the route information from a callsign. Let’s join these tables up together using a series of left joins. We’ll actually need to include the registration info in the data we derived from OpenSky, which only contains the icao24 address. Luckily, we have the get_registration_from_icao24() function for this purpose.

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.1     ✔ stringr   1.5.2
✔ ggplot2   4.0.0     ✔ tibble    3.3.0
✔ lubridate 1.9.4     ✔ tidyr     1.3.1
✔ purrr     1.1.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(sfarrow)
library(gt)
library(sf)

Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.4.0; sf_use_s2() is TRUE

library(httr2)
library(glue)
united_full_fleet_info <- read_csv("data/united_full_fleet_info.csv")

Rows: 1056 Columns: 14
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (14): aircraft_model, registration, delivered, config, ife, wifi, power,...

ℹ 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.

### In the reprex/GitHub repo, I source these from a script, "support_functions.R"
get_registration_from_icao24 <- function(icao24, return_tibble = TRUE) {
  tryCatch(
    {
      registration <- request("https://api.adsbdb.com/v0/mode-s/") |>
        req_url_path_append(icao24) |>
        req_perform() |>
        resp_body_json()

      if (return_tibble) {
        return(as_tibble(registration$response) |> rename(registration = value))
      } else {
        return(registration$response)
      }
    },
    error = function(e) {
      log_error("{icao24} encountered error {e}")
      return(NULL)
    }
  )
}

get_route_information <- function(callsign) {
  tryCatch(
    {
      json <- list(
        planes = list(list(callsign = callsign, lat = 0, lng = 0))
      )

      route <- request("https://api.adsb.lol/api/0/routeset/") |>
        req_body_json(json) |>
        req_perform() |>
        resp_body_json()

      route <- route[[1]] |> as_tibble()
      if (nrow(route) > 2) {
        stop(
          "Callsign has multiple routes or a multi-leg route. Unable to determine routing."
        )
      }
      route_origin <- route[1, ] |>
        unnest_wider(`_airports`, names_sep = "_") |>
        rename_all(~ glue("origin_{.x}"))
      route_destination <- route[2, ] |>
        unnest_wider(`_airports`, names_sep = "_") |>
        rename_all(~ glue("destination_{.x}"))

      route <- bind_cols(route_origin, route_destination) |>
        rename_all(~ str_replace_all(.x, "__", "_")) |>
        mutate(callsign = callsign)

      return(route)
    },
    error = function(e) {
      log_error("Error getting route info for {callsign} {e}")
      route <- tibble(
        origin_airports_iata = NA,
        origin_airports_name = NA,
        origin_airports_countryiso2 = NA,
        origin_plausible = NA,
        destination_airports_iata = NA,
        destination_airports_name = NA,
        destination_airports_countryiso2 = NA,
        destination_plausible = NA,
      )
      return(route)
    }
  )
}
###

united_10_positions <- st_read_parquet("data/state_vector.parquet") |>
  mutate(
    registration = map_chr(icao24, \(x) {
      get_registration_from_icao24(x, return_tibble = F)
    })
  ) |>
  st_as_sf()

I’ve called a bunch of these objects united_10_* due to my original plan to pull 10 aircraft every 15 minutes (40 * 4 = 160 * 24 = 3840 API credits). We’ll want to get the barometric altitude that we stored in the simple features coordinates back out into its own column so we can show that in a table, which we can do using st_coordinates(x)[,3].¹

united_10_positions <- left_join(
  united_10_positions |>
    mutate(baro_altitude = st_coordinates(united_10_positions)[, 3]),
  united_full_fleet_info
)

Joining with `by = join_by(registration)`

route_info <- bind_rows(
  map(united_10_positions |> drop_na(callsign) |> pull(callsign), \(x) {
    get_route_information(x)
  })
)
united_10_positions <- left_join(united_10_positions, route_info) |>
  drop_na(callsign)

Joining with `by = join_by(callsign)`

gt doesn’t really play well with sf geometries, so let’s create an object with those removed:

united_10_gt <- united_10_positions |> as_tibble() |> drop_na(callsign)

Let’s take a peek at the schema real quick:

united_10_gt

# A tibble: 1 × 61
  time                icao24 callsign origin_country time_position      
  <dttm>              <chr>  <chr>    <chr>          <dttm>             
1 2025-10-01 23:05:56 a126cc UAL2353  United States  2025-10-01 23:05:56
# ℹ 56 more variables: last_contact <dttm>, on_ground <lgl>, velocity <dbl>,
#   true_track <dbl>, vertical_rate <int>, sensors <lgl>, geo_altitude <dbl>,
#   squawk <lgl>, special_purpose <lgl>, position_source <int>,
#   registration <chr>, baro_altitude <dbl>, aircraft_model <chr>,
#   delivered <chr>, config <chr>, ife <chr>, wifi <chr>, power <chr>, J <chr>,
#   F <chr>, PP <chr>, `E+` <chr>, Y <chr>, aircraft_image <chr>,
#   aircraft_seatmap <chr>, origin_airport_codes_iata <chr>, …

Our data is currently wide, meaning it has more columns than rows. We’ll need to pivot it long, i.e., more rows than columns, for use in a display table. We’ll need to mutate all the columns to character before doing so, as there are columns that won’t live together when pivoted, i.e., the date time columns we created by converting Unix timestamps will not live with text information like the aircraft model.

Before we pivot longer, we probably want to grab some key information from the table so we can display it outside the usual areas, as in, outside of the body cells. For example, we might want to put the callsign in the table header. Let’s save united_10_gt to an object called tbl and do the work of pulling out some components we want using tbl$column. We could do that within our gt functions, namely using glue() to evaluate these expressions on the spot when wrapped in braces {}, but this approach makes things a little bit more visible to us.

tbl <- united_10_gt

aircraftimg <- tbl$aircraft_image
aircraftmodel <- tbl$aircraft_model

callsign <- tbl$callsign

tbl <- tbl |>
  mutate(across(everything(), \(x) as.character(x))) |>
  pivot_longer(everything())
tbl |>
  gt() |>
  tab_header(
    title = html(glue(
      "<b>{callsign}</b><br>{web_image(aircraftimg, height = '9em')}"
    ))
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  fmt_markdown() |>
  tab_style(
    list(
      cell_text(weight = 500, color = "#FFFFFF"),
      cell_fill(color = "#000000")
    ),
    list(cells_row_groups())
  ) |>
  tab_options(column_labels.hidden = TRUE)

UAL2353
time	2025-10-01 23:05:56
icao24	a126cc
callsign	UAL2353
origin_country	United States
time_position	2025-10-01 23:05:56
last_contact	2025-10-01 23:05:56
on_ground	FALSE
velocity	267.79
true_track	112.48
vertical_rate	0
sensors	NA
geo_altitude	11254.74
squawk	NA
special_purpose	FALSE
position_source	0
registration	N17309
baro_altitude	10668
aircraft_model	Boeing 737 MAX 8
delivered	2023
config	16F/54E+/96Y
ife	AVOD
wifi	ViaSatKA
power	110 V
J	NA
F	16
PP	NA
E+	54
Y	96
aircraft_image	https://media.united.com/assets/m/e1fdecdb14fce86/original/737-MAX-2x.png
aircraft_seatmap	https://media.united.com/assets/m/468bc1680a021607/original/737_8_Max_-16_150-_2272px_62colors.webp
origin_airport_codes_iata	IAH-POS
origin_airports_alt_feet	97
origin_airports_alt_meters	29.57
origin_airports_countryiso2	US
origin_airports_iata	IAH
origin_airports_icao	KIAH
origin_airports_lat	29.9844
origin_airports_location	Houston
origin_airports_lon	-95.3414
origin_airports_name	George Bush Intercontinental Houston Airport
origin_airline_code	UAL
origin_airport_codes	KIAH-TTPP
origin_callsign	UAL2353
origin_number	2353
origin_plausible	0
destination_airport_codes_iata	IAH-POS
destination_airports_alt_feet	58
destination_airports_alt_meters	17.68
destination_airports_countryiso2	TT
destination_airports_iata	POS
destination_airports_icao	TTPP
destination_airports_lat	10.5954
destination_airports_location	Port of Spain
destination_airports_lon	-61.3372
destination_airports_name	Piarco International Airport
destination_airline_code	UAL
destination_airport_codes	KIAH-TTPP
destination_callsign	UAL2353
destination_number	2353
destination_plausible	0
geometry	c(-87.0249, 28.0255, 10668)
Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use.

This is a good start. But this is way too much data for a table. Maybe let’s select only some specific information from the table? Like so:

tbl <- united_10_gt

aircraftimg <- tbl$aircraft_image
aircraftmodel <- tbl$aircraft_model

callsign <- tbl$callsign

tbl <- tbl |>
  select(
    registration,
    aircraft_model,
    delivered,
    config,
    velocity,
    true_track,
    vertical_rate,
    baro_altitude,
    squawk,
    special_purpose
  ) |>
  mutate(across(everything(), \(x) as.character(x))) |>
  pivot_longer(everything())

tbl |>
  gt() |>
  tab_header(
    title = html(glue(
      "<b>{callsign}</b><br>{web_image(aircraftimg, height = '9em')}"
    ))
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  fmt_markdown() |>
  tab_style(
    list(
      cell_text(weight = 500, color = "#FFFFFF"),
      cell_fill(color = "#000000")
    ),
    list(cells_row_groups())
  ) |>
  tab_options(column_labels.hidden = TRUE)

UAL2353
registration	N17309
aircraft_model	Boeing 737 MAX 8
delivered	2023
config	16F/54E+/96Y
velocity	267.79
true_track	112.48
vertical_rate	0
baro_altitude	10668
squawk	NA
special_purpose	FALSE
Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use.

This is a lot more readable. But now I feel like we’re missing some cool information we could otherwise be showing. One major part of aircraft on flight tracking maps is their origin and destination. And you know what’d be super cool? Is if we added some Bootstrap style elements to our table. Can we even do that with gt? Sure we can, and we don’t need any hacks like trying to mangle some HTML together - all we need is a little glue.

Let’s iron out what these value boxes should look like first.

Important

Note that once you start incorporating Bootstrap (bslib) elements into your gt tables, i.e., tooltips, popovers, value boxes, so forth, you can’t rely on simply outputting the gt table object to Positron’s or RStudio’s viewer to give you an accurate depiction of the table. If you do, you’ll find that the Bootstrap elements are conspicuously missing. And if you’re like me, you’ll assume you did something wrong, waste about 30 minutes worth of work thinking it’s completely broken, and then suddenly realize you need to actually render a Quarto document with your code to see if it works or not.

So suffice this to say that once you involve Bootstrap, you’ll need to render your table inside a full-on Quarto document so that your Bootstrap components actually initialize. You can rely on the viewer insofar as it’s depicting a Quarto Preview server.

library(bslib)


Attaching package: 'bslib'

The following object is masked from 'package:utils':

    page

library(fontawesome)

tbl <- united_10_gt

value_box(
  value = tbl$origin_airports_iata,
  title = html(glue(
    "{tbl$origin_airports_name}<br>{tbl$origin_airports_countryiso2}"
  )),
  showcase = fa("plane-departure", height = "4.5em"),
  theme = value_box_theme("bg-gradient-blue-purple")
)

George Bush Intercontinental Houston Airport
US

IAH

value_box(
  value = tbl$destination_airports_iata,
  title = html(glue(
    "{tbl$destination_airports_name}<br>{tbl$destination_airports_countryiso2}"
  )),
  showcase = fa("plane-arrival", height = "4.5em"),
  theme = value_box_theme("bg-gradient-blue-purple")
)

Piarco International Airport
TT

POS

Above, we’re just pulling some information from the table using tbl$column, specifically some of the information in the origin_* and destination_* columns, adding some styling to the boxes using value_box_theme(), and pulling in some icons from Font Awesome using fa().

Those look pretty good. But we need them to live together on a single row. I know! We’ll use layout_column_wrap().

library(bslib)
library(fontawesome)

tbl <- united_10_gt

origin_value_box <- value_box(
  value = tbl$origin_airports_iata,
  title = html(glue(
    "{tbl$origin_airports_name}<br>{tbl$origin_airports_countryiso2}"
  )),
  showcase = fa("plane-departure", height = "4.5em"),
  theme = value_box_theme("bg-gradient-blue-purple")
)

dest_value_box <- value_box(
  value = tbl$destination_airports_iata,
  title = html(glue(
    "{tbl$destination_airports_name}<br>{tbl$destination_airports_countryiso2}"
  )),
  showcase = fa("plane-arrival", height = "4.5em"),
  theme = value_box_theme("bg-gradient-blue-purple")
)

layout_column_wrap(origin_value_box, dest_value_box)

George Bush Intercontinental Houston Airport
US

IAH

Piarco International Airport
TT

POS

Great! But I remember that there’s something off about these routes… oh, right, @#sec-route-info. The routes aren’t always accurate. I don’t really want inaccurate information to be front and center (though, to some extent, this is unavoidable given the points listed in the section). Maybe we can trade out the information when the database tells us the route isn’t plausible? That is, when origin_plausible == 0 | destination_plausible == 0?

if (tbl$origin_plausible == 1) {
  origin_value_box <- value_box(
    value = tbl$origin_airports_iata,
    title = html(glue(
      "{tbl$origin_airports_name}<br>{tbl$origin_airports_countryiso2}"
    )),
    showcase = fa("plane-departure", height = "4.5em"),
    theme = value_box_theme("bg-gradient-blue-purple")
  )
} else {
  origin_value_box <- value_box(
    value = glue("{tbl$velocity} m/s"),
    title = "Aircraft Velocity",
    theme = value_box_theme("bg-gradient-blue-purple"),
    showcase = fa("angles-right", height = "3em")
  )
}
dest_value_box <- if (tbl$destination_plausible == 1) {
  value_box(
    value = tbl$destination_airports_iata,
    title = html(glue(
      "{tbl$destination_airports_name}<br>{tbl$destination_airports_countryiso2}"
    )),
    showcase = fa("plane-arrival", height = "4.5em"),
    theme = value_box_theme("bg-gradient-blue-purple")
  )
} else {
  dest_value_box <- value_box(
    value = glue("{tbl$baro_altitude} meters"),
    title = "Altitude",
    theme = value_box_theme("bg-gradient-blue-purple"),
    showcase = if (tbl$vertical_rate > 0) {
      fa("angle-up", height = "3em")
    } else if (tbl$vertical_rate == 0) {
      fa("minus", fill = "#FFFFFF", "3em")
    } else {
      fa("angle-down", height = "3em")
    }
  )
}

layout_column_wrap(origin_value_box, dest_value_box)

Aircraft Velocity

267.79 m/s

Altitude

10668 meters

One quick side note about this value box, specifically the vertical rate value box. The showcase has a little if-else statement hidden away:

showcase = if (tbl$vertical_rate > 0) {
  fa("angle-up", height = "3em")
} else if (tbl$vertical_rate == 0) {
  fa("minus", fill = "#FFFFFF", "3em")
} else {
  fa("angle-down", height = "3em")
}

This if-else gate determines what kind of symbol to show: if an aircraft is climbing, i.e., its vertical rate is greater than zero, an “angle-up” symbol (an up arrow, an up chevron, whatever you want to call it it’s fine by me) appears. Exactly zero, a dash (minus, again, same difference to me) appears. Else, a down arrow/angle/etc.

Maybe we should prepare a disclaimer for the table to identify when we’re swapping out route info at the top for operational info, as well as provide some caveats we listed in Section 2.1.2, so the viewer doesn’t get confused:

if (tbl$origin_plausible == 0 | tbl$destination_plausible == 0) {
  reliability <- glue(
    "{fa('triangle-exclamation', fill = '#990000')} <b>Route data for {callsign} is unreliable. Operational information is displayed instead.</b>"
  )
} else {
  reliability <- glue(
    "{fa('triangle-exclamation', fill = '#FFB343')} <b>Route data for {callsign} is plausible, but may still be outdated/incorrect. Double check using other sources.</b>"
  )
}

reliability

<svg aria-hidden="true" role="img" viewBox="0 0 512 512" style="height:1em;width:1em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:#990000;overflow:visible;position:relative;"><path d="M256 32c14.2 0 27.3 7.5 34.5 19.8l216 368c7.3 12.4 7.3 27.7 .2 40.1S486.3 480 472 480H40c-14.3 0-27.6-7.7-34.7-20.1s-7-27.8 .2-40.1l216-368C228.7 39.5 241.8 32 256 32zm0 128c-13.3 0-24 10.7-24 24V296c0 13.3 10.7 24 24 24s24-10.7 24-24V184c0-13.3-10.7-24-24-24zm32 224a32 32 0 1 0 -64 0 32 32 0 1 0 64 0z"/></svg> <b>Route data for UAL2353 is unreliable. Operational information is displayed instead.</b>

Alright. Returning to the table above, I think we still need some information other than those boxes. To that end, we’ll mutate the table to add some variables:

origin_info will concatenate a bunch of info about the origin airport into a single string, so it can be displayed in the table as one cell. That way, the user can still see the origin airport, even if it’s not included in the value box due to being unreliable (it may, in fact, be correct, so it’s worth showing). If we can’t determine the airport (for reasons listed in Section 2.1.2), we’ll put “Unable to Determine.” And we’ll do the same thing for destination_info

mutate(
  origin_info = if (origin_plausible == 0 & is.na(origin_airports_name)) {
    as.character(html(glue(
      "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
    )))
  } else if (origin_plausible == 0) {
    as.character(html(glue(
      "{fa('triangle-exclamation', fill = '#990000')} {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
    )))
  } else {
    as.character(html(glue(
      "{origin_airports_iata} - {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
    )))
  }
) |>
  mutate(
    destination_info = if (
      destination_plausible == 0 & is.na(destination_airports_name)
    ) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
      )))
    } else if (destination_plausible == 0) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
      )))
    } else {
      as.character(html(glue(
        "{destination_airports_iata} - {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
      )))
    }
  )

Sidebar that everyone loves a good country flag. So we’ll probably want to include a small country flag somewhere in the origin_info and destination_info string. We’ll rip the code from gt::fmt_flag in order to do this, leveraging the gt:::flag_tbl object:

get_flag <- function(x, height = "1em") {
  flag_tbl <- gt:::flag_tbl
  country_names <- gt:::country_names

  x_str <- character(length(x))
  x_str_non_missing <- x[!is.na(x)]
  x_str_non_missing <- vapply(
    seq_along(x_str_non_missing),
    FUN.VALUE = character(1L),
    USE.NAMES = FALSE,
    FUN = function(x) {
      if (grepl(",", x_str_non_missing[x], fixed = TRUE)) {
        countries <- toupper(unlist(strsplit(x_str_non_missing[x], ",\\s*")))
      } else {
        countries <- toupper(x_str_non_missing[x])
      }
      if (is.numeric(height)) {
        height <- paste0(height, "px")
      }
      out <- c()
      for (y in seq_along(countries)) {
        country_i <- toupper(countries[y])
        country_i_len <- nchar(country_i)
        flag_svg <- flag_tbl[
          flag_tbl[[paste0("country_code_", country_i_len)]] == country_i,
        ][["country_flag"]]
        out_y <- gsub(
          "<svg.*?>",
          paste0(
            "<svg xmlns=\"http://www.w3.org/2000/svg\" ",
            "aria-hidden=\"true\" role=\"img\" ",
            "width=\"512\" height=\"512\" ",
            "viewBox=\"0 0 512 512\" ",
            "style=\"vertical-align:-0.125em;",
            "image-rendering:optimizeQuality;",
            "height:",
            height,
            ";",
            "width:",
            height,
            ";",
            "\"",
            ">"
          ),
          flag_svg
        )
        out <- c(out, out_y)
      }
      paste0(
        "<span style=\"white-space:nowrap;\">",
        paste0(out, collapse = ""),
        "</span>"
      )
    }
  )
  x_str[!is.na(x)] <- x_str_non_missing
  x_str[is.na(x)] <- NA_character_
  x_str
}

It’d be nice to list some aircraft amenities with little logos like the Wi-Fi on-board symbol, power adapter, in-flight entertainment symbol, etc. We’ll do the same process of piggybacking off of United’s CDN for this. If we detect certain strings in the United fleet data, such as “AVOD” or “DTV”, written as "AVOD|DTV", we’ll mutate a variable, let’s called it amenity_ife, so that it contains an SVG converted into HTML using gt’s web_image function, and otherwise we’ll leave it blank. We’ll do this for all the amenity types: amenity_ife, amenity_wifi, and amenity_power, then combine them into a single amenities column.

... |>
  mutate(
    amenity_ife = case_when(
      ife == "NO" ~ NA,
      str_detect(ife, "No ") ~ NA,
      str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
        glue(
          '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
        ),
      str_detect(ife, "AVOD|DTV") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "Seatback|SEATBACK") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "PDE") ~
        web_image(
          "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
        )
    )
  ) |>
  mutate(
    amenity_wifi = case_when(
      wifi == "NO" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      power == "NO" ~ NA,
      power == "F/E+" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      str_detect(power, "USB") ~
        glue(
          "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
        ),
      .default = amenity_power
    )
  ) |>
  mutate(
    amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
  )

Let’s add some formatting to our pre-existing columns before passing them into gt:

... |>
  mutate(velocity = glue("{velocity} m/s")) |>
  mutate(true_track = glue("{true_track} degrees")) |>
  mutate(vertical_rate = glue("{vertical_rate} m/s")) |>
  mutate(baro_altitude = glue("{baro_altitude} m"))

Let’s make sure to update our selections. We might as well rename our columns to something nicer to look at as well, instead of these default names like vertical_rate. Note that we could change these later with some gt functions. It’s just a matter of preference. I’m more used to doing it in dplyr personally.

... |>
  select(
    registration,
    aircraft_model,
    delivered,
    config,
    amenities,
    velocity,
    true_track,
    vertical_rate,
    baro_altitude,
    squawk,
    special_purpose,
    origin_info,
    destination_info
  ) |>
  rename(
    "Registration Number" = registration,
    "Aircraft Model" = aircraft_model,
    "Delivery Year" = delivered,
    "Seating Configuration" = config,
    "Amenities On-Board" = amenities,
    "Velocity" = velocity,
    "Climb Rate" = vertical_rate,
    "True Track" = true_track,
    "Barometric Altitude" = baro_altitude,
    "Squawk Code" = squawk,
    "Special Purpose Flight" = special_purpose,
    "Origin Airport" = origin_info,
    "Destination Airport" = destination_info
  )

Maybe we also want to add some row group labels. What do I mean by that? Here’s a picture of the anatomy of a table from the gt package:

Easy enough, to do this all we’d need to do is create a grouping column. Once we use group(), gt will recognize our row groups and add the row group labels accordingly.

... |>
  mutate(
    category = case_match(
      name,
      "Registration Number" ~ "Aircraft Information",
      "Aircraft Model" ~ "Aircraft Information",
      "Delivery Year" ~ "Aircraft Information",
      "Seating Configuration" ~ "Aircraft Information",
      "Amenities On-Board" ~ "Aircraft Information",
      "Velocity" ~ "Operational Information",
      "True Track" ~ "Operational Information",
      "Climb Rate" ~ "Operational Information",
      "Barometric Altitude" ~ "Operational Information",
      "Squawk Code" ~ "Operational Information",
      "Special Purpose Flight" ~ "Operational Information",
      "Origin Airport" ~ "Route Information",
      "Destination Airport" ~ "Route Information"
    )
  )

Let’s add it all together!

tbl <- united_10_gt

aircraftimg <- tbl$aircraft_image
aircraftmodel <- tbl$aircraft_model

callsign <- tbl$callsign
united_logo <- web_image(
  "https://www.united.com/2500e4e62233fbfe8ac6.unitedLogoNew.svg",
  height = "1em"
)

### Add fallbacks in case route data is inaccurate. API provides a 0/1 metric for plausibility.
if (tbl$origin_plausible == 1) {
  origin_value_box <- value_box(
    value = tbl$origin_airports_iata,
    title = html(glue(
      "{tbl$origin_airports_name}<br>{tbl$origin_airports_countryiso2}"
    )),
    showcase = fa("plane-departure", height = "4.5em"),
    theme = value_box_theme("bg-gradient-blue-purple")
  )
} else {
  origin_value_box <- value_box(
    value = glue("{tbl$velocity} m/s"),
    title = "Aircraft Velocity",
    theme = value_box_theme("bg-gradient-blue-purple"),
    showcase = fa("angles-right", height = "3em")
  )
}
dest_value_box <- if (tbl$destination_plausible == 1) {
  value_box(
    value = tbl$destination_airports_iata,
    title = html(glue(
      "{tbl$destination_airports_name}<br>{tbl$destination_airports_countryiso2}"
    )),
    showcase = fa("plane-arrival", height = "4.5em"),
    theme = value_box_theme("bg-gradient-blue-purple")
  )
} else {
  dest_value_box <- value_box(
    value = glue("{tbl$baro_altitude} meters"),
    title = "Altitude",
    theme = value_box_theme("bg-gradient-blue-purple"),
    showcase = if (tbl$vertical_rate > 0) {
      fa("angle-up", height = "3em")
    } else if (tbl$vertical_rate == 0) {
      fa("minus", fill = "#FFFFFF", "3em")
    } else {
      fa("angle-down", height = "3em")
    }
  )
}

if (tbl$origin_plausible == 0 | tbl$destination_plausible == 0) {
  reliability <- glue(
    "{fa('triangle-exclamation', fill = '#990000')} <b>Route data for {callsign} is unreliable. Operational information is displayed instead.</b>"
  )
} else {
  reliability <- glue(
    "{fa('triangle-exclamation', fill = '#FFB343')} <b>Route data for {callsign} is plausible, but may still be outdated/incorrect. Double check using other sources.</b>"
  )
}

contact <- tbl$last_contact

get_flag <- function(x, height = "1em") {
  flag_tbl <- gt:::flag_tbl
  country_names <- gt:::country_names

  x_str <- character(length(x))
  x_str_non_missing <- x[!is.na(x)]
  x_str_non_missing <- vapply(
    seq_along(x_str_non_missing),
    FUN.VALUE = character(1L),
    USE.NAMES = FALSE,
    FUN = function(x) {
      if (grepl(",", x_str_non_missing[x], fixed = TRUE)) {
        countries <- toupper(unlist(strsplit(x_str_non_missing[x], ",\\s*")))
      } else {
        countries <- toupper(x_str_non_missing[x])
      }
      if (is.numeric(height)) {
        height <- paste0(height, "px")
      }
      out <- c()
      for (y in seq_along(countries)) {
        country_i <- toupper(countries[y])
        country_i_len <- nchar(country_i)
        flag_svg <- flag_tbl[
          flag_tbl[[paste0("country_code_", country_i_len)]] == country_i,
        ][["country_flag"]]
        out_y <- gsub(
          "<svg.*?>",
          paste0(
            "<svg xmlns=\"http://www.w3.org/2000/svg\" ",
            "aria-hidden=\"true\" role=\"img\" ",
            "width=\"512\" height=\"512\" ",
            "viewBox=\"0 0 512 512\" ",
            "style=\"vertical-align:-0.125em;",
            "image-rendering:optimizeQuality;",
            "height:",
            height,
            ";",
            "width:",
            height,
            ";",
            "\"",
            ">"
          ),
          flag_svg
        )
        out <- c(out, out_y)
      }
      paste0(
        "<span style=\"white-space:nowrap;\">",
        paste0(out, collapse = ""),
        "</span>"
      )
    }
  )
  x_str[!is.na(x)] <- x_str_non_missing
  x_str[is.na(x)] <- NA_character_
  x_str
}

gt_tbl <- tbl |>
  mutate(across(everything(), \(x) as.character(x))) |>
  mutate(
    origin_info = if (origin_plausible == 0 & is.na(origin_airports_name)) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
      )))
    } else if (origin_plausible == 0) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
      )))
    } else {
      as.character(html(glue(
        "{origin_airports_iata} - {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
      )))
    }
  ) |>
  mutate(
    destination_info = if (
      destination_plausible == 0 & is.na(destination_airports_name)
    ) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
      )))
    } else if (destination_plausible == 0) {
      as.character(html(glue(
        "{fa('triangle-exclamation', fill = '#990000')} {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
      )))
    } else {
      as.character(html(glue(
        "{destination_airports_iata} - {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
      )))
    }
  ) |>
  mutate(velocity = glue("{velocity} m/s")) |>
  mutate(true_track = glue("{true_track} degrees")) |>
  mutate(vertical_rate = glue("{vertical_rate} m/s")) |>
  mutate(baro_altitude = glue("{baro_altitude} m")) |>
  mutate(
    amenity_ife = case_when(
      ife == "NO" ~ NA,
      str_detect(ife, "No ") ~ NA,
      str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
        glue(
          '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
        ),
      str_detect(ife, "AVOD|DTV") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "Seatback|SEATBACK") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "PDE") ~
        web_image(
          "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
        )
    )
  ) |>
  mutate(
    amenity_wifi = case_when(
      wifi == "NO" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      power == "NO" ~ NA,
      power == "F/E+" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      str_detect(power, "USB") ~
        glue(
          "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
        ),
      .default = amenity_power
    )
  ) |>
  mutate(
    amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
  ) |>
  select(
    registration,
    aircraft_model,
    delivered,
    config,
    amenities,
    velocity,
    true_track,
    vertical_rate,
    baro_altitude,
    squawk,
    special_purpose,
    origin_info,
    destination_info
  ) |>
  rename(
    "Registration Number" = registration,
    "Aircraft Model" = aircraft_model,
    "Delivery Year" = delivered,
    "Seating Configuration" = config,
    "Amenities On-Board" = amenities,
    "Velocity" = velocity,
    "Climb Rate" = vertical_rate,
    "True Track" = true_track,
    "Barometric Altitude" = baro_altitude,
    "Squawk Code" = squawk,
    "Special Purpose Flight" = special_purpose,
    "Origin Airport" = origin_info,
    "Destination Airport" = destination_info
  ) |>
  pivot_longer(everything()) |>
  mutate(
    category = case_match(
      name,
      "Registration Number" ~ "Aircraft Information",
      "Aircraft Model" ~ "Aircraft Information",
      "Delivery Year" ~ "Aircraft Information",
      "Seating Configuration" ~ "Aircraft Information",
      "Amenities On-Board" ~ "Aircraft Information",
      "Velocity" ~ "Operational Information",
      "True Track" ~ "Operational Information",
      "Climb Rate" ~ "Operational Information",
      "Barometric Altitude" ~ "Operational Information",
      "Squawk Code" ~ "Operational Information",
      "Special Purpose Flight" ~ "Operational Information",
      "Origin Airport" ~ "Route Information",
      "Destination Airport" ~ "Route Information"
    )
  ) |>
  group_by(category) |>
  gt() |>
  tab_header(
    title = html(glue(
      "{united_logo} <b>{callsign}</b><br>{web_image(aircraftimg, height = '9em')}"
    )),
    subtitle = html(glue(
      "{bslib::layout_column_wrap(origin_value_box, dest_value_box)}{reliability}<br>Data as of {contact} UTC"
    ))
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  tab_footnote(
    "J = United Polaris seats; F = First Class; PP = Premium Plus; E+ = Economy Plus; Y = Economy.",
    locations = cells_body(
      columns = name,
      rows = name == "Seating Configuration"
    )
  ) |>
  fmt_markdown() |>
  tab_style(
    list(
      cell_text(weight = 500, color = "#FFFFFF"),
      cell_fill(color = "#000000")
    ),
    list(cells_row_groups())
  ) |>
  tab_options(column_labels.hidden = TRUE)

gt_tbl

Aircraft Information
UAL2353
Aircraft Velocity 267.79 m/s Altitude 10668 meters Route data for UAL2353 is unreliable. Operational information is displayed instead. Data as of 2025-10-01 23:05:56 UTC
Registration Number	N17309
Aircraft Model	Boeing 737 MAX 8
Delivery Year	2023
Seating Configuration¹	16F/54E+/96Y
Amenities On-Board
Operational Information
Velocity	267.79 m/s
True Track	112.48 degrees
Climb Rate	0 m/s
Barometric Altitude	10668 m
Squawk Code	NA
Special Purpose Flight	FALSE
Route Information
Origin Airport	George Bush Intercontinental Houston Airport
Destination Airport	Piarco International Airport
¹ J = United Polaris seats; F = First Class; PP = Premium Plus; E+ = Economy Plus; Y = Economy.
Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use.

Some tricks that I’ll draw your attention to: remember the value boxes? You might be wondering how I got those in there. I took this line of the value box code cell:

layout_column_wrap(origin_value_box, dest_value_box)

… and shoved it into gt’s tab_header() function under subtitle, using html() and glue(), like so:

... |>
  tab_header(
    title = html(glue(
      "{united_logo} <b>{callsign}</b><br>{web_image(aircraftimg, height = '9em')}"
    )),
    subtitle = html(glue(
      "{bslib::layout_column_wrap(origin_value_box, dest_value_box)}{reliability}<br>Data as of {contact} UTC"
    ))
  )

As you can see in the cell above, we also embellished the callsign with a United logo on its left, using the object united_logo which, again, relies on United’s CDN to serve up that image. In addition to the value boxes, we added the reliability object underneath the boxes, documenting when we’ve decided to omit or display route info.

Now, we’re ready to wrap this in a function. Really, it’s almost ready to go. Notice that united_10_gt currently contains only one row. The table handles one aircraft at a time, so we’ll need to add a filter to a given callsign, and pass a vector of callsigns using map():

tbl <- df |> filter(callsign == specified_callsign)

We might as well add an option for exporting to HTML that defaults to true as well. Doing that, we get the full function called generate_map_tables:

generate_map_tables <- function(df, specified_callsign, output_html = TRUE) {
  tbl <- df |> filter(callsign == specified_callsign)

  aircraftimg <- tbl$aircraft_image
  aircraftmodel <- tbl$aircraft_model

  callsign <- tbl$callsign
  united_logo <- web_image(
    "https://www.united.com/2500e4e62233fbfe8ac6.unitedLogoNew.svg",
    height = "1em"
  )

  ### Add fallbacks in case route data is inaccurate. API provides a 0/1 metric for plausibility.
  if (tbl$origin_plausible == 1) {
    origin_value_box <- value_box(
      value = tbl$origin_airports_iata,
      title = html(glue(
        "{tbl$origin_airports_name}<br>{tbl$origin_airports_countryiso2}"
      )),
      showcase = fa("plane-departure", height = "4.5em"),
      theme = value_box_theme("bg-gradient-blue-purple")
    )
  } else {
    origin_value_box <- value_box(
      value = glue("{tbl$velocity} m/s"),
      title = "Aircraft Velocity",
      theme = value_box_theme("bg-gradient-blue-purple"),
      showcase = fa("angles-right", height = "3em")
    )
  }
  dest_value_box <- if (tbl$destination_plausible == 1) {
    value_box(
      value = tbl$destination_airports_iata,
      title = html(glue(
        "{tbl$destination_airports_name}<br>{tbl$destination_airports_countryiso2}"
      )),
      showcase = fa("plane-arrival", height = "4.5em"),
      theme = value_box_theme("bg-gradient-blue-purple")
    )
  } else {
    dest_value_box <- value_box(
      value = glue("{tbl$baro_altitude} meters"),
      title = "Altitude",
      theme = value_box_theme("bg-gradient-blue-purple"),
      showcase = if (tbl$vertical_rate > 0) {
        fa("angle-up", height = "3em")
      } else if (tbl$vertical_rate == 0) {
        fa("minus", fill = "#FFFFFF", "3em")
      } else {
        fa("angle-down", height = "3em")
      }
    )
  }

  if (tbl$origin_plausible == 0 | tbl$destination_plausible == 0) {
    reliability <- glue(
      "{fa('triangle-exclamation', fill = '#990000')} <b>Route data for {callsign} is unreliable. Operational information is displayed instead.</b>"
    )
  } else {
    reliability <- glue(
      "{fa('triangle-exclamation', fill = '#FFB343')} <b>Route data for {callsign} is plausible, but may still be outdated/incorrect. Double check using other sources.</b>"
    )
  }

  contact <- tbl$last_contact

  get_flag <- function(x, height = "1em") {
    flag_tbl <- gt:::flag_tbl
    country_names <- gt:::country_names

    x_str <- character(length(x))
    x_str_non_missing <- x[!is.na(x)]
    x_str_non_missing <- vapply(
      seq_along(x_str_non_missing),
      FUN.VALUE = character(1L),
      USE.NAMES = FALSE,
      FUN = function(x) {
        if (grepl(",", x_str_non_missing[x], fixed = TRUE)) {
          countries <- toupper(unlist(strsplit(x_str_non_missing[x], ",\\s*")))
        } else {
          countries <- toupper(x_str_non_missing[x])
        }
        if (is.numeric(height)) {
          height <- paste0(height, "px")
        }
        out <- c()
        for (y in seq_along(countries)) {
          country_i <- toupper(countries[y])
          country_i_len <- nchar(country_i)
          flag_svg <- flag_tbl[
            flag_tbl[[paste0("country_code_", country_i_len)]] == country_i,
          ][["country_flag"]]
          out_y <- gsub(
            "<svg.*?>",
            paste0(
              "<svg xmlns=\"http://www.w3.org/2000/svg\" ",
              "aria-hidden=\"true\" role=\"img\" ",
              "width=\"512\" height=\"512\" ",
              "viewBox=\"0 0 512 512\" ",
              "style=\"vertical-align:-0.125em;",
              "image-rendering:optimizeQuality;",
              "height:",
              height,
              ";",
              "width:",
              height,
              ";",
              "\"",
              ">"
            ),
            flag_svg
          )
          out <- c(out, out_y)
        }
        paste0(
          "<span style=\"white-space:nowrap;\">",
          paste0(out, collapse = ""),
          "</span>"
        )
      }
    )
    x_str[!is.na(x)] <- x_str_non_missing
    x_str[is.na(x)] <- NA_character_
    x_str
  }

  gt_tbl <- tbl |>
    mutate(across(everything(), \(x) as.character(x))) |>
    mutate(
      origin_info = if (origin_plausible == 0 & is.na(origin_airports_name)) {
        as.character(html(glue(
          "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
        )))
      } else if (origin_plausible == 0) {
        as.character(html(glue(
          "{fa('triangle-exclamation', fill = '#990000')} {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
        )))
      } else {
        as.character(html(glue(
          "{origin_airports_iata} - {origin_airports_name} {get_flag(origin_airports_countryiso2)}"
        )))
      }
    ) |>
    mutate(
      destination_info = if (
        destination_plausible == 0 & is.na(destination_airports_name)
      ) {
        as.character(html(glue(
          "{fa('triangle-exclamation', fill = '#990000')} Unable to Determine"
        )))
      } else if (destination_plausible == 0) {
        as.character(html(glue(
          "{fa('triangle-exclamation', fill = '#990000')} {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
        )))
      } else {
        as.character(html(glue(
          "{destination_airports_iata} - {destination_airports_name} {get_flag(destination_airports_countryiso2)}"
        )))
      }
    ) |>
    mutate(velocity = glue("{velocity} m/s")) |>
    mutate(true_track = glue("{true_track} degrees")) |>
    mutate(vertical_rate = glue("{vertical_rate} m/s")) |>
    mutate(baro_altitude = glue("{baro_altitude} m")) |>
    mutate(
      amenity_ife = case_when(
        ife == "NO" ~ NA,
        str_detect(ife, "No ") ~ NA,
        str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
          glue(
            '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
          ),
        str_detect(ife, "AVOD|DTV") ~
          web_image(
            "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
          ),
        str_detect(ife, "Seatback|SEATBACK") ~
          web_image(
            "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
          ),
        str_detect(ife, "PDE") ~
          web_image(
            "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
          )
      )
    ) |>
    mutate(
      amenity_wifi = case_when(
        wifi == "NO" ~ NA,
        .default = web_image(
          "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
        )
      )
    ) |>
    mutate(
      amenity_power = case_when(
        power == "NO" ~ NA,
        power == "F/E+" ~ NA,
        .default = web_image(
          "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
        )
      )
    ) |>
    mutate(
      amenity_power = case_when(
        str_detect(power, "USB") ~
          glue(
            "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
          ),
        .default = amenity_power
      )
    ) |>
    mutate(
      amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
    ) |>
    select(
      registration,
      aircraft_model,
      delivered,
      config,
      amenities,
      velocity,
      true_track,
      vertical_rate,
      baro_altitude,
      squawk,
      special_purpose,
      origin_info,
      destination_info
    ) |>
    rename(
      "Registration Number" = registration,
      "Aircraft Model" = aircraft_model,
      "Delivery Year" = delivered,
      "Seating Configuration" = config,
      "Amenities On-Board" = amenities,
      "Velocity" = velocity,
      "Climb Rate" = vertical_rate,
      "True Track" = true_track,
      "Barometric Altitude" = baro_altitude,
      "Squawk Code" = squawk,
      "Special Purpose Flight" = special_purpose,
      "Origin Airport" = origin_info,
      "Destination Airport" = destination_info
    ) |>
    pivot_longer(everything()) |>
    mutate(
      category = case_match(
        name,
        "Registration Number" ~ "Aircraft Information",
        "Aircraft Model" ~ "Aircraft Information",
        "Delivery Year" ~ "Aircraft Information",
        "Seating Configuration" ~ "Aircraft Information",
        "Amenities On-Board" ~ "Aircraft Information",
        "Velocity" ~ "Operational Information",
        "True Track" ~ "Operational Information",
        "Climb Rate" ~ "Operational Information",
        "Barometric Altitude" ~ "Operational Information",
        "Squawk Code" ~ "Operational Information",
        "Special Purpose Flight" ~ "Operational Information",
        "Origin Airport" ~ "Route Information",
        "Destination Airport" ~ "Route Information"
      )
    ) |>
    group_by(category) |>
    gt() |>
    tab_header(
      title = html(glue(
        "{united_logo} <b>{callsign}</b><br>{web_image(aircraftimg, height = '9em')}"
      )),
      subtitle = html(glue(
        "{bslib::layout_column_wrap(origin_value_box, dest_value_box)}{reliability}<br>Data as of {contact} UTC"
      ))
    ) |>
    tab_options(table.width = pct(100), container.width = pct(100)) |>
    tab_source_note(
      "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
    ) |>
    fmt_markdown() |>
    tab_style(
      list(
        cell_text(weight = 500, color = "#FFFFFF"),
        cell_fill(color = "#000000")
      ),
      list(cells_row_groups())
    ) |>
    tab_options(column_labels.hidden = TRUE)

  if (output_html) {
    gt_tbl <- gt_tbl |> as_raw_html()
  }

  return(gt_tbl)
}

5.2 Map It!

I recognize this isn’t a mapping contest (maybe someone needs to get on that idea). Still, if the whole point is putting a table inside a map, I kind of need to walk you through the mapping part a little bit. Alright, let’s grab our parquet files we made in Section 3.1.

united_10_tracks <- st_read_parquet("data/flight_track.parquet")
united_10_positions <- st_read_parquet("data/state_vector.parquet")

Important

Before I go further, in the actual project, you’ll use the functions we created in Section 3.1 to query the OpenSky API and build the tracks/positions objects. That looks like this:

united_explore_10 <-
  compatible_registrations |>
  slice_sample(n = 10) |>
  pull(icao24)

united_10_tracks <- bind_rows(
  map(united_explore_10, \(x) get_flight_track(x))
) |>
  st_as_sf()

united_10_positions <- bind_rows(
  map(united_explore_10, \(x) get_state_vector(x))
) |>
  mutate(
    registration = map_chr(icao24, \(x) {
      get_registration_from_icao24(x, return_tibble = F)
    })
  ) |>
  st_as_sf()

united_explore_10 simply picks 10 random flights to query from the compatible_registrations list, which we made in Section 4.1. That’s because, up until we made that list, we didn’t actually have the information necessary to comprehensively pull from United’s active mainline fleet. And the reason we’re only pulling 10 is further documented in Section 2.1.1, but basically the long-and-short is we have limited API credits, and we can’t just pull the whole fleet, so a random sample of 10 is the compromise I landed on. The API limit is also why I’m demonstrating/executing the code using static parquet files here in Quarto. You’re free to adjust this as you like, just make sure to change the slice_sample(n = 10) row, or, if you’re feeling adventurous, delete it entirely I guess. As they say, enjoy responsibly.

Note that if you do increase the number of aircraft you want to pull, you’ll likely need to add some cooldown time between your API requests, else you’ll run into a rate limit of the OpenSky API. Even though the OpenSky API doesn’t include anything about limiting requests in a certain period of time, I find that you start running into a 429 response when you run the script as-is on more than about 30 aircraft or so. In our box analogy, the OpenSky team doesn’t want you rolling up to their box, scooping up a bunch of stuff and then running off with it. It’s almost Halloween as of the time of writing, and it wouldn’t be very courteous of you to take the whole bowl of candy when there’s a line of people taking only a few pieces at once. The same goes for our API access.

When you do get rate limited, you’ll probably get a 429/503 response. req_perform() actually retries by default if it encounters this code, but you’ll probably just get a 429 again if you’ve burned up too many requests in a time window. In that case, I’d recommend taking a look at req_throttle() and its documentation.

Let’s make sure that everything in tracks is actually also in positions, since we’ll assign the tooltip/hover functionality to positions, and not tracks:

united_10_tracks <- united_10_tracks |>
  filter(icao24 %in% (united_10_positions |> drop_na(time) |> pull(icao24)))

Getting registration info so we can join united_10_positions with our fleet information:

united_10_positions <- united_10_positions |>
  mutate(
    registration = map_chr(icao24, \(x) {
      get_registration_from_icao24(x, return_tibble = F)
    })
  ) |>
  st_as_sf()

Doing some joins on united_10_positions to join it up with route and fleet data and creating a separate united_10_gt object that’s a little cleaned up for use with gt…

united_10_positions <- left_join(
  united_10_positions |>
    mutate(baro_altitude = st_coordinates(united_10_positions)[, 3]),
  united_full_fleet_info
)

Joining with `by = join_by(registration)`

route_info <- bind_rows(
  map(united_10_positions |> drop_na(callsign) |> pull(callsign), \(x) {
    get_route_information(x)
  })
)
united_10_positions <- left_join(united_10_positions, route_info) |>
  drop_na(callsign)

Joining with `by = join_by(callsign)`

united_10_gt <- united_10_positions |>
  as_tibble() |>
  drop_na(origin_plausible, destination_plausible)

Hi. Future me here. So I’d like to save you some headache that I couldn’t save myself from. See this image from GitHub actions?

Yeah, that’s all because of this:

… which is connected to how I originally dealt with undetermined route information, which was just to try and coerce NA to 0 inside of the map table function. Turns out, if doesn’t really like that approach, since trying to evaluate tbl$origin_plausible == 1 when you have an NA doesn’t actually resolve in a way that the computer can comprehend - does NA == 1? I don’t have any information about NA, so who knows? Well, time to throw an error!

Hence, this function when defining united_10_gt is pretty important to avoid serial failures related to that:

drop_na(origin_plausible, destination_plausible)

… we’ve finally arrived at the mapping function itself:

united_10_gt <- united_10_gt |>
  mutate(
    gt_html = map_chr(callsign, \(x) generate_map_tables(df = united_10_gt, x))
  ) |>
  select(callsign, gt_html)

Great. Let’s join this to our positions data and make sure it’s a simple features object:

united_10_positions_gt <- left_join(united_10_positions, united_10_gt) |>
  st_as_sf()

Joining with `by = join_by(callsign)`

Now we can finally map it!

To initialize a Maplibre map (after you’ve gotten the mapgl package), we’ll call the maplibre() function. We’ll set the projection to globe using set_projection("globe"), add our data sources using add_source(), add a little airplane icon for use with our symbol layer with add_image(), add a line layer with add_line_layer(), add a symbol layer with add_symbol_layer(), add a fullscreen control with add_fullscreen_control(), and add a reset control with add_reset_control().

library(mapgl)

maplibre(
  style = carto_style("dark-matter"),
  bounds = united_10_tracks,
  height = "100vh",
  attributionControl = list(
    customAttribution = "<a href='https://sites.google.com/site/unitedfleetsite/mainline-fleet-tracking'>United Fleet Site project contributors</a>, OpenSky Network contributors, adsb.lol, ADSB-DB",
    compact = TRUE
  )
) |>
  set_projection("globe") |>
  add_source(id = "paths", data = united_10_tracks) |>
  add_source(id = "positions", data = united_10_positions_gt) |>
  add_image(
    "aircraft-icon",
    "https://upload.wikimedia.org/wikipedia/commons/1/10/Avatar_plane.png"
  ) |>
  add_line_layer(
    id = "flight-tracks",
    source = "paths",
    line_color = "#1414D2",
    line_width = 3
  ) |>
  add_symbol_layer(
    id = "aircraft-positions",
    source = "positions",
    icon_rotate = get_column("true_track"),
    icon_image = "aircraft-icon",
    icon_size = interpolate(
      property = "zoom",
      values = c(4, 8, 12),
      stops = c(0.15, 0.25, 0.4)
    ),
    icon_allow_overlap = TRUE,
    popup = "gt_html",
    tooltip = "gt_html",
    icon_rotation_alignment = "map",
    icon_pitch_alignment = "map"
  ) |>
  add_fullscreen_control() |>
  add_reset_control()

A few notes about the parameters here:

To get the maps to actually show up, I specified popup = "gt_html" and tooltip = "gt_html" inside add_symbol_layer()
To get the aircraft icons to point in the right direction, I used icon_rotate = get_column("true_track") as well as icon_rotation_alignment = "map" and icon_pitch_alignment = "map" so that the icons actually keep their rotation, even if the user starts rotating the map.
This block:

icon_size = interpolate(
  property = "zoom",
  values = c(4, 8, 12),
  stops = c(0.15, 0.25, 0.4)
)

… scales the aircraft icon depending on zoom level. And the attributionControl argument in maplibre() is used to credit the data sources.

It’s worth noting something important here: your pop-up will probably look like this,

Why? ~~Because I’ve set you up for failure~~ Because of Maplibre’s default CSS rules. We actually need to create an scss file that overrides some of these rules. For my contest entry, I have my scss looking something like this (for the pop-up scaling specifically):

body .maplibregl-popup {
    max-width: 80vw !important; // Default for mobile and small screens (<901px)
    max-height: 70vh !important;
    z-index: 1200;
}

// Rule for displays between 901px and 1351px
@media screen and (min-width: 901px) and (max-width: 1351px) {
    body .maplibregl-popup {
        max-width: 60vw !important; // Larger on "tablet" and medium desktop displays
    }
}

// Rule for large displays (>1351px)
@media screen and (min-width: 1352px) {
    body .maplibregl-popup {
        max-width: 40vw !important; // Smaller on large desktop displays
    }
}

body .maplibregl-popup-content {
    overflow-x: auto !important;
    overflow-y: auto !important;
}

… with @media screen being used to scale the width of the pop-up to different display sizes, using a mobile first approach (greater width on smaller screens to try and get the map as large as possible without being completely obscured by the table).

Tip

Hi reader. Future me here. You’ll notice that if you implement this code as-written that on small displays, you’ll still have to scroll the table pop-up within the map. I’d encourage you to run two pieces of the code and try this out for yourself: the chunk that produces the table standalone, i.e., in the main body of the Quarto document, and then the code with the map table pop-up. You should hopefully see that while the standalone table in the main body of the document scales down (by squishing the aircraft image to fit the page width), the table inside of the map doesn’t actually scale. Instead, it relies on the overflow-x property for users on small screens to scroll horizontally.

This is fine, but seeing as we have a perfectly working table example that scales responsively, and seeing how phones are everywhere, it feels like a shame to not optimize for mobile portrait orientation by getting this scaling into our map somehow. To that end, we can try adding this bit of CSS to our .scss file:

@media screen and (max-width: 900px) {
    .gt_heading img {
    max-width: 100%;
    height: auto !important;
    }
}

… where this SCSS rule will tell all instances of images inside of gt headers to set their max-width to 100% of the parent container (in this case, the maplibre pop-up container), and to scale height according to width, i.e., maintain aspect ratio. Why is height marked important? Because of our argument earlier to web_image() setting aircraft image height to 9em. For small devices, we want to reject this rule, overriding it with “auto.”

5.3 One Last Table - Well, Actually, a Table of Tables

Remember the compromise I discussed in Section 2.1.1 about not being able to show the entire fleet? The compromise I landed on is showing a few planes in the air, and then showing details about all the active aircraft in United’s fleet based on the Google sheet we pulled on a separate page called “Full Fleet Information” on my Shiny app. You’re actually well equipped to recreate just about the entire table given what we learned from the map table, which is debatably more complicated than this one. The interactive full fleet table is more straightforward, leveraging the aircraft images and seatmaps we pulled from United’s CDN.

Let’s try a quick prototype, pulling 5 random rows from the United fleet (I’d rather not display all 1,000 here and wait several minutes for my computer to render the table, especially on the later steps…). We’ll involve some gtExtras as well, specifically the merge stack function.

library(gtExtras)

main_tbl <- united_full_fleet_info |>
  slice_sample(n = 5) |>
  filter(str_starts(registration, "N")) |>
  mutate(aircraft_seatmap = web_image(aircraft_seatmap, height = "30em")) |>
  mutate(
    amenity_ife = case_when(
      ife == "NO" ~ NA,
      str_detect(ife, "No ") ~ NA,
      str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
        glue(
          '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
        ),
      str_detect(ife, "AVOD|DTV") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "Seatback|SEATBACK") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "PDE") ~
        web_image(
          "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
        )
    )
  ) |>
  mutate(
    amenity_wifi = case_when(
      wifi == "NO" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      power == "NO" ~ NA,
      power == "F/E+" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      str_detect(power, "USB") ~
        glue(
          "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
        ),
      .default = amenity_power
    )
  ) |>
  mutate(
    amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
  ) |>
  select(-amenity_wifi, -amenity_power, -amenity_ife)

united_logo <- web_image(
  "https://www.united.com/2500e4e62233fbfe8ac6.unitedLogoNew.svg",
  height = "1em"
)

main_tbl <- main_tbl |>
  select(
    delivered,
    aircraft_image,
    aircraft_model,
    aircraft_seatmap,
    amenities,
    J,
    F,
    PP,
    `E+`,
    Y
  ) |>
  mutate(across(c("J", "F", "PP", "E+", "Y"), \(x) as.integer(x))) |>
  mutate("Total Seats" = sum(c(J, F, PP, `E+`, Y), na.rm = T)) |>
  gt() |>
  fmt_image(columns = aircraft_image, height = "22em") |>
  gt_merge_stack(
    col1 = aircraft_image,
    col2 = aircraft_model,
    font_size = c("14px", "18px"),
    palette = c("black", "black"),
    font_weight = c("bold", "normal")
  ) |>
  gt_merge_stack(col1 = aircraft_image, col2 = aircraft_seatmap) |>
  cols_width(aircraft_image ~ px(1200)) |>
  cols_align(align = "center", columns = aircraft_image) |>
  cols_label(
    delivered = "Delivery Year",
    aircraft_image = "Aircraft"
  ) |>
  tab_style(
    cell_borders(sides = c("bottom"), weight = px(1.2), style = "dashed"),
    cells_body()
  ) |>
  tab_style(
    list(
      cell_fill(color = "#000000"),
      cell_text(
        color = "#FFFFFF",
        weight = 400,
        stretch = "semi-condensed",
        size = "large"
      )
    ),
    locations = cells_body(columns = delivered)
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  opt_interactive(
    use_search = TRUE,
    page_size_values = c(5, 10, 25),
    page_size_default = 5,
    use_filters = TRUE
  )

main_tbl

Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use.

I mean, this is alright. A Quarto book won’t do it justice since it’s necessarily crammed into the small space. Still, though, it feels like we’re going to struggle with a lot of vertical whitespace due to the combination of the aircraft and the seatmap, which generally make the most visual sense when they’re sitting together vertically. Hmm… what if we took a bunch of these columns and turned them into rows? As in, have a bunch of tiny cells, and one big, merged cell next to them? You might think that gt wasn’t really built for something like that. And you’d probably be right. But, just like in the maps, gt tables can be output into HTML. And just like mapgl, gt can render HTML using fmt_markdown().

Let’s take the same approach as our map. For every observation (aircraft registration value), we’ll create a vertically-oriented table that contains:

the aircraft’s registration information in the tab_header();
the aircraft information, in a category called “Aircraft Information,” which contains the aircraft model and layout;
the amenities on-board the aircraft, in a category called “Amenities On-Board,” containing amenity logos like in our map table, as well as the specific in-flight entertainment type, Wi-Fi system, and power available;
the seating available on board the aircraft, by class;
and the total number of seats at the bottom.

generate_addt_info_table <- function(df, specified_registration) {
  tbl <- df |> filter(registration == specified_registration)

  tbl |>
    select(
      aircraft_model,
      config,
      amenities,
      ife,
      wifi,
      power,
      J,
      F,
      PP,
      `E+`,
      Y
    ) |>
    mutate(across(c("J", "F", "PP", "E+", "Y"), \(x) as.integer(x))) |>
    mutate("Total Seats" = sum(c(J, F, PP, `E+`, Y), na.rm = T)) |>
    mutate(across(everything(), \(x) as.character(x))) |>
    rename(
      "Aircraft Model" = aircraft_model,
      Layout = config,
      "Amenities" = amenities,
      "In-Flight Entertainment" = ife,
      "Wi-Fi System" = wifi,
      "Power Available" = power,
      "Polaris Seats" = J,
      "First Class Seats" = F,
      "Premium Plus Seats" = PP,
      "Economy Plus Seats" = `E+`,
      "Economy Seats" = Y
    ) |>
    pivot_longer(everything()) |>
    mutate(
      category = case_match(
        name,
        "Aircraft Model" ~ "Aircraft Information",
        "Layout" ~ "Aircraft Information",
        "Amenities" ~ "Amenities On-Board",
        "In-Flight Entertainment" ~ "Amenities On-Board",
        "Wi-Fi System" ~ "Amenities On-Board",
        "Power Available" ~ "Amenities On-Board",
        "Polaris Seats" ~ "Seating",
        "First Class Seats" ~ "Seating",
        "Premium Plus Seats" ~ "Seating",
        "Economy Plus Seats" ~ "Seating",
        "Economy Seats" ~ "Seating",
        "Total Seats" ~ "Seating"
      )
    ) |>
    group_by(category) |>
    gt() |>
    tab_options(column_labels.hidden = TRUE) |>
    fmt_markdown() |>
    sub_missing() |>
    tab_header(title = specified_registration) |>
    tab_style(
      list(
        cell_text(weight = 400, color = "#FFFFFF"),
        cell_fill(color = "#000000")
      ),
      list(cells_row_groups(), cells_body(rows = name == "Total Seats"))
    ) |>
    tab_options(table.width = pct(90), table.border.top.style = "hidden") |>
    data_color(
      rows = category == "Seating" & name != "Total Seats",
      palette = "ggsci::indigo_material",
      columns = value,
      na_color = "#FFFFFF"
    ) |>
    as_raw_html()
}

Let’s add this into our full fleet table using the following line:

... |>
  mutate(
    amenity_table = map(registration, \(x) {
      generate_addt_info_table(main_tbl, x)
    })
  )

main_tbl <- united_full_fleet_info |>
  filter(str_starts(registration, "N")) |>
  slice_sample(n = 5) |>
  mutate(aircraft_seatmap = web_image(aircraft_seatmap, height = "30em")) |>
  mutate(
    amenity_ife = case_when(
      ife == "NO" ~ NA,
      str_detect(ife, "No ") ~ NA,
      str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
        glue(
          '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
        ),
      str_detect(ife, "AVOD|DTV") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "Seatback|SEATBACK") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "PDE") ~
        web_image(
          "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
        )
    )
  ) |>
  mutate(
    amenity_wifi = case_when(
      wifi == "NO" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      power == "NO" ~ NA,
      power == "F/E+" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      str_detect(power, "USB") ~
        glue(
          "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
        ),
      .default = amenity_power
    )
  ) |>
  mutate(
    amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
  ) |>
  select(-amenity_wifi, -amenity_power, -amenity_ife)

united_logo <- web_image(
  "https://www.united.com/2500e4e62233fbfe8ac6.unitedLogoNew.svg",
  height = "1em"
)

main_tbl <- main_tbl |>
  mutate(
    amenity_table = map(registration, \(x) {
      generate_addt_info_table(main_tbl, x)
    })
  ) |>
  select(
    delivered,
    aircraft_image,
    aircraft_model,
    aircraft_seatmap,
    amenity_table
  ) |>
  gt() |>
  fmt_image(columns = aircraft_image, height = "22em") |>
  gt_merge_stack(
    col1 = aircraft_image,
    col2 = aircraft_model,
    font_size = c("14px", "18px"),
    palette = c("black", "black"),
    font_weight = c("bold", "normal")
  ) |>
  gt_merge_stack(col1 = aircraft_image, col2 = aircraft_seatmap) |>
  cols_move(columns = aircraft_image, after = amenity_table) |>
  cols_width(amenity_table ~ px(450), aircraft_image ~ px(1200)) |>
  cols_align(align = "center", columns = aircraft_image) |>
  cols_label(
    delivered = "Delivery Year",
    amenity_table = "",
    aircraft_image = "Aircraft"
  ) |>
  tab_style(
    cell_borders(sides = c("bottom"), weight = px(1.2), style = "dashed"),
    cells_body()
  ) |>
  tab_style(
    list(
      cell_fill(color = "#000000"),
      cell_text(
        color = "#FFFFFF",
        weight = 400,
        stretch = "semi-condensed",
        size = "large"
      )
    ),
    locations = cells_body(columns = delivered)
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  opt_interactive(
    use_search = TRUE,
    page_size_values = c(5, 10, 25),
    page_size_default = 5,
    use_filters = TRUE
  )

main_tbl

That’s a lot better. But I have no idea what some of these IFE/Wi-Fi options mean. And I’m the guy making the table, so if I can’t make out what AVOD/DTV means, then my audience probably can’t either (again, assumption, but probably a fair one). Maybe we can fix that with bslib::tooltip() and text_replace()?

Let’s try adding these lines:

ife_learn_more <- glue("In-Flight Entertainment {fa('circle-question')}")
wifi_learn_more <- glue("Wi-Fi System {fa('circle-question')}")
power_learn_more <- glue("Power Available {fa('circle-question')}")

... |>
  text_replace(
    "In-Flight Entertainment",
    glue(
      '{bslib::tooltip(
      html(ife_learn_more),
      "Abbreviations: Audio-Video on Demand (AVOD), AVOD with overhead television monitors in economy (AVOD/OVER), Personal Device Entertainment via the United app (PDE), DirecTV (DTV). F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
    )
  ) |>
  text_replace(
    "Wi-Fi System",
    glue(
      '{bslib::tooltip(
      html(wifi_learn_more),
      "Abbreviations: Satellite (Satl), Ku (Ku-band satellite frequency), Ka (Ka-band satellite frequency). F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
    )
  ) |>
  text_replace(
    "Power Available",
    glue(
      '{bslib::tooltip(
      html(power_learn_more),
      "Numerical values represent volts. USB indicates that USB power (either type-A or type-C) is available. F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
    )
  )

generate_addt_info_table <- function(df, specified_registration) {
  tbl <- df |> filter(registration == specified_registration)

  ife_learn_more <- glue("In-Flight Entertainment {fa('circle-question')}")
  wifi_learn_more <- glue("Wi-Fi System {fa('circle-question')}")
  power_learn_more <- glue("Power Available {fa('circle-question')}")

  tbl |>
    select(
      aircraft_model,
      config,
      amenities,
      ife,
      wifi,
      power,
      J,
      F,
      PP,
      `E+`,
      Y
    ) |>
    mutate(across(c("J", "F", "PP", "E+", "Y"), \(x) as.integer(x))) |>
    mutate("Total Seats" = sum(c(J, F, PP, `E+`, Y), na.rm = T)) |>
    mutate(across(everything(), \(x) as.character(x))) |>
    rename(
      "Aircraft Model" = aircraft_model,
      Layout = config,
      "Amenities" = amenities,
      "In-Flight Entertainment" = ife,
      "Wi-Fi System" = wifi,
      "Power Available" = power,
      "Polaris Seats" = J,
      "First Class Seats" = F,
      "Premium Plus Seats" = PP,
      "Economy Plus Seats" = `E+`,
      "Economy Seats" = Y
    ) |>
    pivot_longer(everything()) |>
    mutate(
      category = case_match(
        name,
        "Aircraft Model" ~ "Aircraft Information",
        "Layout" ~ "Aircraft Information",
        "Amenities" ~ "Amenities On-Board",
        "In-Flight Entertainment" ~ "Amenities On-Board",
        "Wi-Fi System" ~ "Amenities On-Board",
        "Power Available" ~ "Amenities On-Board",
        "Polaris Seats" ~ "Seating",
        "First Class Seats" ~ "Seating",
        "Premium Plus Seats" ~ "Seating",
        "Economy Plus Seats" ~ "Seating",
        "Economy Seats" ~ "Seating",
        "Total Seats" ~ "Seating"
      )
    ) |>
    group_by(category) |>
    gt() |>
    tab_options(column_labels.hidden = TRUE) |>
    fmt_markdown() |>
    sub_missing() |>
    tab_header(title = specified_registration) |>
    tab_style(
      list(
        cell_text(weight = 400, color = "#FFFFFF"),
        cell_fill(color = "#000000")
      ),
      list(cells_row_groups(), cells_body(rows = name == "Total Seats"))
    ) |>
    tab_options(table.width = pct(90), table.border.top.style = "hidden") |>
    text_replace(
      "In-Flight Entertainment",
      glue(
        '{bslib::tooltip(
      html(ife_learn_more),
      "Abbreviations: Audio-Video on Demand (AVOD), AVOD with overhead television monitors in economy (AVOD/OVER), Personal Device Entertainment via the United app (PDE), DirecTV (DTV). F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
      )
    ) |>
    text_replace(
      "Wi-Fi System",
      glue(
        '{bslib::tooltip(
      html(wifi_learn_more),
      "Abbreviations: Satellite (Satl), Ku (Ku-band satellite frequency), Ka (Ka-band satellite frequency). F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
      )
    ) |>
    text_replace(
      "Power Available",
      glue(
        '{bslib::tooltip(
      html(power_learn_more),
      "Numerical values represent volts. USB indicates that USB power (either type-A or type-C) is available. F/E+ indicates that this amenity is only available in First or Economy Plus; in this case, the amenity is omitted from the icon list as it is not available to all passengers."
    )}'
      )
    ) |>
    data_color(
      rows = category == "Seating" & name != "Total Seats",
      palette = "ggsci::indigo_material",
      columns = value,
      na_color = "#FFFFFF"
    ) |>
    as_raw_html()
}

main_tbl <- united_full_fleet_info |>
  filter(str_starts(registration, "N")) |>
  slice_sample(n = 5) |>
  mutate(aircraft_seatmap = web_image(aircraft_seatmap, height = "30em")) |>
  mutate(
    amenity_ife = case_when(
      ife == "NO" ~ NA,
      str_detect(ife, "No ") ~ NA,
      str_detect(ife, "AVOD|DTV") & str_detect(ife, "PDE") ~
        glue(
          '{web_image("https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg")} {web_image("https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg")}'
        ),
      str_detect(ife, "AVOD|DTV") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "Seatback|SEATBACK") ~
        web_image(
          "https://media.united.com/assets/m/6902cf38052408ed/original/x-global-icons-travel-airport-on-demand.svg"
        ),
      str_detect(ife, "PDE") ~
        web_image(
          "https://media.united.com/assets/m/36ec366e93188fda/original/x-global-icons-travel-airport-personal-device.svg"
        )
    )
  ) |>
  mutate(
    amenity_wifi = case_when(
      wifi == "NO" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/4d2b44a2bcff27d9/original/x-global-icons-travel-airport-wifi.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      power == "NO" ~ NA,
      power == "F/E+" ~ NA,
      .default = web_image(
        "https://media.united.com/assets/m/3acf299d26de7a3b/original/x-global-icons-travel-airport-in-seat-power.svg"
      )
    )
  ) |>
  mutate(
    amenity_power = case_when(
      str_detect(power, "USB") ~
        glue(
          "{amenity_power} {web_image('https://media.united.com/assets/m/601a3d239d42470/original/USB-icon.svg')}"
        ),
      .default = amenity_power
    )
  ) |>
  mutate(
    amenities = glue("{amenity_wifi} {amenity_power} {amenity_ife}", .na = "")
  ) |>
  select(-amenity_wifi, -amenity_power, -amenity_ife)

united_logo <- web_image(
  "https://www.united.com/2500e4e62233fbfe8ac6.unitedLogoNew.svg",
  height = "1em"
)

main_tbl <- main_tbl |>
  mutate(
    amenity_table = map(registration, \(x) {
      generate_addt_info_table(main_tbl, x)
    })
  ) |>
  select(
    delivered,
    aircraft_image,
    aircraft_model,
    aircraft_seatmap,
    amenity_table
  ) |>
  gt() |>
  fmt_image(columns = aircraft_image, height = "22em") |>
  gt_merge_stack(
    col1 = aircraft_image,
    col2 = aircraft_model,
    font_size = c("14px", "18px"),
    palette = c("black", "black"),
    font_weight = c("bold", "normal")
  ) |>
  gt_merge_stack(col1 = aircraft_image, col2 = aircraft_seatmap) |>
  cols_move(columns = aircraft_image, after = amenity_table) |>
  cols_width(amenity_table ~ px(450), aircraft_image ~ px(1200)) |>
  cols_align(align = "center", columns = aircraft_image) |>
  cols_label(
    delivered = "Delivery Year",
    amenity_table = "",
    aircraft_image = "Aircraft"
  ) |>
  tab_style(
    cell_borders(sides = c("bottom"), weight = px(1.2), style = "dashed"),
    cells_body()
  ) |>
  tab_style(
    list(
      cell_fill(color = "#000000"),
      cell_text(
        color = "#FFFFFF",
        weight = 400,
        stretch = "semi-condensed",
        size = "large"
      )
    ),
    locations = cells_body(columns = delivered)
  ) |>
  tab_options(table.width = pct(100), container.width = pct(100)) |>
  tab_source_note(
    "Information sourced from the OpenSky Network, adsb.lol, ADSB-DB, and the United Fleet Website's mainline fleet tracker. Information, especially route information, may be inaccurate, and is omitted from the table header when unreliable. Table design by Martin Stavro. Information displayed here, including the medium in which it is displayed, is not affiliated with nor endorsed by United Airlines and is presented here within the provisions of fair use."
  ) |>
  opt_interactive(
    use_search = TRUE,
    page_size_values = c(5, 10, 25),
    page_size_default = 5,
    use_filters = TRUE
  )

main_tbl

Awesome. I think we’re ready to move onto the final step: deploying our work!

You might be wondering what the point of even putting it into the coordinates was in the first place. Originally, I thought I’d be able to map the z-offset, until I learned it’s a Mapbox only feature, and Mapbox has its own API/cost requirements. So, for those of you using Mapbox, the option is still there with the z-offset argument.↩︎