出于好奇心和练习，这里有一种可能的方法来重新创建基于facet_grid的原始FiveThirtyEight图表，并进行许多额外的自定义，以获得正确的外观和所有细节。

library(tidyverse)
library(ggthemes)
data <- read_csv("https://raw.githubusercontent.com/fivethirtyeight/data/master/masculinity-survey/raw-responses.csv", col_names = TRUE) %>%
  select(q0005, age3)
table(data$q0005)
pal_color <- c("#ED713A", "#8DDADF", "#CDCDCD")
names(pal_color) <- c("Yes", "No", "No answer")
pal_fte <- deframe(ggthemes::ggthemes_data[["fivethirtyeight"]])
data_sum <- data |>
  count(q0005, age3) |>
  mutate(group = "b")
data_sum <- data_sum |>
  summarise(
    group = "a",
    age3 = "All adult men",
    n = sum(n),
    .by = q0005
  ) |>
  bind_rows(data_sum) |>
  mutate(pct = n / sum(n), .by = age3) |>
  mutate(
    age3 = case_match(
      age3,
      "18 - 34" ~ "18-34",
      "35 - 64" ~ "35-64",
      "65 and up" ~ "65+",
      .default = age3
    ),
    age3 = factor(
      age3,
      rev(c("18-34", "35-64", "65+", "All adult men"))
    ),
    q0005 = factor(
      q0005,
      rev(c("Yes", "No answer", "No"))
    )
  )
data_labels <- data_sum |>
  filter(group == "a") |>
  arrange(desc(q0005)) |>
  mutate(
    pct = cumsum(pct),
    pctlag = lag(pct, default = 0),
    y = .5 * pct + .5 * pctlag
  )
data_segment <- data_labels |>
  filter(q0005 == "No answer")
data_labels <- data_labels |> 
  filter(q0005 != "No answer")
ggplot(data_sum, aes(pct, age3)) +
  geom_segment(
    data = data_segment,
    aes(
      x = .4, xend = y,
    ),
    y = 0, yend = 0, color = pal_fte[["Dark Gray"]]
  ) +
  geom_segment(
    data = data_segment,
    aes(
      x = y, xend = y,
    ),
    y = 0, yend = 1, color = pal_fte[["Dark Gray"]]
  ) +
  geom_label(
    data = data.frame(
      x = .4, group = "a", hjust = 0,
      label = "No answer"
    ),
    aes(x = x, hjust = hjust, label = label),
    y = 0, hjust = 0, color = pal_fte[["Dark Gray"]],
    label.size = 0, fill = pal_fte[["Light Gray"]],
    inherit.aes = FALSE, size = .8 * 12 / .pt
  ) +
  geom_vline(
    xintercept = .5
  ) +
  geom_col(aes(fill = q0005), width = .6) +
  geom_vline(
    xintercept = c(0, 1)
  ) +
  geom_label(
    data = data_labels,
    aes(x = pctlag, label = q0005),
    hjust = 0, nudge_x = .025,
    fontface = "bold", label.size = 0, fill = NA,
    size = .8 * 12 / .pt
  ) +
  geom_text(
    aes(x = -.25, hjust = 0, label = age3),
    fontface = "bold", size = .8 * 12 / .pt
  ) +
  geom_text(
    data = data.frame(
      group = "b"
    ),
    aes(x = -.25, hjust = 0, label = "BY AGE GROUP"),
    y = 4, color = "black",
    size = .6 * 12 / .pt
  ) +
  scale_fill_manual(
    values = pal_color,
    guide = "none"
  ) +
  scale_x_continuous(
    breaks = seq(0, 1, .1),
    labels = \(x) paste0(100 * x, c("%", rep("", 10))),
    position = "top",
    expand = c(0, 0)
  ) +
  coord_cartesian(clip = "off") +
  facet_grid(group ~ ., space = "free_y", scales = "free_y") +
  ggthemes::theme_fivethirtyeight(base_size = 12) +
  theme(
    panel.grid.major.y = element_blank(),
    strip.text.y = element_blank(),
    panel.spacing.y = unit(1, "cm"),
    axis.text.y = element_blank(),
    axis.text.x = element_text(
      family = "mono",
      color = pal_fte[["Dark Gray"]]
    ),
    plot.title.position = "plot",
    plot.title = element_text(
      size = rel(1.25)
    ),
    plot.caption = element_text(
      family = "mono",
      size = rel(.6),
      color = pal_fte[["Dark Gray"]],
      margin = margin(20, unit = "pt")
    ),
    plot.caption.position = "plot"
  ) +
  labs(
    x = NULL, y = NULL,
    title = paste(
      "Do you think society puts pressure on men in a way",
      "that is unhealthy or bad for them?",
      sep = "\n"
    ),
    subtitle = "",
    caption = "SOURCE: FIVETHIRTYEIGHT/DEATH, SEX & MONEY/SURVEY"
  )
ggsave("fivethirtyeight.png",
  width = 550, height = 350, units = "px",
  dpi = 300, scale = 300 / 96
)

字符串

的数据