R-ggpattern（绘图花式大赏-1）

生信技能树

发布于 2022-12-16 14:28:08

1K0

发布于 2022-12-16 14:28:08

文章被收录于专栏：生信技能树生信技能树

1.如何写一个pattern

如何创建一个pattern在ggpatern里面使用呢?

我们需要一下几步

1决定使用geometry_based pattern 还是array_based pattern

2使用需要的参数创建一个函数

3使用options()使得gridpattern知道你要授权的函数名称

1.1pattern的分类，参数以及返回值

首先使用gridpattern中提供的pattern可以早ggpattern中创建个性化的pattern

常见的gridpattern有：

ggpattern中的一些参数：

Geom-based:

在绘制图形边界中添加几何图形（比如 sf::st_intersection(), gridGeometry::polyclipGrob(),gridpattern::alphaMaskGrob()对几何图形进行操作）

函数参数：

paras：geom信息，你想画啥图
boundary_df:一个包含图形信息的polygon_df形式数据框，该数据框仅仅包含3列，图案边界的x，y坐标以及使用的图案id
aspect_ratio：渲染图案的长宽比
legend：返回逻辑值是否添加图例

返回一个 grid grob对象

polygon_df形式的数据框：包含了几何图形边界坐标。比如以下这个数据框包含x，y坐标以及两种集合图形的两个id

Array-based:使用gridpattern确保在绘制图形边界中添加图片

函数：

width，height：图形对象的大小
param：geom信息
legend：是否加上图例

返回3d向量或者RGBA值

1.2 将函数关联到gridpattern中的pattern名称

注意你用的pattern名称必须和gridpattern中的名称有所不同

options(ggpattern_array_funcs    = list(your_pattern_name = your_pattern_function))
options(ggpattern_geometry_funcs = list(your_pattern_name = your_pattern_function))

1.3 例一：多彩条纹

条纹strips是geometry-based pattern。ggplot中我们只能使用单色条纹进行fill，但是在ggpatern里面可以创造多色条纹。这里我们就创建这样一个pattern

下面演示

#我们先创建一个函数叫做multicolor_stripe_pattern
#应该使用的function中的参数和上述一致
multicolor_stripe_pattern <- function(params, boundary_df, aspect_ratio, 
                                      legend = FALSE) {
    args <- as.list(params)
    args <- args[grep("^pattern_", names(args))]

    args$pattern_colour <- strsplit(args$pattern_colour, ",")[[1]]
    args$pattern_fill <- strsplit(args$pattern_fill, ",")[[1]]

    args$pattern <- "stripe"
    args$x <- boundary_df$x
    args$y <- boundary_df$y
    args$id <- boundary_df$id
    args$prefix <- ""

    do.call(gridpattern::patternGrob, args)
}

下面我们保存这个参数的名字叫做multicolor_stripe

options(ggpattern_geometry_funcs = list(multicolor_stripe = multicolor_stripe_pattern))

现在我们来使用

df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2))
ggplot(df, aes(trt, outcome)) +
    geom_col_pattern(aes(fill = trt), colour = 'black', 
                     pattern = 'multicolor_stripe',
                     pattern_fill = "grey30,grey70,white,grey70") +
    theme(legend.key.size = unit(1.5, 'cm'))

1.4 例二：三色多边形瓷砖

我们使用内置的polygon_tiling的pattern

#给新的函数起一个名字叫做tiling3_pattern
tiling3_pattern <- function(params, boundary_df, aspect_ratio, legend = FALSE) {
    args <- as.list(params)
    args <- args[grep("^pattern_", names(args))]

#设置瓷砖的类型
    args$pattern <- "polygon_tiling"

# 使用 `fill`, `pattern_fill`  "average"设计三色瓷砖的三种颜色
#也就是fill色，pattern_fill色，两者的中间色三种颜色
    avg_col <- gridpattern::mean_col(params$fill, params$pattern_fill)
    args$pattern_fill <- c(params$fill, avg_col, args$pattern_fill)

    args$x <- boundary_df$x
    args$y <- boundary_df$y
    args$id <- boundary_df$id
    args$prefix <- ""

    do.call(gridpattern::patternGrob, args)
} 
#设定pattern名称到环境中
options(ggpattern_geometry_funcs = list(tiling3 = tiling3_pattern))

