rplotvisualizationlatticelikert

Different pattern in each discrete option in HH::likert function


I want to create a Likert plot using the HH package that incorporates visual patterns (e.g. hatching) in each bar category to improve accessibility for color-blind users.

Apparently, having grey-scales or other color-blind friendly colours is not enough for the client.

The different categories of each bar (e.g., very happy, happy, neither happy nor sad, sad, very sad), has to contain some pattern or other visual distinction ( e.g. a symbol) in addition to differing colours.

Here is a reproducible example:

Sample data:

## Dataframe with the necessary variables
df <- data.frame(institutt = c("institutt1", "institutt2"), 
                 Spørsmål = c("q1", "q1"), 
                 Veryhappy = c(3, 5), 
                 Happy = c(2, 4),
                 Neithernor = c(3, 2), 
                 Sad = c(4, 3), 
                 Verysad = c(5, 2))

Starting plot:

install.packages("HH")
library(HH)
likert_plot <- df %>%  
    likert(grouping = df$institutt,
           as.percentage = TRUE) 

Which creates:

this figure

How can I add lines or crosses or a symbol to the 'Very happy', 'Happy', etc categories to distinguish between them?


Solution

  • Although the "HH" package can produce nice Likert plots without much effort, it is quite an old package (at least 18 years currently), and uses the trellis graphics system, which does not have native support for pattern fills. The drawing methods in trellis graphics draw graphical objects without returning them to the user. This means we cannot use the newer features that have been developed in the underlying grid graphics system to modify the output.

    While it is not impossible to capture and modify the output, it is difficult and complex. Certainly much easier to switch to an alternative system such as ggplot with ggpattern:

    library(tidyverse)
    library(ggpattern)
    
    df %>%
      pivot_longer(-c(1:2), names_to = "level") %>%
      mutate(level = fct_inorder(level)) %>%
      group_by(institutt, Spørsmål) %>%
      mutate(left = cumsum(lag(value, 1, 0)), right = left + value) %>%
      mutate(xmin = left - (left + right)[level == "Neithernor"]/2) %>%
      mutate(xmax = xmin + value) %>%
      ungroup() %>%
      mutate(ymin = as.numeric(factor(institutt)) - 0.3) %>%
      mutate(ymax = ymin + 0.6) %>%
      ggplot(aes(fill = level, pattern = level, pattern_angle = level)) +
      geom_vline(xintercept = 0, linetype = 2) +
      geom_rect_pattern(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
                        pattern_color = NA, pattern_fill = "white",
                        pattern_spacing = 0.02) +
      scale_fill_manual(values = c("#e16a86", "#e79aa9", "#e2e2e2",
                                   "#a2ace5", "#768be6")) +
      scale_pattern_manual(values = c("none", "stripe", "crosshatch", "stripe",
                                      "circle")) +
      scale_y_reverse(limits = c(2.5, 0.5), breaks = 1:2,
                      labels = levels(factor(df$institutt))) +
      scale_pattern_angle_manual(values = c(45, 90, 45, 45, 0)) +
      theme_classic(20) +
      theme(legend.position = "bottom", 
            panel.background = element_rect(color = "black"),
            axis.line = element_blank(),
            legend.key.size = unit(10, "mm"))
    

    enter image description here