GGplot,将填充图案叠加到填充颜色上

GGplot, overlaying fill patterns onto fill colors

我有这样的数据:

Likert<-structure(list(Question = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L), .Label = "satisfied_6", class = "factor"), 
    Answer = structure(c(1L, 1L, 3L, 3L, 2L, 2L, 1L, 5L, 1L, 
    2L, NA, 1L, 4L, 4L, 3L, 2L, 2L, 5L, 1L, 4L, 1L, 1L, 1L, 1L, 
    1L, 4L, 3L, 4L), .Label = c("Never", "Rarely", "Sometimes", 
    "Often", "Always"), class = "factor")), row.names = c(NA, 
-28L), class = c("tbl_df", "tbl", "data.frame"))

我画成这样的图表:

使用此代码:

library(RColorBrewer)
Likert%>%filter(Question=="satisfied_6")%>%filter(!is.na(Answer))%>%group_by(Question)%>%count(Answer)%>%mutate(Percent= (n/sum(n)*100))%>%ggplot(aes(x=Percent,y=Question, fill=Answer))+geom_col()+
      theme(axis.title.y=element_blank(),
            axis.text.y=element_blank(),
            axis.ticks.y=element_blank())+labs(title = "How frequently does impairment of your arm, shoulder, or hand negatively impact your sexual satisfaction?")+scale_x_reverse()+ scale_fill_brewer(palette = "PuBu")

我们决定“从不”和“很少”可以组合成“不受影响”,“有时”、“经常”和“总是”可以组合成“受影响”,我'我也喜欢在视觉上展示这两个类别。我的想法是使用覆盖在颜色之上的填充图案,但我完全不知道如何同时进行。我的最终目标是这样的:

有什么想法吗?

P.s。也许作为评论,我喜欢关于如何最好地视觉传达该信息的其他建议

这是对 {ggpattern} 包的一个很好的使用。

我已尝试为您清理图例,但代码应该很容易从此处修改以满足您的需要。

# load packages
library(tidyverse)
library(ggpattern)
library(RColorBrewer)

Likert <- structure(list(Question = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "satisfied_6", class = "factor"), Answer = structure(c(1L, 1L, 3L, 3L, 2L, 2L, 1L, 5L, 1L, 2L, NA, 1L, 4L, 4L, 3L, 2L, 2L, 5L, 1L, 4L, 1L, 1L, 1L, 1L, 1L, 4L, 3L, 4L), .Label = c("Never", "Rarely", "Sometimes", "Often", "Always"), class = "factor")), row.names = c(NA, -28L), class = c("tbl_df", "tbl", "data.frame"))


Likert %>%
  filter(Question=="satisfied_6") %>% 
  filter(!is.na(Answer)) %>% 
  group_by(Question) %>% 
  count(Answer) %>% 
  ungroup() %>% 
  mutate(impact = c(rep("not impacted", 3), rep("impacted", 2))) %>% 
  mutate(impact = fct_rev(impact)) %>% 
  mutate(Percent= (n/sum(n)*100)) %>%
  ggplot(aes(x=Percent,y=Question, fill=Answer)) + 
  geom_col_pattern(aes(pattern_angle = impact),
                   pattern_color = NA,
                   pattern_fill = "black",
                   pattern = "stripe") +
  labs(title = "How frequently does impairment of your arm, shoulder, or hand \nnegatively impact your sexual satisfaction?") + 
  scale_x_reverse() + 
  scale_pattern_angle_manual(values = c(45, 135),
                             guide = guide_legend(title = "Impact", order = 2, override.aes = list(fill = "white", color = "black"))) +
  scale_fill_brewer(palette = "PuBu",
                    guide = guide_legend(order = 1, override.aes = list(pattern = "none")))  +
  theme(axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        aspect.ratio = 0.4,
        legend.box = "horizontal") 

reprex package (v2.0.1)

于 2022-02-04 创建