I94 processing with theming

I94_asof2026_8.R

############################################################
# US International Visitor Arrivals Analysis
#
# Purpose:
# Analyse changes in international visitor arrivals to the
# United States using I-94 arrival data. The chart compares
# rolling 12-month visitor volumes against November 2024,
# using that month as a 100-point baseline.
############################################################

# Core data manipulation packages
library(dplyr)
library(tidyr)

# Data import packages
library(readxl)

# Visualisation
library(ggplot2)
library(ggthemes)

# Date handling
library(lubridate)

# Rolling calculations
library(slider)

# Font registration
library(systemfonts)


############################################################
# Custom Theme, Fonts and Helper Functions
############################################################

# Colour-blind friendly palette used throughout charts
six_cols <- colorblind_pal()(6)

# Standard footer text for chart captions
make_footer <- function(x) {
  paste0(
    x,
    "\n Made by David Hood, ",
    Sys.Date()
  )
}

# Body font definition
bodyfont <- "IBM Plex Sans Thin"

systemfonts::register_variant(
  name = bodyfont,
  family = "IBM Plex Sans",
  weight = "ultralight"
)

# Heading font definition
headfont <- "IBM Plex Sans SemiBold"

systemfonts::register_variant(
  name = headfont,
  family = "IBM Plex Sans",
  weight = "semibold"
)

# Custom chart theme
theme_david <- function() {
  
  theme_minimal(
    base_family = bodyfont,
    header_family = headfont,
    base_size = 9,
    ink = "#000000",
    paper = "#FFFFFF",
    accent = "red"
  ) %+replace%
    
    theme(
      axis.line.x = element_line(linewidth = 0.2),
      axis.line.y = element_line(linewidth = 0.2),
      axis.ticks = element_line(linewidth = 0.2),
      
      axis.title.y.left = element_text(
        margin = margin(
          t = 5, r = 7, b = 5, l = 5,
          unit = "pt"
        )
      ),
      
      axis.title.x.bottom = element_text(
        margin = margin(
          t = 7, r = 5, b = 0, l = 5,
          unit = "pt"
        )
      ),
      
      panel.background = element_rect(
        fill = "#FFFFFF",
        colour = "#F7F7F7",
        linewidth = 2
      ),
      
      panel.grid = element_blank(),
      
      plot.title.position = "plot",
      
      plot.title = element_text(
        lineheight = 1.18,
        size = 12,
        margin = margin(
          t = 5, r = 5, b = 10, l = 10,
          unit = "pt"
        ),
        hjust = 0,
        vjust = 0
      ),
      
      plot.subtitle = element_text(
        lineheight = 1.18,
        size = 10,
        margin = margin(
          t = 0, r = 5, b = 10, l = 10,
          unit = "pt"
        ),
        hjust = 0
      ),
      
      plot.background = element_rect(
        fill = "#FFFFFF",
        colour = "#FFFFFF"
      ),
      
      plot.caption = element_text(
        margin = margin(
          t = 2, r = 5, b = 5, l = 5,
          unit = "pt"
        ),
        lineheight = 1.15,
        size = 8,
        hjust = 1
      ),
      
      plot.caption.position = "plot",
      
      strip.background = element_rect(
        fill = "#F7F7F7",
        colour = "#F7F7F7",
        linewidth = 2
      ),
      
      strip.text = element_text(
        size = 10,
        margin = margin(
          t = 5, r = 5, b = 5, l = 5,
          unit = "pt"
        )
      ),
      
      plot.margin = margin(
        t = 10, r = 10, b = 10, l = 10
      ),
      
      panel.spacing = unit(10, "points")
    )
}


############################################################
# Data Source Information
############################################################

data_URL <- "https://www.trade.gov/i-94-arrivals-program"

# Text used in chart footer
original_link_text <- "I-94 monthly international visitor arrivals, 2000-present (Excel file)"


############################################################
# Load Monthly I-94 Arrival Data
############################################################

i94_contents <- read_excel(
  "~/Downloads/Monthly Arrivals 2000 to Present – Country of Residence (COR)_1.xlsx",
  sheet = "Monthly"
)

############################################################
# Determine Monthly Data Columns
#
# The spreadsheet contains descriptive columns followed by
# monthly data columns. Locate the first month column and
# the last month column dynamically.
############################################################

# Find position of January 2023 column
left_end <- grep(
  "2023-01",
  names(i94_contents),
  fixed = TRUE
)

# Find first placeholder column ("...")
# and step back one column to find the final month
placeholder_cols <- grep(
  "^\\.\\.\\.",
  names(i94_contents)
)

right_end <- if (length(placeholder_cols) > 0) {
  min(placeholder_cols) - 1
} else {
  ncol(i94_contents)
}

# Extract names of all monthly columns
selected_colnames <- names(
  i94_contents[, left_end:right_end]
)


############################################################
# Reshape and Prepare Data
############################################################

i94_longform <- i94_contents |>
  
  # Select country name column and all month columns
  select(
    Area = `International Visitors--\r\n   1) Country of Residence\r\n   2) 1+ nights in the USA\r\n   3)  Among qualified visa types`,
    any_of(selected_colnames)
  ) |>
  
  # Keep only country-level rows.
  # Row numbers are specific to the spreadsheet structure.
  slice(2, 20:254) |>
  
  # Convert from wide format:
  #   Country | Jan | Feb | Mar ...
  #
  # to long format:
  #   Country | Month | Arrivals
  pivot_longer(
    any_of(selected_colnames),
    names_to = "Mnth",
    values_to = "arrivals"
  ) |>
  
  arrange(Area, Mnth) |>
  
  group_by(Area) |>
  
  # Calculate rolling 12-month average arrivals
  #
  # slide_dbl() comes from the slider package.
  # .before = 11 means:
  # current month + previous 11 months = 12 months total.
  #
  # .complete = TRUE requires a full 12 months before
  # producing a result.
  mutate(
    roll12 = slide_dbl(
      arrivals,
      .f = mean,
      .before = 11,
      .complete = TRUE
    )
  ) |>
  
  ungroup() |>
  
  # Remove periods before the rolling average exists
  filter(!is.na(roll12))


