1 准备数据

library(tidyverse)
library(camcorder)

files_path <- "posts/ggplot2-tidytuesday-2025week2/tech/datas"

read_and_clean <- function(files_path) {
  household_raw <- rio::import(files_path, sheet = "QD4_3", skip = 8)

  household_raw %>%
    select(1:5) %>%
    select(-1) %>%
    mutate(country_code = colnames(.[2])) %>%
    select(
      country_code,
      "response" = 1,
      "total" = 2,
      "men" = 3,
      "women" = 4
    ) %>%
    filter(response %in% c("Total 'Agree'", "Total 'Disagree'")) %>%
    mutate(across(total:women, as.numeric))
}

household <- list.files(
  path = here::here(files_path),
  full.names = TRUE,
  pattern = "ST.+xlsx$"
) %>%
  map_df(\(x) read_and_clean(x))

1.1 数据清洗

household_plot <- household %>%
  filter(response == "Total 'Agree'") %>%
  mutate(
    difference = women - men,
    men = if_else(difference == 0, men + 0.00075, men),
    women = if_else(difference == 0, women - 0.00075, women)
  ) %>%
  pivot_longer(
    men:women,
    names_to = "gender",
    values_to = "ratio"
  ) %>%
  mutate(
    country = countrycode::countrycode(
      country_code,
      origin = "eurostat",
      destination = "country.name"
    ),
    country = fct_reorder(country, total)
  ) %>%
  group_by(country) %>%
  mutate(
    mid_ratio = mean(ratio),
    highest_ratio = if_else(difference > 0, "women", "men")
  ) %>%
  ungroup()

2 数据可视化

p <- ggplot(household_plot, aes(x = ratio, y = country)) +
  geom_vline(xintercept = 0.5, linetype = "dotted") +
  geom_tile(
    aes(
      x = mid_ratio,
      width = abs(difference) - 0.0125,
      fill = highest_ratio
    ),
    height = 0.15,
    alpha = 0.6,
    stat = "unique",
    show.legend = FALSE
  ) +
  geom_point(
    aes(fill = gender),
    alpha = 0.8,
    size = 5,
    shape = 21,
    color = "grey99"
  ) +
  shadowtext::geom_shadowtext(
    data = . %>% filter(gender != highest_ratio),
    aes(label = country),
    stat = "unique",
    hjust = 1,
    nudge_x = -0.015,
    color = "grey30",
    bg.color = "grey99",
    vjust = 0.45
  ) +
  scale_x_continuous(
    labels = scales::percent_format(),
    breaks = seq(0.2, 1, 0.1),
    minor_breaks = seq(0.15, 1, 0.05),
    limits = c(0.1, 0.75)
  ) +
  scale_fill_manual(
    values = c("#4caf50", "#9c27b0"),
    guide = guide_legend(reverse = TRUE)
  ) +
  coord_cartesian(clip = "off") +
  labs(
    title = "'Overall, men are naturally less competent than women to perform household tasks'",
    color = " ",
    fill = ""
  ) +
  theme_minimal() +
  theme(
    legend.position = "top",
    legend.text = element_text(size = 12),
    plot.background = element_rect(fill = "grey99", color = NA),
    panel.grid.major.y = element_blank(),
    axis.title = element_blank(),
    axis.text = element_text(size = 10),
    axis.text.y = element_blank(),
    plot.title = element_text(face = "bold"),
    plot.subtitle = element_text(lineheight = 1),
    plot.margin = margin(c(15, 15, 10, 10))
  )

p

ggsave(
  "p.png",
  p,
  width = 10,
  height = 8,
  dpi = 300,
  units = "in"
)