rdataframeggplot2likert

Merging bars in bar plot using ggplot 2 in R


I have a data frame called df that has 3 likert scale levels columns and one filter column:

df
# A tibble: 50 × 4
   val1                   val2                   val3                var  
   <chr>                  <chr>                  <chr>               <chr>
 1 "Very \n Dissatisfied" "Neutral"              "Very \n Dissatisf… Yes  
 2 "Neutral"              "Neutral"              "Neutral"           No   
 3 "Dissatisfied"         "Satisfied"            "Neutral"           Yes  
 4 "Very \n Satisfied"    "Satisfied"            "Very \n Satisfied" Yes  
 5 "Very \n Dissatisfied" "Very \n Dissatisfied" "Neutral"           Yes  
 6 "Very \n Satisfied"    "Very \n Satisfied"    "Very \n Satisfied" Yes  
 7 "Dissatisfied"         "Neutral"              "Dissatisfied"      Yes  
 8 "Neutral"              "Satisfied"            "Neutral"           Yes  
 9 "Satisfied"            "Very \n Satisfied"    "Satisfied"         No   
10 "Neutral"              "Satisfied"            "Neutral"           Yes  

the resulting function from a previous question here

gives me the bar plot all the same value.Which is correct.!! All i want is instead of repeating it 3 times (20,30 and 50) i want to have it one time this bar of the right plot.Not 3 .

Is that possible ?

plot_fun <- function(x, y) {
  .data <- df |>
    filter(var %in% x)

  p1 <- .data |>
    ggstats::gglikert(include = -var) +
    aes(y = reorder(.question,
      ifelse(
        .answer %in% c("Very \n Dissatisfied", "Dissatisfied"),
        1, 0
      ),
      FUN = sum
    ), decreasing = TRUE) +
     facet_wrap(~paste0("var to ", y))+ scale_fill_manual(values = custom_colors) +
       theme(
        strip.text = element_text(size = 14,color = "black"),               # Increase facet label size
        axis.title = element_text(size = 14),               # Increase axis title size
        axis.text = element_text(size = 10))+               # Increase axis text size
    theme(strip.background = element_rect(color="black", fill="red", size=1.5, linetype="solid"))

  p2 <- .data %>%
    tidyr::pivot_longer(-var) |>
    filter(!is.na(value)) |> 
    mutate(
      name = reorder(name,
        ifelse(
          value %in% c("Very \n Dissatisfied", "Dissatisfied"),
          1, 0
        ),
        FUN = sum
      )
    ) |>
   ggplot(aes(y = name)) +
    geom_bar(fill = "lightgrey")+
    theme_light()+
    geom_text(aes(label = ..count..), 
              stat = "count",
              position=position_stack(vjust = 0.5))+
      theme(
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank())

  
  list(p1, p2)
}

.include <- list(No = "No", Yes = "Yes", All = c("Yes", "No"))

purrr::imap(.include, plot_fun) |>
  purrr::reduce(c) |>
  wrap_plots(ncol = 2) +
  plot_layout(axes = "collect", guides = "collect", widths = c(.7, .3)) &
  labs(x = NULL, y = NULL) &
  theme(legend.position = "bottom")

Data

 dput(df)
