Visualizing Anscombe’s Quartet

Different shapes can have similar summary statistics
R
#TidyTuesday
scatter-plot
Author

Mickey Rafa

Published

October 16, 2020

Figure 1: Anscombe’s Quartet is a statistical trap, where datasets with fundamentally different characteristics and distributions can have the same (or very similar) summary statistics. This dataset is a modern more example that shows this trap in action. The graphic above visualizes a bullseye, dinosaur, and star, which are similar in their summary statistics but are obviously quite different visually.

1. Load Packages & Setup

Show code
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
    tidyverse,
    tidytuesdayR,
    patchwork,
    ggtext,
    showtext,
    janitor,   #for clean_names()
    glue,
    here
)    

font_add_google('Source Code Pro')
showtext_auto()

2. Read in the Data

Show code
tt_year <- 2020
tt_week <- 42

tuesdata <- tidytuesdayR::tt_load(tt_year, week = tt_week)

datasaurus <- tuesdata$datasaurus

3. Examine the Data

Show code
datasaurus %>% 
  glimpse()
Rows: 1,846
Columns: 3
$ dataset <chr> "dino", "dino", "dino", "dino", "dino", "dino", "dino", "dino"…
$ x       <dbl> 55.3846, 51.5385, 46.1538, 42.8205, 40.7692, 38.7179, 35.6410,…
$ y       <dbl> 97.1795, 96.0256, 94.4872, 91.4103, 88.3333, 84.8718, 79.8718,…

4. Tidy the Data

Show code
sum_datasaurus <- datasaurus %>% 
  group_by(dataset) %>% 
  summarise_all(list(mean = mean, 
                     min = min, 
                     max = max,
                     sd = sd))

column_names <- c('dataset', 'Mean(x)', 'Mean(y)', 'Min(x)', 'Min(y)', 'Max(x)', 'Max(y)', 'Std Dev(x)', 'Std Dev(y)')

names(sum_datasaurus) <- column_names

sum_datasaurus <- sum_datasaurus %>% 
  gather(summary_statistic, value, 2:9) %>% 
  mutate(value = round(value, 2)) %>% 
  mutate(label = paste(summary_statistic, value, sep = " = "))

sum_datasaurus$summary_statistic <- factor(sum_datasaurus$summary_statistic, 
                                           levels =  c('Std Dev(y)', 'Std Dev(x)', 
                                                       'Min(y)', 'Min(x)', 
                                                       'Max(y)', 'Max(x)', 
                                                       'Mean(y)', 'Mean(x)'))

5. Visualization Parameters

Show code
my_theme <- theme(
  # choose font family
  text = element_text(family = 'Source Code Pro', size=12, color='black'), 
  axis.ticks = element_blank(), 
  plot.background = element_blank(),
  panel.background =  element_blank(), 
  legend.background = element_blank(), 
  panel.grid.major = element_line(colour = "grey90", linewidth = 0.5),
  panel.grid.minor = element_line(colour = "grey93", linewidth = 0.5),
  panel.border = element_blank(),
  strip.text = element_textbox(size=rel(2), face='bold'))

6. Plot

Show code
facet_datasaurus_viz <- datasaurus %>% 
  filter(dataset %in% c('dino', 'bullseye', 'star')) %>% 
  ggplot(.) + 
  geom_point(aes(x=x,
                 y=y),
             size=.7) + 
  facet_wrap(~dataset,
             ncol = 1) + 
  my_theme

datasaurus_summary_stat_viz <- sum_datasaurus %>% 
  filter(dataset %in% c('dino', 'bullseye', 'star')) %>% 
  mutate(nrow = row_number()) %>% 
  ggplot(.) + 
  geom_text(aes(x=1,
                y=-nrow,
                label=label),
            family="Source Code Pro",
            size=7) + 
  facet_wrap(~dataset,
             ncol = 1) + 
  my_theme + 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.title = element_blank(),
        axis.text = element_blank())
Show code
datasaurus_viz <- datasaurus_summary_stat_viz + facet_datasaurus_viz + 
  plot_annotation(title = '**Summary statistics can mislead**',
                  subtitle = "The Anscombe Quartet is a statistical trap that demonstrates that summary statistics can be misleading. The visualization below shows three contemporary examples of the Anscombe Quartet problem. **Only by visualizing the data** can you understand the dramatic differences in the distribution of the data.",
                  caption = '**Source**: Tidy Tuesday Week 41 (2020)',
                  theme = theme(plot.title = element_textbox(size=rel(4.5), face='bold'),
                                plot.subtitle = element_textbox_simple(size=rel(2), lineheight=.3),
                                plot.caption = element_textbox(size=rel(1.5)))
                  )

7. Save

Show code
# Save the plot as PNG
ggsave(
  filename = glue("tt_{tt_year}_{tt_week}.png"),
  plot = datasaurus_viz,
  width = 5, height = 5, units = "in", dpi = 320
)

# make thumbnail for page
magick::image_read(glue("tt_{tt_year}_{tt_week}.png")) %>%
  magick::image_resize(geometry = "400") %>%
  magick::image_write(glue("tt_{tt_year}_{tt_week}_thumbnail.png"))

8. Session Info

R version 4.4.0 (2024-04-24)
Platform: aarch64-apple-darwin20
Running under: macOS Sonoma 14.6.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: America/Denver
tzcode source: internal

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

other attached packages:
 [1] here_1.0.1         glue_1.8.0         janitor_2.2.0      showtext_0.9-7    
 [5] showtextdb_3.0     sysfonts_0.8.9     ggtext_0.1.2       patchwork_1.3.0   
 [9] tidytuesdayR_1.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.5      xfun_0.48         httr2_1.0.5       htmlwidgets_1.6.4
 [5] gh_1.4.1          tzdb_0.4.0        vctrs_0.6.5       tools_4.4.0      
 [9] generics_0.1.3    curl_5.2.3        parallel_4.4.0    fansi_1.0.6      
[13] pkgconfig_2.0.3   lifecycle_1.0.4   compiler_4.4.0    farver_2.1.2     
[17] textshaping_0.4.0 munsell_0.5.1     snakecase_0.11.1  htmltools_0.5.8.1
[21] yaml_2.3.10       pillar_1.9.0      crayon_1.5.3      magick_2.8.5     
[25] commonmark_1.9.2  tidyselect_1.2.1  digest_0.6.37     stringi_1.8.4    
[29] labeling_0.4.3    rprojroot_2.0.4   fastmap_1.2.0     grid_4.4.0       
[33] colorspace_2.1-1  cli_3.6.3         magrittr_2.0.3    utf8_1.2.4       
[37] withr_3.0.1       scales_1.3.0      rappdirs_0.3.3    bit64_4.5.2      
[41] timechange_0.3.0  rmarkdown_2.28    gitcreds_0.1.2    bit_4.5.0        
[45] ragg_1.3.3        hms_1.1.3         evaluate_1.0.1    knitr_1.48       
[49] markdown_1.13     rlang_1.1.4       gridtext_0.1.5    Rcpp_1.0.13      
[53] xml2_1.3.6        rstudioapi_0.17.1 vroom_1.6.5       jsonlite_1.8.9   
[57] R6_2.5.1          systemfonts_1.1.0

9. Github Repository