df <- data.frame(trt = c("a", "b", "c"), outcome = c(2.3, 1.9, 3.2))
ggplot(df, aes(trt, outcome)) +
    geom_col_pattern(aes(fill = trt, pattern_type = trt), 
                     pattern = 'tiling3', pattern_angle = 45) +#让图案倾斜一点比较好看
    scale_pattern_type_manual(values = c("hexagonal", "tetrakis_square", "rhombille")) +#设置三种图案
    theme(legend.key.size = unit(1.5, 'cm'))#设置图例大小

2 鉴赏array_based pattern

array-based pattern的重要一点就是可以在图中使用图片和特殊的渐变

2.1 geom_bar_pattern()和geom_col_pattern柱状图

placeholder占位符pattern中的图片来源其中有

if (require("magick")) {#按需加载magick包，这个包可以p图之类的操作

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#重复pattern间的距离
  ) +
  theme_bw(18) +#主题
  labs(
    title = "ggpattern::geom_bar_pattern()",
    subtitle = "pattern = 'placeholder', pattern_type = 'kitten'"
  ) + #主副标题
  theme(legend.position = 'none') +#不添加图例，使用图片的图例会变成空白的
  coord_fixed(ratio = 1/15)  #控制x，y轴之间单位长度的大小，这里小于1代表和横轴设定更长的单位长度

p

}

使用image pattern有以下type。这些type可以让图复制摞起来，或者调整图片的状况

if (require("magick")) {

flags <- c(
  system.file("img", "flag", "au.png", package = "ggpattern"),
  system.file("img", "flag", "dk.png", package = "ggpattern"),
  system.file("img", "flag", "gb.png", package = "ggpattern"),
  system.file("img", "flag", "gr.png", package = "ggpattern"),
  system.file("img", "flag", "no.png", package = "ggpattern"),
  system.file("img", "flag", "se.png", package = "ggpattern"),
  system.file("img", "flag", "us.png", package = "ggpattern")
)#首先加载ggpattern包中的图片们并且赋值给flags

p <- ggplot(mpg, aes(class)) +
  geom_bar_pattern(#柱状图
    aes(
      pattern_filename = class
    ), 
    pattern         = 'image',#使用image pattern
    pattern_type    = 'tile',#使用tile type
    fill            = 'white', #填充色，这个时候有图案所以不是很重要
    colour          = 'black',#轮廓为黑色
    pattern_filter  = 'box',#调整图像大小使用的过滤器
    pattern_scale   = -1#设置pattern图案的大小
  ) +
  theme_bw(18) +#背景
  labs(
    title = "ggpattern::geom_bar_pattern()",
    subtitle = "pattern = 'image'"
  ) + #主副标题
  theme(legend.position = 'none') +#不加图例
  scale_pattern_filename_discrete(choices = flags) +#使用国旗分割图案
  coord_fixed(ratio = 1/15) + 
  scale_pattern_discrete(guide = guide_legend(nrow = 1))

p

}

geom_bar_pattern()+coord_flip()调转坐标轴

if (require("magick")) {

p <- ggplot(mpg, aes(class)) +
  geom_bar_pattern(
    aes(
      pattern_filename = class
    ), 
    pattern         = 'image',
    pattern_type    = 'none',#就单独整一个图
    fill            = 'grey80', 
    colour          = 'black',
    pattern_scale   = -2,#改变图片尺寸           
    pattern_filter  = 'point',
    pattern_gravity = 'east'#图形放置水平：向东放
  ) +
  theme_bw(18) +
  labs(
    title = "ggpattern::geom_bar_pattern() + coord_flip()",
    subtitle = "pattern = 'image'"
  ) + 
  theme(legend.position = 'none') +
  scale_pattern_filename_discrete(choices = flags) +
  coord_flip() + 
  scale_pattern_discrete(guide = guide_legend(nrow = 1))

p

}