structure(list(val1 = c("Very \n Dissatisfied", "Neutral", "Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Very \n Satisfied", 
"Dissatisfied", "Neutral", "Satisfied", "Neutral", "Very \n Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Satisfied", "Neutral", 
"Very \n Dissatisfied", "Neutral", "Neutral", "Satisfied", "Neutral", 
"Very \n Satisfied", "Dissatisfied", "Dissatisfied", "Satisfied", 
"Neutral", "Dissatisfied", "Satisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Dissatisfied", "Dissatisfied", "Neutral", "Dissatisfied", 
"Dissatisfied", "Very \n Dissatisfied", "Satisfied", "Satisfied", 
"Neutral", "Very \n Dissatisfied", "Very \n Satisfied", "Very \n Dissatisfied", 
"Satisfied", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Satisfied", "Dissatisfied", "Dissatisfied"), val2 = c("Neutral", 
"Neutral", "Satisfied", "Satisfied", "Very \n Dissatisfied", 
"Very \n Satisfied", "Neutral", "Satisfied", "Very \n Satisfied", 
"Satisfied", "Very \n Dissatisfied", "Very \n Satisfied", "Satisfied", 
"Very \n Satisfied", "Satisfied", "Neutral", "Dissatisfied", 
"Satisfied", "Neutral", "Satisfied", "Satisfied", "Neutral", 
"Very \n Satisfied", "Very \n Satisfied", "Satisfied", "Satisfied", 
"Very \n Satisfied", "Satisfied", "Neutral", "Neutral", "Neutral", 
"Neutral", "Neutral", "Satisfied", "Satisfied", "Dissatisfied", 
"Neutral", "Satisfied", "Very \n Satisfied", "Satisfied", "Satisfied", 
"Very \n Dissatisfied", "Satisfied", "Neutral", "Satisfied", 
"Very \n Dissatisfied", "Neutral", "Satisfied", "Neutral", "Satisfied"
), val3 = c("Very \n Dissatisfied", "Neutral", "Neutral", "Very \n Satisfied", 
"Neutral", "Very \n Satisfied", "Dissatisfied", "Neutral", "Satisfied", 
"Neutral", "Very \n Dissatisfied", "Very \n Satisfied", "Very \n Dissatisfied", 
"Satisfied", "Neutral", "Very \n Dissatisfied", "Satisfied", 
"Neutral", "Satisfied", "Neutral", "Very \n Satisfied", "Neutral", 
"Satisfied", "Satisfied", "Neutral", "Dissatisfied", "Satisfied", 
"Very \n Satisfied", "Neutral", "Very \n Dissatisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Satisfied", "Dissatisfied", "Dissatisfied", 
"Very \n Dissatisfied", "Dissatisfied", "Very \n Dissatisfied", 
"Satisfied", "Satisfied", "Neutral", "Very \n Dissatisfied", 
"Very \n Satisfied", "Very \n Dissatisfied", "Satisfied", "Very \n Dissatisfied", 
"Dissatisfied", "Satisfied", "Neutral", "Dissatisfied"), var = c("Yes", 
"No", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No", "Yes", 
"No", "No", "Yes", "No", "No", "No", "No", "No", "Yes", "No", 
"No", "Yes", "No", "No", "No", "Yes", "No", "No", "Yes", "No", 
"No", "No", "No", "No", "Yes", "No", "No", "No", "Yes", "No", 
"No", "Yes", "Yes", "No", "Yes", "Yes", "No", "No", "No", "Yes"
)), row.names = c(NA, -50L), class = c("tbl_df", "tbl", "data.frame"
))
likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

enter image description here


Solution

  • Simply remove the pivoting part:

    library(tidyverse)
    library(patchwork)
    
    likert_levels <- c(
      "Very \n Dissatisfied", "Dissatisfied", "Neutral",
      "Satisfied", "Very \n Satisfied"
    )
    
    plot_fun <- function(x, y) {
      .data <- df |>
        filter(var %in% x) |>
        mutate(
          across(-var, ~ factor(.x, likert_levels))
        )
    
      p1 <- .data |>
        ggstats::gglikert(include = -var) +
        aes(y = reorder(.question,
          ifelse(
            .answer %in% c("Very \n Dissatisfied", "Dissatisfied"),
            1, 0
          ),
          FUN = sum
        ), decreasing = TRUE) +
        facet_wrap(~ paste0("var to ", y)) +
        # scale_fill_manual(values = custom_colors) +
        theme(
          strip.text = element_text(size = 14, color = "black"), # Increase facet label size
          axis.title = element_text(size = 14), # Increase axis title size
          axis.text = element_text(size = 10)
        ) + # Increase axis text size
        theme(strip.background = element_rect(color = "black", fill = "red", size = 1.5, linetype = "solid"))
    
      p2 <- .data %>%
        count() |> 
        ggplot(aes(y = factor(1), x = n)) +
        geom_col(fill = "lightgrey") +
        theme_light() +
        geom_text(aes(label = n),
          position = position_stack(vjust = 0.5)
        ) +
        theme(
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()
        )
    
      list(p1, p2)
    }
    
    .include <- list(No = "No", Yes = "Yes", All = c("Yes", "No"))
    
    purrr::imap(.include, plot_fun) |>
      purrr::reduce(c) |>
      wrap_plots(ncol = 2) +
      plot_layout(guides = "collect", widths = c(.7, .3)) &
      labs(x = NULL, y = NULL) &
      theme(legend.position = "bottom")