Gender Differences in Color Ranking Accuracy

Analysis of ~64K users from the xkcd Color Survey.

TidyTuesday
Data Visualization
R Programming
2025
An analysis of gender differences in color ranking accuracy using data from the famous xkcd Color Survey. This study examines 64,775 users who ranked colors on a 1-5 scale, revealing statistically significant but practically small differences between groups.
Author

Steven Ponce

Published

July 8, 2025

Figure 1: Two-panel chart showing gender differences in color ranking accuracy from 64,775 xkcd Color Survey users. Top panel shows distribution curves where males have slightly higher accuracy scores than females. Bottom panel displays mean accuracy with confidence intervals: Males with normal vision score highest (0.414), followed by females with normal vision (0.409), females who are colorblind (0.393), and males who are colorblind (0.39). A dashed vertical line shows the overall mean (0.412). The gender difference is small (1.3%) but statistically significant.

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
    janitor,    # Simple Tools for Examining and Cleaning Dirty Data
    scales,     # Scale Functions for Visualization
    glue,       # Interpreted String Literals
    patchwork,  # The Composer of Plots
    effsize     # Efficient Effect Size Computation 
  )})

### |- figure size ----
camcorder::gg_record(
  dir    = here::here("temp_plots"),
  device = "png",
   width  = 10,
  height =  10,
  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(2025, week = 27)

answers <- tt$answers |> clean_names()
users <- tt$users |> clean_names()

tidytuesdayR::readme(tt)
rm(tt)
```

3. Examine the Data

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

glimpse(answers)
glimpse(users)
```

4. Tidy Data

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

# Data preparation
user_accuracy <- answers |>
  left_join(users, by = "user_id") |>
  filter(!is.na(y_chromosome), !is.na(colorblind)) |>
  group_by(user_id, y_chromosome, colorblind) |>
  summarise(
    avg_user_rank = mean(rank, na.rm = TRUE),
    accuracy_score = 1 / avg_user_rank,
    total_answers = n(),
    .groups = "drop"
  ) |>
  filter(total_answers >= 5)

# Plot 1 data
accuracy_by_groups <- user_accuracy |>
  mutate(
    chromosome_label = ifelse(y_chromosome == 1, "Males", "Females"),
    colorblind_label = ifelse(colorblind == 1, "Colorblind", "Normal Vision"),
    user_group = case_when(
      y_chromosome == 1 & colorblind == 0 ~ "Males\nNormal Vision",
      y_chromosome == 1 & colorblind == 1 ~ "Males\nColorblind",
      y_chromosome == 0 & colorblind == 0 ~ "Females\nNormal Vision",
      y_chromosome == 0 & colorblind == 1 ~ "Females\nColorblind"
    )
  ) |>
  filter(!is.na(user_group))

# Plot 2 data
group_stats <- accuracy_by_groups |>
  group_by(user_group) |>
  summarise(
    n = n(),
    mean_acc = mean(accuracy_score),
    median_acc = median(accuracy_score),
    se_acc = sd(accuracy_score) / sqrt(n()),
    ci_lower = mean_acc - 1.96 * se_acc,
    ci_upper = mean_acc + 1.96 * se_acc,
    .groups = "drop"
  ) |>
  mutate(
    gender = ifelse(str_detect(user_group, "Males"), "Males", "Females"),
    vision = ifelse(str_detect(user_group, "Colorblind"), "Colorblind", "Normal Vision")
  )

# key statistics

# overall mean for reference line
overall_mean <- mean(accuracy_by_groups$accuracy_score)

# t-test
gender_ttest <- t.test(accuracy_score ~ chromosome_label, data = accuracy_by_groups)

# Percentage difference
summary_stats <- accuracy_by_groups %>%
  group_by(chromosome_label, colorblind_label) %>%
  summarise(
    n = n(),
    mean_acc = mean(accuracy_score),
    .groups = "drop"
  )

male_mean <- summary_stats$mean_acc[summary_stats$chromosome_label == "Males" &
  summary_stats$colorblind_label == "Normal Vision"]
female_mean <- summary_stats$mean_acc[summary_stats$chromosome_label == "Females" &
  summary_stats$colorblind_label == "Normal Vision"]

percentage_diff <- ((male_mean - female_mean) / female_mean) * 100

# Effect size
gender_cohens_d <- cohen.d(
  accuracy_by_groups$accuracy_score,
  accuracy_by_groups$chromosome_label
)
cohens_d_value <- abs(gender_cohens_d$estimate)

# Descriptive variables
gender_sig <- ifelse(gender_ttest$p.value < 0.001, "p < 0.001",
                     ifelse(gender_ttest$p.value < 0.01, "p < 0.01",
                            ifelse(gender_ttest$p.value < 0.05, "p < 0.05", 
                                   paste("p =", round(gender_ttest$p.value, 3)))))

gender_effect_desc <- ifelse(cohens_d_value < 0.2, "very small",
                             ifelse(cohens_d_value < 0.5, "small", 
                                    ifelse(cohens_d_value < 0.8, "medium", "large")))
```

5. Visualization Parameters

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

### |-  plot aesthetics ----
colors <- get_theme_colors(
  palette = c("#DDA853", "#27548A")
)

### |- titles and caption ----
title_text <- str_glue("Gender Differences in Color Ranking Accuracy")

subtitle_text <- str_glue(
    "Analysis of ", scales::comma(nrow(accuracy_by_groups)), " users from the xkcd Color Survey.<br><br>",        
    "**Key Findings:**<br>", 
    "Males show ", round(percentage_diff, 1), "% higher accuracy. ",
    "Gender effect size is ", gender_effect_desc, " (", gender_sig, "). ",
    "Colorblindness has minimal impact."
    )

caption_text <- create_social_caption(
  tt_year = 2025,
  tt_week = 27,
  source_text =  "xkcd Color Survey SQLite database"
)

### |-  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(
    # Axis elements
    axis.text = element_text(color = colors$text, size = rel(0.7)),
    axis.title.x = element_text(color = colors$text, face = "bold", size = rel(0.8), margin = margin(t = 15)),
    axis.title.y = element_text(color = colors$text, face = "bold", size = rel(0.8), margin = margin(r = 10)),

    # Grid elements
    panel.grid.major.y = element_line(color = "gray50", linewidth = 0.05),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),

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

    # Plot margin
    plot.margin = margin(t = 15, r = 15, b = 15, l = 15),
  )
)

# Set theme
theme_set(weekly_theme)
```

6. Plot

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

# Plot 1: Distribution plot
p1 <- ggplot(accuracy_by_groups, aes(x = accuracy_score, fill = chromosome_label)) +
  # Geoms
  geom_density(alpha = 0.65, size = 0.8) +
  # Annotations
  geom_richtext(
    data = tibble(
      accuracy_score = c(0.55, 0.6),
      y = c(6, 6),
      chromosome_label = c("Females", "Males"),
      label = c("More variable", "Slightly more accurate")
    ), aes(x = accuracy_score, y = y, label = label),
    inherit.aes = FALSE,
    size = 3.5, fontface = "italic",
    color = colors$palette
  ) +
  # Scales
  scale_fill_manual(
    values = colors$palette,
    name = "Group"
  ) +
  # Labs
  labs(
    title = "Distribution of Color Accuracy",
    subtitle = "Males show slight rightward shift (higher accuracy)",
    x = "Accuracy Score",
    y = "Density"
  ) +
  # Facets
  facet_wrap(~chromosome_label) +
  # Theme
  theme(
    legend.position = "none",
    panel.grid.minor = element_blank(),
    strip.text = element_text(face = "bold", size = 12),
    plot.title = element_text(
      size = rel(1.5),
      family = fonts$title,
      face = "bold",
      color = colors$title,
      hjust = 0.5,
      lineheight = 1.1,
      margin = margin(t = 5, b = 5)
    ),
    plot.subtitle = element_text(
      size = rel(0.9),
      family = fonts$subtitle,
      color = colors$subtitle,
      hjust = 0.5,
      lineheight = 1.2,
      margin = margin(t = 5, b = 20)
    ),
  )

# Plot 2: dot-range plot
p2 <- ggplot(group_stats, aes(x = mean_acc, y = reorder(user_group, mean_acc))) +
  # Geoms
  geom_segment(
    aes(
      x = ci_lower, xend = ci_upper,
      y = user_group, yend = user_group,
      color = gender
    ),
    size = 1.5, alpha = 0.8
  ) +
  geom_point(aes(color = gender), size = 4, alpha = 0.9) +
  geom_text(aes(label = paste0("n=", scales::comma(n))),
    hjust = 0.5, vjust = 2.5, size = 3, color = "gray30"
  ) +
  geom_text(aes(label = round(mean_acc, 3)),
    hjust = 0.5, vjust = -2, size = 3.5, fontface = "bold"
  ) +
  geom_vline(
    xintercept = overall_mean,
    linetype = "dashed", color = "gray50", alpha = 0.7
  ) +
  # Annotate
  annotate("text",
    x = overall_mean + 0.004, y = 0.5,
    label = paste0("Overall Mean\n(", round(overall_mean, 3), ")"),
    hjust = 0.5, vjust = 0, size = 3,
    color = "gray50", fontface = "italic"
  ) +
  # Scales
  scale_color_manual(
    values = colors$palette,
    name = "Gender"
  ) +
  scale_x_continuous(
    labels = scales::number_format(accuracy = 0.001),
    limits = c(
      min(group_stats$ci_lower) * 0.95,
      max(group_stats$ci_upper) * 1.05
    )
  ) +
  # Labs
  labs(
    title = "Mean Color Accuracy with 95% Confidence Intervals",
    subtitle = "Colorblindness has surprisingly minimal impact on ranking performance",
    x = "Mean Accuracy Score",
    y = NULL
  ) +
  # Theme
  theme(
    legend.position = "plot",
    panel.grid.minor = element_blank(),
    panel.grid.major.y = element_blank(),
    axis.text.y = element_text(size = 11),
    plot.title = element_text(
      size = rel(1.5),
      family = fonts$title,
      face = "bold",
      color = colors$title,
      hjust = 0.5,
      lineheight = 1.1,
      margin = margin(t = 5, b = 5)
    ),
    plot.subtitle = element_text(
      size = rel(0.9),
      family = fonts$subtitle,
      color = colors$subtitle,
      hjust = 0.5,
      lineheight = 1.2,
      margin = margin(t = 5, b = 5)
    ),
  )

# Combine plots 
combined_plot <- p1 / p2 +
  plot_layout(heights = c(0.8, 1.2)) 
  
combined_plot <- combined_plot +  
  plot_annotation(
    title = title_text,
    subtitle = subtitle_text,
    caption = caption_text,
    theme = theme(
      plot.title = element_text(
        size = rel(1.75),
        family = fonts$title,
        face = "bold",
        color = colors$title,
        lineheight = 1.1,
        margin = margin(t = 5, b = 5)
      ),
      plot.subtitle = element_markdown(
        size = rel(0.9),
        family = fonts$subtitle,
        color = colors$subtitle,
        lineheight = 1.2,
        margin = margin(t = 5, b = 10)
      ),
      plot.caption = element_markdown(
        size = rel(0.6),
        family = fonts$caption,
        color = colors$caption,
        hjust = 0.5,
        margin = margin(t = 10)
      )
    )
  )
```

7. Save

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

### |-  plot image ----  
save_plot_patchwork(
  plot = combined_plot, 
  type = "tidytuesday", 
  year = 2025, 
  week = 27, 
  width  = 10,
  height = 10
)
```

8. Session Info

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

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      effsize_0.8.1   patchwork_1.3.0 glue_1.8.0     
 [5] scales_1.3.0    janitor_2.2.0   showtext_0.9-7  showtextdb_3.0 
 [9] sysfonts_0.8.9  ggtext_0.1.2    lubridate_1.9.3 forcats_1.0.0  
[13] stringr_1.5.1   dplyr_1.1.4     purrr_1.0.2     readr_2.1.5    
[17] tidyr_1.3.1     tibble_3.2.1    ggplot2_3.5.1   tidyverse_2.0.0
[21] 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         yulab.utils_0.1.8  vctrs_0.6.5       
 [9] tools_4.4.0        generics_0.1.3     parallel_4.4.0     curl_6.0.0        
[13] gifski_1.32.0-1    fansi_1.0.6        pkgconfig_2.0.3    ggplotify_0.1.2   
[17] lifecycle_1.0.4    compiler_4.4.0     farver_2.1.2       munsell_0.5.1     
[21] codetools_0.2-20   snakecase_0.11.1   htmltools_0.5.8.1  yaml_2.3.10       
[25] crayon_1.5.3       pillar_1.9.0       camcorder_0.1.0    magick_2.8.5      
[29] commonmark_1.9.2   tidyselect_1.2.1   digest_0.6.37      stringi_1.8.4     
[33] labeling_0.4.3     rsvg_2.6.1         rprojroot_2.0.4    fastmap_1.2.0     
[37] grid_4.4.0         colorspace_2.1-1   cli_3.6.4          magrittr_2.0.3    
[41] utf8_1.2.4         withr_3.0.2        rappdirs_0.3.3     bit64_4.5.2       
[45] timechange_0.3.0   rmarkdown_2.29     tidytuesdayR_1.1.2 gitcreds_0.1.2    
[49] bit_4.5.0          hms_1.1.3          evaluate_1.0.1     knitr_1.49        
[53] markdown_1.13      gridGraphics_0.5-1 rlang_1.1.6        gridtext_0.1.5    
[57] Rcpp_1.0.13-1      xml2_1.3.6         renv_1.0.3         vroom_1.6.5       
[61] svglite_2.1.3      rstudioapi_0.17.1  jsonlite_1.8.9     R6_2.5.1          
[65] fs_1.6.5           systemfonts_1.1.0

9. GitHub Repository

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

For the full repository, click here.

10. References

  1. Data Sources:
  • TidyTuesday 2025 Week 27: [The xkcd Color Survey Results](https://github.com/rfordatascience/tidytuesday/blob/main/data/2025/2025-07-08)
Back to top