使用geom_bar_pattern画个饼图

magick支持的pattern

if (require("magick")) {

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_type = group, pattern_fill = group)) +
  geom_bar_pattern(
    pattern              = 'magick',
    width                = 1, 
    stat                 = "identity", #堆叠状态
    fill                 = 'white', 
    colour               = 'black',
    pattern_scale        = 3,#放大图案
    pattern_aspect_ratio = 1,#改变图片的长宽比
    pattern_key_scale_factor = 1.5#图例中的图案大小
  ) +
  coord_polar("y", start=0) + #极坐标坐标系
  theme_void(20) + #去除主题
  theme(
    legend.key.size = unit(2, 'cm')#图例大小
  ) + 
  scale_pattern_type_manual(values = c(Cool = 'hexagons', But = 'crosshatch',
                                       Use = 'right45', Less = 'checkerboard')) + #使用的图案
  labs(
    title = "ggpattern::geom_bar_pattern() + coord_polar()",
    subtitle = "pattern = 'magick'"
  )

p

}

使用geom_col_pattern的效果和bar没有啥区别

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(
        pattern      = 'placeholder',
        pattern_type = 'bear',
        colour       = 'black'
      ) +
      theme_bw(18) +
      labs(
        title = "ggpattern::geom_col_pattern()",
        subtitle = "pattern = 'placeholder', pattern_type = 'bear'"
      ) + 
      theme(legend.position = 'none') +  
      coord_fixed(ratio = 1/2)
    
    p

2.2 geom_bin2d_pattern()块块图

if (require("magick")) {

p <- ggplot(diamonds, aes(x, y)) + 
  xlim(4, 10) + ylim(4, 10) +#限定坐标轴的范围
  geom_bin2d_pattern(
    aes(pattern_type = ..density..), 
    pattern       = 'magick',#依然是magic pattern
    pattern_scale = 3,#设置大小
    pattern_fill  = 'black',#pattern的颜色
    bins          = 6, #这个是设置从4到10之间设置6个格子
    fill          = 'white', #填充色是白色
    colour        = 'black', #边框是黑色
    size          = 0.5#边框的宽度
  ) +
  theme_bw(18) +#背景
  theme(legend.position = 'none') + #无图例
  scale_pattern_type_continuous(choices = gridpattern::names_magick_intensity[15:21]) +#magick款式
  labs(
    title = "ggpattern::geom_bin2d_pattern()",
    subtitle = "pattern = 'magick'"#主副标题
  ) 

p

}

2.3 geom_boxplot_pattern箱线图

if (require("magick")) {

standard_image_filenames <- c(
  system.file('img', 'Rlogo.png'    , package = 'png'),
  system.file('img', 'bug.jpg'      , package = 'ggpattern'),
  system.file('img', 'magpie.jpg'   , package = 'ggpattern'),
  system.file('img', 'seamless1.jpg', package = 'ggpattern'),
  system.file('img', 'seamless2.jpg', package = 'ggpattern'),
  system.file('img', 'seamless3.jpg', package = 'ggpattern')
)#先把需要的图片赋给一个对象

p <- ggplot(mpg, aes(class, hwy)) +
  geom_boxplot_pattern(
    aes(
      pattern_filename = class, #图片给谁用
    ),  
    pattern       = 'image',#这里就是用的是image这个pattern
    pattern_type  = 'tile',#在边界内重复图形
    pattern_scale = 0.5#设置图形大小
  ) +
  theme_bw(18) +#设置背景
  labs(
    title = "ggpattern::geom_boxplot_pattern() + coord_flip()",
    subtitle = "pattern = 'image'"
  ) + #设置标题
  scale_pattern_filename_discrete(choices = standard_image_filenames) +#用哪些图片
  theme(legend.position = 'none') + 
  coord_fixed(1/8)

p
}

