前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >R-ggpattern (绘图花式大赏-2)

R-ggpattern (绘图花式大赏-2)

作者头像
生信技能树
发布2022-12-16 14:28:39
4940
发布2022-12-16 14:28:39
举报
文章被收录于专栏:生信技能树生信技能树

上一小节中,我们介绍了ggpattern并鉴赏了ggpattern中两大pattern之一的array_based_pattern。详见:R-ggpattern(绘图花式大赏-1)

接下来,我们继续介绍一下另一大pattern-geometry_based pattern,鉴赏一下geometry_based pattern绘制的图。

Geometry-based pattern

geometry-based pattern的特点就是比较的丑,不能加这么多特别的图片啥的。

geometry-based pattern 有三个重要的参数:

  • density控制一个图形和其他 相邻图形之间的距离,范围【0,1】

image.png

  • spacing控制两个图形之间的距离

image.png

  • 控制角度

image.png

1 黑白条纹

代码语言:javascript
复制
df <- data.frame(level = c("a", "b", "c", 'd'), outcome = c(2.3, 1.9, 3.2, 1))

p <- ggplot(df, aes(level, outcome)) +#设置x轴y轴
  geom_col_pattern(
    aes(pattern = level, pattern_angle = level, pattern_spacing = level), #控制的三个参数
    fill            = 'white',#  柱子内里是白色          
    colour          = 'black', #柱子轮廓是黑色
    pattern_density = 0.35, #设置密度
    pattern_fill    = 'black',#图形颜色
    pattern_colour  = 'black'#图形的轮廓
  ) +
  theme_bw() +
  labs(
    title    = "ggpattern::geom_col_pattern()",
    subtitle = 'geometry-based patterns'
  ) +
  scale_pattern_spacing_discrete(range = c(0.01, 0.05)) + #这个设定了两个图形之间的间隔
  theme(legend.position = 'none ') + 
  coord_fixed(ratio = 1)#横纵轴比

p

image.png

2 彩色条纹

代码语言:javascript
复制
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) +#这个是控制图例中图案大小的,这里没有设置就没用
#一般来说这个值设置为1是比较合适的
  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

image.png

3 所有的图

接下来的操作就和array-based pattern的套路一样了,会教学你不同的图的画法。这里把代码抄写并且注释一下,尤其是比较新的操作:

