ggpattern包-基于几何图案或图像的自定义填充

平时我们做柱状图或饼图都会用彩色进行填充，但是文章有时候为了节约成本采用黑白印刷时候，图形一般都会做成各种阴影线条填充模式来进行区分(如下图)，R中的ggpattern包刚好可以满足了我们的需求，若有需要就来学习下吧~该包也给出了详细的文档适合初学者跟着学习，地址：https://coolbutuseless.github.io/package/ggpattern/index.html

特点总结：

• 几乎满足所有来自ggplot2拥有填充特性的geoms (如bar、boxplot等)
• 一套控制图案外观的aesthetics
• 包含了用户定义模式的能力

安装

# install.packages("remotes")
remotes::install_github("coolbutuseless/ggpattern")
library(ggpattern)

这里就演示常见的7\8 种图形，详细内容自行阅读源文档~~

绘图

1. geom_col_pattern

df <- data.frame(level = c("a", "b", "c", 'd'), outcome = c(2.3, 1.9, 3.2, 1))

ggplot(df) +
    geom_col_pattern(
    aes(level, outcome, pattern_fill = level),
    pattern = 'stripe',
    fill    = 'white',## 填充色
    colour  = 'black'## 边框
  ) +
  theme_bw(18) +
  theme(legend.position = 'none') +
  labs(
    title    = "ggpattern::geom_pattern_col()",
    subtitle = "pattern = 'stripe'"
  ) +
  coord_fixed(ratio = 1/2)

主要函数为geom_col_pattern,pattern提供形状，fill填充色，colour边框颜色

不同分组映射不同形状

p <- ggplot(df, aes(level, outcome)) +
  geom_col_pattern(
    aes(pattern = level, fill = level, pattern_fill = level),
    colour                   = 'black',
    pattern_density          = 0.35,
    pattern_key_scale_factor = 1.3) +
  theme_bw() +
  labs(
    title    = "ggpattern::geom_col_pattern()",
    subtitle = 'geometry-based patterns'
  ) +
  scale_pattern_fill_manual(values = c(a='blue', b='red', c='yellow', d='darkgreen')) +
  theme(legend.position = 'none') +
  coord_fixed(ratio = 1)

p

这里我们多加了个参数pattern_density = 0.35, 作用改变图案密度即改变元素向邻近元素延伸的距离。它是一个分数，通常要求取值范围为[0,1]。

自定义颜色
利用scale_pattern_fill_manual函数

p <- ggplot(df, aes(level, outcome)) +
  geom_col_pattern(
    aes(pattern = level, fill = level, pattern_fill = level),
    colour                   = 'black',
    pattern_density          = 0.35,
    pattern_key_scale_factor = 1.3) +
  theme_bw() +
  labs(
    title    = "ggpattern::geom_col_pattern()",
    subtitle = 'geometry-based patterns'
  ) +
  scale_pattern_fill_manual(values = c(a='blue', b='red', c='yellow', d='darkgreen')) +
  theme(legend.position = 'none') +
  coord_fixed(ratio = 1)

p

2. geom_bar_pattern()

p <- ggplot(mpg, aes(class)) +
  geom_bar_pattern(
    aes(
      pattern = class,
      pattern_angle = class
    ),
    fill            = 'white',
    colour          = 'black',
    pattern_spacing = 0.025
  ) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_bar_pattern()") +
  theme(legend.position = 'none') +
  coord_fixed(ratio = 1/15) +
  scale_pattern_discrete(guide = guide_legend(nrow = 1))

p

其中参数pattern_spacing 代表元素之间的距离

pattern_angle代表元素旋转角度

利用geom_bar_pattern()绘制饼图

df <- data.frame(
  group = factor(c("Cool", "But", "Use", "Less"), levels = c("Cool", "But", "Use", "Less")),
  value = c(10, 20, 30, 40)
)

p <- ggplot(df, aes(x="", y = value, pattern = group, pattern_angle = group))+
  geom_bar_pattern(
    width                = 1,
    stat                 = "identity",
    fill                 = 'white',
    colour               = 'black',
    pattern_aspect_ratio = 1,
    pattern_density      = 0.3
  ) +
  coord_polar("y", start=0) +
  theme_void(20) +
  theme(
    legend.key.size = unit(2, 'cm')
  ) +
  labs(title = "ggpattern::geom_bar_pattern() + coord_polar()")

p

饼图

3.geom_bin2d_pattern()