2.4 geom_crossbar_pattern()分组图

if (require("magick")) {

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)) +
  geom_crossbar_pattern(
    aes(
      ymin          = lower, 
      ymax          = upper,
      pattern_fill  = interaction(trt, group),
    ), 
    pattern = 'plasma',#一种同色质感的颜色图案
    width   = 0.2, #边框宽窄
  ) +
  theme_bw(18) +#背景
  labs(
    title = "ggpattern::geom_crossbar_pattern()",
    subtitle = "pattern = 'plasma'"
  ) + 
  theme(legend.key.size = unit(1.5, 'cm')) +
  coord_fixed(ratio = 1/3)#设置图的长宽比例

p

}

2.5 geom_density_patern()密度图

很多人可能都是冲着这个多彩的密度图来的

if (require("magick")) {

seamless_image_filenames <- c(
  system.file('img', 'seamless1.jpg', package = 'ggpattern'),
  system.file('img', 'seamless2.jpg', package = 'ggpattern'),
  system.file('img', 'seamless3.jpg', package = 'ggpattern')
)#还是总结用哪些图片

p <- ggplot(mtcars) +
  geom_density_pattern(
    aes(
      x                = mpg, 
      pattern_filename = as.factor(cyl)#给cyl这个因子使用图片
    ), 
    pattern       = 'image',
    pattern_type  = 'tile'#重复图片
  ) +
  theme_bw(18) +
  labs(
    title = "ggpattern::geom_density_pattern()",
    subtitle = "pattern = 'image'"
  ) + 
  scale_pattern_filename_discrete(choices = seamless_image_filenames) + #使用图片
  theme(legend.key.size = unit(2, 'cm')) +#设置图例
  coord_fixed(ratio = 100)#横纵1：1

p

}

2.6 geom_map_pattern地图

if (require("magick") && require("maps")) {

crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)#state全名小写

states_map <- map_data("state")#提取地图的信息，内置于map包

p <- ggplot(crimes, aes(map_id = state)) +
    geom_map_pattern(
      map = states_map,#地图信息
      aes(
        pattern_type = state
      ),
      pattern              = 'magick',
      pattern_fill         = 'black',
      pattern_aspect_ratio = 1.75,#设置图案的大小
      fill                 = 'white',
      colour               = 'black',
    ) +
    expand_limits(x = states_map$long, y = states_map$lat) +#设置图形边界
    coord_map() +#快速的投影方法
    theme_bw(18) +#背景
    labs(title = "ggpattern::geom_map_pattern()") + 
  labs(
    title = "ggpattern::geom_map_pattern()",
    subtitle = "pattern = 'magick'"#标题
  ) + 
    scale_pattern_type_discrete(choices = gridpattern::names_magick) +#选取这里面的图案
    theme(legend.position = 'none')#不加图例

p

}

2.7 geom_polygon_pattern()设计你的logo

if (require("magick")) {

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), 
    pattern          = 'image',
    pattern_filename = system.file('img', 'bug.jpg', package = 'ggpattern'),#使用image往里面放一个甲虫
    fill             = 'white', 
    colour           = 'black'
  ) + 
  labs(title = "ggpattern") + 
  coord_equal() + #设定笛卡尔坐标轴，确定一个fixed aspect ratio，也就是一个单位的长和一个单位的宽之间的比值
  theme_bw(25) + 
  theme(axis.title = element_blank())#不设置标题

p

}

ggpattern使用这种方式就可以设计你自己的logo。但是，真的有人会用它来设计logo嘛。。。。。。

2.8 geom_rect_pattern()

