How Far Does APOD Take Us?

Distribution of distances mentioned in NASA’s Astronomy Picture of the Day (2007-2025). Most content focuses on our galaxy, peaking where nebulae and star clusters reside.

TidyTuesday
2026
Analyzing 19 years of NASA’s Astronomy Picture of the Day archive to explore the cosmic distances featured in explanations. A histogram reveals APOD’s ‘sweet spot’ between 1,000-2,000 light-years where nebulae and star clusters dominate, with reference lines marking key landmarks from Proxima Centauri to the Andromeda Galaxy.
Author

Steven Ponce

Published

January 18, 2026

Figure 1: Histogram showing the distribution of distances mentioned in NASA’s Astronomy Picture of the Day explanations from 2007-2025, plotted on a logarithmic scale from 1 to 10 billion light-years. The distribution peaks sharply between 1,000 and 2,000 light-years (labeled “The Nebula Peak”), where nebulae and star clusters reside. Five vertical reference lines mark key cosmic landmarks: Proxima Centauri at 4 light-years, the Orion Nebula at 1,500 light-years, the Galactic center at 26,000 light-years, the Milky Way diameter at 100,000 light-years, and the Andromeda Galaxy at 2.5 million light-years. A secondary peak appears around 10-100 million light-years, representing distant galaxies.

Steps to Create this Graphic

1. Load Packages & Setup

Show code
```{r}
#| label: load
#| warning: false
#| message: false
#| results: "hide"

## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
    tidyverse,     # Easily Install and Load the 'Tidyverse'
    ggtext,        # Improved Text Rendering Support for 'ggplot2'
    showtext,      # Using Fonts More Easily in R Graphs
    ggrepel,       # Non-overlapping Text Labels
    janitor,       # Simple Tools for Examining and Cleaning Dirty Data
    scales,        # Scale Functions for Visualization
    glue           # Interpreted String Literals
)
})

### |- figure size ----
camcorder::gg_record(
  dir    = here::here("temp_plots"),
  device = "png",
  width  = 8,
  height = 6,
  units  = "in",
  dpi    = 320
)

# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```

2. Read in the Data

Show code
```{r}
#| label: read
#| include: true
#| eval: true
#| warning: false

tt <- tidytuesdayR::tt_load(2026, week = 03)
apod_raw <- tt$apod |> clean_names()
rm(tt)
```

3. Examine the Data

Show code
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false

glimpse(apod_raw)
```

4. Tidy Data

Show code
```{r}
#| label: tidy-fixed
#| warning: false

# Extract light-year distances from explanations
extract_distances <- function(text) {
  if (is.na(text)) {
    return(NA_real_)
  }
  pattern <- "(\\d{1,3}(?:,\\d{3})*(?:\\.\\d+)?)\\s*(million|billion)?\\s*light[\\-\\s]years?"
  matches <- str_match_all(tolower(text), pattern)[[1]]
  if (nrow(matches) == 0) {
    return(NA_real_)
  }

  val <- str_remove_all(matches[, 2], ",") |> as.numeric()
  multiplier <- case_when(
    matches[, 3] == "million" ~ 1e6,
    matches[, 3] == "billion" ~ 1e9,
    TRUE ~ 1
  )
  return(val * multiplier)
}

# Build distance dataset
distances_clean <- apod_raw |>
  mutate(dist_val = map(explanation, extract_distances)) |>
  unnest(dist_val) |>
  filter(!is.na(dist_val), dist_val > 0, dist_val < 1e10)

landmarks <- tibble(
  distance = c(4.24, 1500, 26000, 100000, 2500000),
  label = c(
    "Nearest star\n(Proxima Centauri)",
    "Orion Nebula\n(APOD favorite)",
    "Galactic\ncenter",
    "Milky Way\ndiameter",
    "Andromeda\nGalaxy"
  ),
  y_pos = c(255, 255, 275, 255, 255)
)
```

5. Visualization Parameters

Show code
```{r}
#| label: params
#| include: true
#| warning: false

### |-  plot aesthetics ----
colors <- get_theme_colors(
  palette = list(
      bar =   "#b066a2",     
      line =  "#58a6ff"
  )
)

### |- titles and caption ----
title_text = "How Far Does APOD Take Us?"

subtitle_text = str_glue(
    "Distribution of distances mentioned in NASA's **Astronomy Picture of the Day** (2007-2025).<br>",
    "Most content focuses on our galaxy, peaking where **nebulae and star clusters** reside."
    )