p <- ggplot(diamonds, aes(x, y)) +
  xlim(4, 10) + ylim(4, 10) +
  geom_bin2d_pattern(aes(pattern_spacing = ..density..), fill = 'white', bins = 6, colour = 'black', size = 1) +
  theme_bw(18) +
  theme(legend.position = 'none') +
  labs(title = "ggpattern::geom_bin2d_pattern()")

p
#> Warning: Removed 478 rows containing non-finite values (stat_bin2d).

二维封箱热图

4. geom_boxplot_pattern() 箱线图

p <- ggplot(mpg, aes(class, hwy)) +
  geom_boxplot_pattern(
    aes(
      pattern      = class,
      pattern_fill = class
    ),
    pattern_spacing = 0.03
  ) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_boxplot_pattern()") +
  theme(legend.position = 'none') +
  coord_fixed(1/8)

p

5. geom_crossbar_pattern()

df <- data.frame(
  trt = factor(c(1, 1, 2, 2)),
  resp = c(1, 5, 3, 4),
  group = factor(c(1, 2, 1, 2)),
  upper = c(1.1, 5.3, 3.3, 4.2),
  lower = c(0.8, 4.6, 2.4, 3.6)
)

p <- ggplot(df, aes(trt, resp, colour = group)) +
    geom_crossbar_pattern(
      aes(
        ymin          = lower,
        ymax          = upper,
        pattern_angle = trt,
        pattern       = group
      ), width        = 0.2,
      pattern_spacing = 0.02
    ) +
    theme_bw(18) +
    labs(title = "ggpattern::geom_crossbar_pattern()") +
    theme(legend.position = 'none') +
    coord_fixed(ratio = 1/3)

p

crossbar

6. geom_density_pattern()

p <- ggplot(mtcars) +
   geom_density_pattern(
     aes(
       x            = mpg,
       pattern_fill = as.factor(cyl),
       pattern      = as.factor(cyl)
     ),
     fill                     = 'white',
     pattern_key_scale_factor = 1.2,
     pattern_density          = 0.4
   ) +
   theme_bw(18) +
   labs(title = "ggpattern::geom_density_pattern()") +
   theme(legend.key.size = unit(2, 'cm')) +
   coord_fixed(ratio = 100)

p

密度图

7. geom_map_pattern()

library(maps)

crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
crimesm <- reshape2::melt(crimes, id = 1)

states_map <- map_data("state")

p <- ggplot(crimes, aes(map_id = state)) +
    geom_map_pattern(
      aes(
        # fill            = Murder,
        pattern_fill    = Murder,
        pattern_spacing = state,
        pattern_density = state,
        pattern_angle   = state,
        pattern         = state
      ),
      fill   = 'white',
      colour = 'black',
      pattern_aspect_ratio = 1.8,
      map    = states_map
    ) +
    expand_limits(x = states_map$long, y = states_map$lat) +
    coord_map() +
    theme_bw(18) +
    labs(title = "ggpattern::geom_map_pattern()") +
    scale_pattern_density_discrete(range = c(0.01, 0.3)) +
    scale_pattern_spacing_discrete(range = c(0.01, 0.03)) +
    theme(legend.position = 'none')

p

map

8. geom_violin_pattern()

p <- ggplot(mtcars, aes(as.factor(cyl), mpg)) +
  geom_violin_pattern(aes(pattern = as.factor(cyl))) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_violin_pattern()") +
  theme(
    legend.key.size  = unit(2, 'cm')
  ) +
  coord_fixed(1/15)

p

Violin

其它好玩的

1. 结合gganimate包绘制动态的条形图

   
   
2. 以图片形式填充你的图形，这里利用pattern= 'placeholder'模式，类型pattern_type选择kitten, 填充个几个噬元兽试试

p <- ggplot(mpg, aes(class)) +
  geom_bar_pattern(
    aes(
      pattern_angle = class
    ),
    pattern         = 'placeholder',
    pattern_type    = 'kitten',
    fill            = 'white',
    colour          = 'black',
    pattern_spacing = 0.025
  ) +
  theme_bw(18) +
  labs(
    title = "ggpattern::geom_bar_pattern()",
    subtitle = "pattern = 'placeholder', pattern_type = 'kitten'"
  ) +
  theme(legend.position = 'none') +
  coord_fixed(ratio = 1/15) +
  scale_pattern_discrete(guide = guide_legend(nrow = 1))

p

改变pattern_type=murray

哈哈，更多好玩的图形自己摸索吧，当然也支持自定义图片呦： 提供图片给一个向量后， 结合pattern = 'image' 模式和scale_pattern_filename_discrete()函数轻松绘制，很是easy！！