代码语言:javascript
复制
##geom_bar_pattern()柱状图
p <- ggplot(mpg, aes(class)) +
  geom_bar_pattern(
    aes(
      pattern = class, 
      pattern_angle = class#这两个参数使得不同的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

##使用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)#这里要设置factor
)

p <- ggplot(df, aes(x="", y = value, pattern = group, pattern_angle = group))+#这里x为空的
  geom_bar_pattern(
    width                = 1,#这里设置的是柱体的宽度
    stat                 = "identity", #这样设置的柱状图就是叠叠乐,stat表示一种统计方式
    #https://www.cnblogs.com/muchen/p/5279727.html
    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

##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
#这个过程真的比array简单很多可见默认就是geom-based的形式

## geom_boxplot_pattern
p <- ggplot(mpg, aes(class, hwy)) +
  geom_boxplot_pattern(
    aes(
      pattern      = class,#不一样的pattern不一样的颜色 
      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
## geom_col_pattern
df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2))

p <- ggplot(df, aes(trt, outcome)) +
  geom_col_pattern(
    aes(
      pattern = trt, 
      fill    = trt
    ), 
    colour                   = 'black', 
    pattern_density          = 0.5, 
    pattern_key_scale_factor = 1.11
  ) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_col_pattern()") + 
  theme(legend.position = 'none') +  
  coord_fixed(ratio = 1/2)

p
## 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
## 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
##geom_map_pattern
if (require(maps)) {

crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)

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

}
## geom_polygon_pattern
angle <- seq(0, 2*pi, length.out = 7) + pi/6
polygon_df <- data.frame(
  angle = angle,
  x     = cos(angle),
  y     = sin(angle)
)

p <- ggplot(polygon_df) +
  geom_polygon_pattern(
    aes(x = x, y = y), 
    fill            = 'white', 
    colour          = 'black', 
    pattern_spacing = 0.15, 
    pattern_density = 0.4, 
    pattern_fill    = 'lightblue', 
    pattern_colour  = '#002366',
    pattern_angle   = 45
  ) + 
  labs(title = "ggpattern") + 
  coord_equal() + 
  theme_bw(25) + 
  theme(axis.title = element_blank())

p
## geom_rect_pattern
plot_df <- data.frame(
  xmin    = c(0, 10),
  xmax    = c(8, 18),
  ymin    = c(0, 10),
  ymax    = c(5, 19),
  type    = c('a', 'b'),
  angle   = c(45, 0),
  pname   = c('circle', 'circle'),#设置里面的形状,其他的形状键R-ggpattern(1)
  pcolour = c('red', 'blue'),#设置颜色
  pspace  = c(0.03, 0.05),
  size    = c(0.5, 1),
  stringsAsFactors = FALSE
)

p <- ggplot(plot_df) +
  geom_rect_pattern(
    aes(
      xmin=xmin, ymin=ymin, xmax=xmax, ymax=ymax,
      pattern_angle   = I(angle),
      pattern_colour  = I(pcolour),
      pattern_spacing = I(pspace),
      pattern_size    = I(size)
    ),
    pattern         = 'circle',
    fill            = 'white',
    colour          = 'black',
    pattern_density = 0.3
  ) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_rect_pattern()") + 
  theme(legend.key.size = unit(1.5, 'cm'))

p
## geom_violin_pattern
huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))

p <- ggplot(huron, aes(year)) +
  geom_ribbon_pattern(
    aes(
      ymin = level - 1, 
      ymax = level + 1
    ), 
    fill            = NA, 
    colour          = 'black',
    pattern         = 'circle',
    pattern_spacing = 0.03, 
    pattern_density = 0.5,
    pattern_angle   = 30,
    outline.type    = 'legacy'
  ) +
  theme_bw(18) +
  labs(title = "ggpattern::geom_ribbon_pattern()")

p

4 动画化图案

代码语言:javascript
复制
library(ggpattern)
if (require("gganimate")) {

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# 创建不同时间状态的数据框
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
df1 <- data.frame(time = 1, offset = 0    , trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2), stringsAsFactors = FALSE)
df2 <- data.frame(time = 2, offset = 0.045, trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2), stringsAsFactors = FALSE)
df  <- rbind(df1, df2)
#offset代表左右移动
#所以上表代表左右不移动,上下移动
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#将不同的状态进行转换
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
p <- ggplot(df, aes(trt, outcome)) +
  geom_col_pattern(
    aes(
      pattern_fill    = trt, 
      pattern_xoffset = I(offset), #移动情况
      pattern_yoffset = I(-offset)
    ), 
    colour          = 'black', 
    fill            = 'white',
    pattern_density = 0.5,
    pattern_angle   = 45
  ) +
  theme_bw() +
  labs(title = "ggpattern + gganimate") + 
  theme(legend.position = 'none') + 
  coord_fixed(ratio = 1/2) 

p <- p + transition_states(time, transition_length = 2,#转换的相对长度,和状态数量一致
                    state_length = 0, #暂停
                           wrap = FALSE)#是否需要重复播放(回到第一张图)

animate(p, nframes = 60, fps = 20)#nframe渲染帧数,fps动画的帧速率,单位为帧/秒(默认为10)

}

感兴趣的小伙伴可以来试试画各式各样的图额!

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-11-10,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 生信技能树 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
目录
  • Geometry-based pattern
    • 1 黑白条纹
      • 2 彩色条纹
        • 3 所有的图
          • 4 动画化图案
          领券
          问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档