if (require("magick")) {

plot_df <- data.frame(
  xmin    = c(0, 10, 3),
  xmax    = c(8, 18, 4),
  ymin    = c(0, 10, 8),
  ymax    = c(5, 19, 15),
  type    = c('a', 'b', 'c'),
  colour1 = c('red', 'black', 'blue'),#双色渐变中的第一色
  colour2 = c('black', NA, 'yellow'),#双色渐变中的第二色
  orient  = c('horizontal', 'radial', 'vertical'),#渐变色方向
  stringsAsFactors = FALSE
)#设计传递的矩阵，包括三个长方形四个点的坐标，颜色，方向等

p <- ggplot(plot_df) +
  geom_rect_pattern(
    aes(
      xmin=xmin, ymin=ymin, xmax=xmax, ymax=ymax,
      pattern_fill  = I(colour1),
      pattern_fill2 = I(colour2),
      pattern_orientation = I(orient)
    ),
    pattern         = 'gradient',#设置渐变色
    colour          = 'black',#边框颜色
    pattern_density = 0.3,#图案覆盖的面积比（感觉好像没有啥用）
    fill = NA
  ) +
  theme_bw(18) +
  labs(
    title = "ggpattern::geom_rect_pattern()",
    subtitle = "pattern = 'gradient'"
  ) + 
  theme(legend.key.size = unit(1.5, 'cm'))

p

}

2.9 geom_ribbon_pattern()条带图

if (require("magick")) {

huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))#数据框里包含了x轴y轴的信息

p <- ggplot(huron, aes(year)) +
  geom_ribbon_pattern(
    aes(
      ymin = level - 1, #所以条带的宽度是2
      ymax = level + 1
    ), 
    fill            = NA, 
    colour          = 'black',
    pattern         = 'image',#还是使用的image
    pattern_type    = 'tile',
    pattern_filename = system.file('img', 'seamless2.jpg', package = 'ggpattern'),
    outline.type    = 'legacy'#轮廓线的状况，upper上包，full全包或者legacy不包
  ) +
  theme_bw(18) +
  labs(
    title = "ggpattern::geom_ribbon_pattern()",
    subtitle = "pattern = 'image'"
  ) 

p

}

2.10 geom_sf_pattern()

if (require("dplyr") && require("magick") && require("sf")) {

nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
nc <- nc %>% filter(between(CNTY_ID, 1820, 1830))#sf包和arcgis相似可以操纵矢量地图数据
  #可以接受shp文件


p <- ggplot(nc) +
  geom_sf_pattern(
    aes(
      fill    = NAME,
    pattern_type = NAME#要上色的图形
    ),
    pattern = 'placeholder',
    pattern_type = 'kitten',#使用猫猫图
    pattern_aspect_ratio = 3
  ) +
  theme_bw(15) + 
  # theme(legend.key.size = unit(1.5, 'cm')) +
  theme(legend.position = 'none') +
  scale_pattern_type_discrete(choices = gridpattern::names_magick) + 
  labs(
    title = "ggpattern::geom_sf_pattern()",
    subtitle = "pattern = 'placeholder', pattern_type = 'kitten'"
  ) 

p

}

2.11 geom_violin_pattern()

if (require("magick")) {
  
  seamless_image_filenames <- c(
  system.file('img', 'seamless1.jpg', package = 'ggpattern'),
  system.file('img', 'seamless2.jpg', package = 'ggpattern'),
  system.file('img', 'seamless3.jpg', package = 'ggpattern')
)

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

p

}

感兴趣的小伙伴们，可以来画一画这一些多姿多彩的图额。

本文参与腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2022-11-09，如有侵权请联系 cloudcommunity@tencent.com 删除

geometry

legend

polygon

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

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

本文参与腾讯云自媒体分享计划，欢迎热爱写作的你一起参与！

geometry

legend

polygon

登录后参与评论

0 条评论

热度