Recreating bar chart with R and ggplot2

Question

Heyy, can anyone help with recreating a graph in R using ggplot2?

library(ggplot)
library(tidyverse)
library(ggthemes)

We were thinking of creating two separate graphs and combining them using patchwork or cowplot and also ggthemes for the design. Would be great if anyone with some more experience could help us with how to approach this task. Any help is much appreciated!

Answer 1

Just out of curiosity and as an exercise, here is a possible approach to recreate the original FiveThirtyEight chart based on facet_grid and many additional customizations for the right look and all the details.

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
)