caption_text <- create_social_caption(
    tt_year = 2026,
    tt_week = 03,
    source_text = "NASA APOD Archive via NASA API"
)

### |-  fonts ----
setup_fonts()
fonts <- get_font_families()

### |-  plot theme ----
# Start with base theme
base_theme <- create_base_theme(colors)

# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
  base_theme,
  theme(
    # Text styling
    plot.title = element_text(
      face = "bold", family = fonts$title, size = rel(1.4),
      color = colors$title, margin = margin(b = 10), hjust = 0
    ),
    plot.subtitle = element_markdown(
      face = "italic", family = fonts$subtitle, lineheight = 1.2,
      color = colors$subtitle, size = rel(0.9), margin = margin(b = 20), hjust = 0
    ),

    # Grid
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    panel.grid.major = element_line(color = "gray90", linewidth = 0.25),

    # Axes
    axis.title = element_text(size = rel(0.8), color = "gray30"),
    axis.text = element_text(color = "gray30"),
    axis.text.y = element_text(size = rel(0.85)),
    axis.ticks = element_blank(),

    # Facets
    strip.background = element_rect(fill = "gray95", color = NA),
    strip.text = element_text(
      face = "bold",
      color = "gray20",
      size = rel(0.9),
      margin = margin(t = 6, b = 4)
    ),
    panel.spacing = unit(1.5, "lines"),

    # Legend elements
    legend.position = "plot",
    legend.title = element_text(
      family = fonts$subtitle,
      color = colors$text, size = rel(0.8), face = "bold"
    ),
    legend.text = element_text(
      family = fonts$tsubtitle,
      color = colors$text, size = rel(0.7)
    ),
    legend.margin = margin(t = 15),

    # Plot margin
    plot.margin = margin(10, 20, 10, 20),
    
  )
)

# Set theme
theme_set(weekly_theme)
```

6. Plot

Show code
```{r}
#| label: plot
#| warning: false

### |- Plot ----
p <- ggplot(distances_clean, aes(x = dist_val)) +
  # Annotate
  annotate("rect",
    xmin = 800, xmax = 3000, ymin = 0, ymax = 300,
    fill = colors$palette$bar, alpha = 0.08
  ) +
  annotate("text",
    x = 1800, y = 290, label = "THE NEBULA PEAK",
    family = fonts$text, size = 4, color = colors$palette$bar, fontface = "bold"
  ) +
  # Geoms
  geom_histogram(
    fill = colors$palette$bar, color = "white",
    bins = 60, alpha = 0.9
  ) +
  geom_segment(
    data = landmarks,
    aes(x = distance, xend = distance, y = 0, yend = 300),
    linetype = "dotted",
    color = colors$palette$line,
    linewidth = 0.5
  ) +
  geom_text(
    data = landmarks, aes(x = distance, y = y_pos, label = label),
    size = 2.8, family = fonts$text, fontface = "bold",
    lineheight = 0.85, vjust = 1, color = colors$text
  ) +
  # Scales
  scale_x_log10(
    expand = expansion(mult = c(0.02, 0.05)),
    breaks = 10^(0:10),
    labels = label_log()
  ) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  coord_cartesian(clip = "off") +
  # Labs
  labs(
    title = title_text,
    subtitle = subtitle_text,
    caption = caption_text,
    x = "Distance (light-years)",
    y = "Number of\nMentions"
  ) +
  # Theme
  theme(
    axis.title.y = element_text(angle = 0, vjust = 0.95, hjust = 0, size = rel(0.8), face = "bold", color = colors$text),
    axis.title.x = element_text(size = rel(0.8), face = "bold", color = colors$text),
    axis.text = element_text(, color = colors$text, size = rel(0.6)),
    plot.title = element_markdown(
      size = rel(1.8),
      family = fonts$title,
      face = "bold",
      color = colors$title,
      lineheight = 1.15,
      margin = margin(t = 5, b = 5)
    ),
    plot.subtitle = element_markdown(
      size = rel(0.65),
      family = fonts$subtitle,
      color = colors$subtitle,
      lineheight = 1.5,
      margin = margin(t = 5, b = 5)
    ),
    plot.caption = element_markdown(
      size = rel(0.45),
      family = fonts$subtitle,
      color = colors$caption,
      hjust = 0,
      lineheight = 1.4,
      margin = margin(t = 10, b = 5)
    ),
  )
