rdataframeggplot2

Show percentages on specific categories in likert plot using ggplot2


i have a data frame in R called df :

# Define categories and Likert levels
var_levels <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")

likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

# Set seed for reproducibility
set.seed(42)

# Create the dataframe with three Likert response columns
df <- tibble(
  var = sample(var_levels, 50, replace = TRUE),  # Random values from A to Q
  val1 = sample(likert_levels, 50, replace = TRUE) # Random values from Likert levels
  
)


library(tidyverse)
library(ggstats)

dat <- df |>
  mutate(
    across(-var, ~ factor(.x, likert_levels))
  ) |>
  pivot_longer(-var, names_to = "group") |>
  count(var, value, group) |>
  complete(var, value, group, fill = list(n = 0)) |>
  mutate(
    prop = n / sum(n),
    prop_lower = sum(prop[value %in% c("Strongly disagree", "Disagree")]),
    prop_higher = sum(prop[value %in% c("Strongly agree", "Agree")]),
    .by = c(var, group)
  ) |>
  arrange(group, prop_lower) |>
  mutate(
    y_sort = paste(var, group, sep = "."),
    y_sort = fct_inorder(y_sort)
  )

top10 <- dat |>
  distinct(group, var, prop_lower) |>
  slice_max(prop_lower, n = 10, by = group)

dat <- dat |>
  semi_join(top10)
#> Joining with `by = join_by(var, group, prop_lower)`

dat_tot <- dat |>
  distinct(group, var, y_sort, prop_lower, prop_higher) |>
  pivot_longer(-c(group, var, y_sort),
               names_to = c(".value", "name"),
               names_sep = "_"
  ) |>
  mutate(
    hjust_tot = ifelse(name == "lower", 1, 0),
    x_tot = ifelse(name == "lower", -1, 1)
  )

i want to calculate the liekrt chart :

p1 <- ggplot(dat, aes(y = y_sort, x = prop, fill = value)) +
  geom_col(position = position_likert(reverse = FALSE)) +
  geom_text(
    aes(
      label = label_percent_abs(hide_below = .05, accuracy = 1)(prop),
      color = after_scale(hex_bw(.data$fill))
    ),
    position = position_likert(vjust = 0.5, reverse = FALSE),
    size = 3.5
  ) +
  geom_label(
    aes(
      x = x_tot,
      label = label_percent_abs(accuracy = 1)(prop),
      hjust = hjust_tot,
      fill = NULL
    ),
    data = dat_tot,
    size = 3.5,
    color = "black",
    fontface = "bold",
    label.size = 0,
    show.legend = FALSE
  ) +
  scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
  scale_x_continuous(
    labels = label_percent_abs(),
    expand = c(0, .15)
  ) +
  scale_fill_brewer(palette = "BrBG") +
  facet_wrap(~group,
             scales = "free_y", ncol = 1,
             strip.position = "right"
  ) +
  theme_light() +
  theme(
    legend.position = "bottom",
    panel.grid.major.y = element_blank()
  ) +
  labs(x = NULL, y = NULL, fill = NULL)

resulting to the image. But i want to see only the totals at right and at left and the middle category. Not to show the "Disaggree" or "Agree" percentages. For example in the picture in the last line i want ot show 33% at left 33% at right and 33% at the white color bar for "Neither agree nor disagree" likert category.

How can i do it in R ?

enter image description here


Solution

  • To achieve your desired result you can use an ifelse to assign the non-desired categories an empty "" as the label:

    library(ggplot2)
    library(ggstats)
    
    ggplot(dat, aes(y = y_sort, x = prop, fill = value)) +
      geom_col(position = position_likert(reverse = FALSE)) +
      geom_text(
        aes(
          label = ifelse(
            value %in% "Neither agree nor disagree",
            label_percent_abs(hide_below = .05, accuracy = 1)(prop),
            ""
          ),
          color = after_scale(hex_bw(.data$fill))
        ),
        position = position_likert(vjust = 0.5, reverse = FALSE),
        size = 3.5
      ) +
      geom_label(
        aes(
          x = x_tot,
          label = label_percent_abs(accuracy = 1)(prop),
          hjust = hjust_tot,
          fill = NULL
        ),
        data = dat_tot,
        size = 3.5,
        color = "black",
        fontface = "bold",
        label.size = 0,
        show.legend = FALSE
      ) +
      scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
      scale_x_continuous(
        labels = label_percent_abs(),
        expand = c(0, .15)
      ) +
      scale_fill_brewer(palette = "BrBG") +
      facet_wrap(~group,
        scales = "free_y", ncol = 1,
        strip.position = "right"
      ) +
      theme_light() +
      theme(
        legend.position = "bottom",
        panel.grid.major.y = element_blank()
      ) +
      labs(x = NULL, y = NULL, fill = NULL)
    

    enter image description here