############################################################
# Compare Each Month Against November 2024
#
# November 2024 becomes the baseline (100).
# Future values are expressed as an index relative to it.
############################################################

vs_Nov_24 <- i94_longform |>
  
  # Extract baseline value for each country
  filter(Mnth == "2024-11") |>
  
  select(
    Area,
    baseline = roll12
  ) |>
  
  # Join baseline back to all observations
  inner_join(
    i94_longform,
    by = join_by(Area)
  ) |>
  
  mutate(
    
    # Index where Nov-2024 = 100
    v2411 = 100 * roll12 / baseline,
    
    # Convert text month ("2025-03") to a date
    # using the 15th day of month
    Dated = ymd(
      paste0(
        substr(Mnth, 1, 7),
        "-15"
      )
    )
  ) |>
  
  # Keep only post-Nov-2024 observations
  filter(
    !is.na(v2411),
    Dated > ymd("2024-11-1")
  )


############################################################
# Determine Most Recent Month for Chart Title
############################################################

most_recent <- format(
  max(vs_Nov_24$Dated),
  "%B %Y"
)


############################################################
# Countries To Highlight
#
# All countries are plotted faintly in the background,
# while selected countries receive coloured lines and labels.
############################################################

shortlist <- data.frame(
  Names = c(
    "Australia",
    "Canada",
    "New Zealand",
    "Denmark",
    "Hungary",
    "South Korea"
  ),
  
  # Custom colours from colour-blind palette
  Style_col = six_cols[c(2, 3, 2, 1, 1, 3)],
  
  # Line types (solid/dashed etc.)
  Style_line = c(2, 1, 1, 2, 1, 2),
  
  # Label vertical positioning adjustment
  Style_height = c(0, 1, .5, .5, .5, 1),
  
  stringsAsFactors = FALSE
)


############################################################
# Extract Highlight Countries
############################################################

select_countries <- vs_Nov_24 |>
  filter(Area %in% shortlist$Names)


############################################################
# Create End-of-Line Labels
#
# Grab most recent observation for each selected country
# and move its label slightly beyond the line endpoint.
############################################################

Country_label <- select_countries |>
  
  arrange(Area, desc(Dated)) |>
  
  group_by(Area) |>
  
  # Keep latest record per country
  slice(1) |>
  
  ungroup() |>
  
  mutate(
    Dated = max(Dated) + days(15)
  )

############################################################
# Set the vertical range to be a bit beyond those
# countries that are highlighted
############################################################

graph_top <- max(select_countries$v2411) + 5

graph_low <- min(select_countries$v2411) - 5


############################################################
# Create Plot
############################################################

ggplot(
  vs_Nov_24,
  aes(
    x = Dated,
    y = v2411
  )
) +
  
  # Background reference lines for all countries
  geom_line(
    aes(group = Area),
    linewidth = 0.03,
    alpha = 0.3
  ) +
  
  # Highlight selected countries
  geom_line(
    data = select_countries,
    aes(
      colour = Area,
      linetype = Area
    )
  ) +
  
  theme_david() +
  
  theme(
    legend.position = "none"
  ) +
  
  scale_colour_manual(
    values = shortlist$Style_col
  ) +
  
  scale_x_date(
    breaks = as.Date(
      c(
        "2024-11-15",
        "2025-07-15",
        "2026-03-15"
      )
    ),
    date_labels = "%b %y"
  ) +
  
  scale_linetype_manual(
    values = shortlist$Style_line
  ) +
  
  # Custom vertical placement for endpoint labels
  scale_discrete_manual(
    aesthetics = "vjust",
    values = shortlist$Style_height
  ) +
  
  coord_cartesian(
    
    # Restrict visible y-axis range
    ylim = c(graph_low, graph_top),
    
    # Extend x-axis so labels fit on the right
    xlim = c(
      NA_Date_,
      Country_label$Dated[1] + days(90)
    )
  ) +
  
  # Add country labels at line endpoints
  geom_text(
    data = Country_label,
    aes(
      colour = Area,
      label = Area,
      vjust = Area
    ),
    size = 3,
    hjust = 0
  ) +
  
  labs(
    x = NULL,
    y = "Arrivals as % of Nov 2024",
    
    title = paste(
      "Visitor entries to the US among selected countries",
      "still with free access to US,\nto",
      most_recent
    ),
    
    subtitle =
      "Rolling 12 month average I-94 1+ nights visitors to the US, as percentage of Nov 2024",
    
    caption = make_footer(
      paste0(
        "Source: ",
        original_link_text,
        "\n",
        data_URL
      )
    )
  )


############################################################
# Export Images
############################################################

# Social / widescreen version
ggsave(
  "~/Desktop/ggsocmed.jpg",
  width = 2016,
  height = 1134,
  units = "px"
)

# High-resolution A4 version
ggsave(
  filename = "~/Desktop/gga4ish.png",
  width = 178,
  height = 126,
  units = "mm",
  dpi = 400
)