```

7. Save

Show code
```{r}
#| label: save
#| warning: false

### |-  plot image ----  
save_plot(
  plot = p, 
  type = "tidytuesday", 
  year = 2026, 
  week = 03, 
  width  = 8,
  height = 6,
  )
```

8. Session Info

R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26100)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/New_York
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
 [1] here_1.0.1      glue_1.8.0      scales_1.3.0    janitor_2.2.0  
 [5] ggrepel_0.9.6   showtext_0.9-7  showtextdb_3.0  sysfonts_0.8.9 
 [9] ggtext_0.1.2    lubridate_1.9.3 forcats_1.0.0   stringr_1.5.1  
[13] dplyr_1.1.4     purrr_1.0.2     readr_2.1.5     tidyr_1.3.1    
[17] tibble_3.2.1    ggplot2_3.5.1   tidyverse_2.0.0 pacman_0.5.1   

loaded via a namespace (and not attached):
 [1] gtable_0.3.6       httr2_1.0.6        xfun_0.49          htmlwidgets_1.6.4 
 [5] gh_1.4.1           tzdb_0.5.0         vctrs_0.6.5        tools_4.4.0       
 [9] generics_0.1.3     parallel_4.4.0     curl_6.0.0         gifski_1.32.0-1   
[13] fansi_1.0.6        pkgconfig_2.0.3    lifecycle_1.0.4    farver_2.1.2      
[17] compiler_4.4.0     textshaping_0.4.0  munsell_0.5.1      codetools_0.2-20  
[21] snakecase_0.11.1   htmltools_0.5.8.1  yaml_2.3.10        crayon_1.5.3      
[25] pillar_1.9.0       camcorder_0.1.0    magick_2.8.5       commonmark_1.9.2  
[29] tidyselect_1.2.1   digest_0.6.37      stringi_1.8.4      labeling_0.4.3    
[33] rsvg_2.6.1         rprojroot_2.0.4    fastmap_1.2.0      grid_4.4.0        
[37] colorspace_2.1-1   cli_3.6.4          magrittr_2.0.3     utf8_1.2.4        
[41] withr_3.0.2        rappdirs_0.3.3     bit64_4.5.2        timechange_0.3.0  
[45] rmarkdown_2.29     tidytuesdayR_1.1.2 gitcreds_0.1.2     bit_4.5.0         
[49] ragg_1.3.3         hms_1.1.3          evaluate_1.0.1     knitr_1.49        
[53] markdown_1.13      rlang_1.1.6        gridtext_0.1.5     Rcpp_1.0.13-1     
[57] xml2_1.3.6         renv_1.0.3         vroom_1.6.5        svglite_2.1.3     
[61] rstudioapi_0.17.1  jsonlite_1.8.9     R6_2.5.1           systemfonts_1.1.0

9. GitHub Repository

The complete code for this analysis is available in tt_2026_03.qmd.

For the full repository, click here.

10. References

  1. Data Source:
  2. Cosmic Distance Landmarks:
  3. Article:

11. Custom Functions Documentation

This analysis uses custom functions from my personal module library for efficiency and consistency across projects.

Functions Used:

  • fonts.R: setup_fonts(), get_font_families() - Font management with showtext
  • social_icons.R: create_social_caption() - Generates formatted social media captions
  • image_utils.R: save_plot() - Consistent plot saving with naming conventions
  • base_theme.R: create_base_theme(), extend_weekly_theme(), get_theme_colors() - Custom ggplot2 themes

Why custom functions?
These utilities standardize theming, fonts, and output across all my data visualizations. The core analysis (data tidying and visualization logic) uses only standard tidyverse packages.

Source Code:
View all custom functions → GitHub: R/utils

Back to top

Citation

BibTeX citation:
@online{ponce2026,
  author = {Ponce, Steven},
  title = {How {Far} {Does} {APOD} {Take} {Us?}},
  date = {2026-01-18},
  url = {https://stevenponce.netlify.app/data_visualizations/TidyTuesday/2026/tt_2026_03.html},
  langid = {en}
}
For attribution, please cite this work as:
Ponce, Steven. 2026. “How Far Does APOD Take Us?” January 18. https://stevenponce.netlify.app/data_visualizations/TidyTuesday/2026/tt_2026_03.html.