rdataframeggplot2

Combine likert plot from appended data frame and bar plot from pure data frame in R using ggplot2


I have a data frame in R called df :

library(tibble)
library(tidyverse)
library(ggplot2)
library(ggstats)

var_levels <- c(LETTERS[1:20])
n = 500
likert_levels = c(
  "Very \n Dissatisfied",
  "Dissatisfied",
  "Neutral",
  "Satisfied",
  "Very \n Satisfied"
)

df <- tibble(
  var = sample(var_levels, n, replace = TRUE),  
  val1 = sample(likert_levels, n, replace = TRUE), 
  val2 = sample(likert_levels, n, replace = TRUE) ,
  val3 = sample(likert_levels, n, replace = TRUE) 
)

This data frame contains the correct count of var levels A, B and C.

Then I append each category-question with pivot longer in R :

df2 = df%>%
  pivot_longer(!var, names_to = "Categories", values_to = "likert_values")%>%
  select(-Categories)

resulting to :

 var   likert_values         
   <chr> <chr>                 
 1 B     "Very \n Satisfied"   
 2 B     "Dissatisfied"        
 3 B     "Dissatisfied"        
 4 B     "Dissatisfied"        
 5 B     "Very \n Dissatisfied"
 6 B     "Very \n Dissatisfied"
 7 A     "Dissatisfied"        
 8 A     "Dissatisfied"        
 9 A     "Neutral"             
10 C     "Very \n Dissatisfied"
# ℹ 140 more rows

I want to create two plots.One with ggplikert or ggplot2 that will create facets on the likert chart based on the levels of the var column and to be sorted based on the two lower likert levels (ie "Very \n Dissatisfied" and "Dissatisfied") and keep the first 10 levels (ie the most dissatisfied levels). The second plot I want to be a bar plot but this df2 data frame with pivot longer cannot be used for the count due to the pivot longer. I have to use the first data frame df.But I want to match horizontally the levels on the likert chart and the bar plot.How can I do it in R ?


Solution

  • This is a modification of the approach I used in this answer, i.e. I use same code for the likert plot and use patchwork to add corresponding bar charts of counts:

    library(tidyverse)
    library(ggstats)
    
    set.seed(123)
    
    
    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% likert_levels[1:2]]),
        prop_higher = sum(prop[value %in% likert_levels[4:5]]),
        .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)
      )
    
    dat_bar <- dat |> 
      summarise(
        n = sum(n), .by = c(y_sort, group)
      )
    
    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(),
        strip.text = element_blank()
      ) +
      labs(x = NULL, y = NULL, fill = NULL)
    
    p2 <- ggplot(dat_bar, aes(y = y_sort, x = n)) +
      geom_col() +
      geom_label(
        aes(
          label = label_number_abs(hide_below = .05, accuracy = 1)(n)
        ),
        size = 3.5,
        hjust = 1,
        fill = NA,
        label.size = 0,
        color = "white"
      ) +
      scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
      scale_x_continuous(
        labels = label_number_abs(),
        expand = c(0, 0, 0, .05)
      ) +
      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)
    
    library(patchwork)
    
    p1 + p2 +
      plot_layout(
        #axes = "collect", 
        guides = "collect") &
      theme(legend.position = "bottom")
    

    enter image description here