使用R语言进行纹理填充

转自  biobabble

《把你用R画的图（base或ggplot2）变成ASCII纯文本！》这篇文章发表的时候，我想大家可能只是觉得很牛逼，仅此而已，但事实上文章中说的devout，支持用R函数来实现画图设备，这是打开了潘多拉盒子，ascii()码就算是一个，作者写了一个minipdf的包，用来创建pdf文档，基于这个devout和minipdf，只用了300行纯R代码就写了devoutpdf这个包，实现了pdf画图设备。然后又一个脑洞大开的是，他竟然又写了一个devoutaudio的包，实现了把画图变成了音频。也就是说你画个图，可以变成一段音频，盲人都能听图了。

library(devoutaudio)
plot_df <- mtcars %>% arrange(mpg)

audio()
ggplot(plot_df) +
  geom_point(aes(mpg, wt, size = cyl)) +
  theme(legend.position = 'none')
dev.off()

这张图「画」来下面这段音频，来感受一下，或者你可以用你画一张图来弹奏一曲了。

ggplotaudio来自biobabble00:0000:07

我看到作者又写了一个minisvg包的时候，我就知道他会再写一个出svg的设备。而minisvg只是一个用来创建svg文件的包而已。有了这个包和devout，写设备就不难了，不过我没想到的是，作者脑洞果然大，还有一个神操作，把颜色给换成了形状填充物。也就是像下面这种图，以后用R轻松可以画了。

安装包

# install.packages("devtools")
devtools::install_github("coolbutuseless/lofi")      # Colour encoding
devtools::install_github("coolbutuseless/minisvg")   # SVG creation
devtools::install_github("coolbutuseless/devout")    # Device interface
devtools::install_github("coolbutuseless/devoutsvg") # This package

怎么填充？

首先svgout这个设备能够把RGB颜色变成形状/纹理模式，这需要把模式编码成颜色，所以我们画图还是照常填充颜色，然后在实际渲染颜色的时候，解码然后使用你编码的模式去填充。这样你画的图，还是一样的图，不会去改变你画图的任何语句，然后出图它就变了。

对于这些编码解码的模式包呢，作者也写了两个，svgpatternsimple和svgpatternusgs。

library(svgpatternsimple)
#> 
#> Attaching package: 'svgpatternsimple'
#> The following objects are masked from 'package:svgpatternusgs':
#> 
#>     create_pattern_id_from_rgba_vec, decode_pattern_from_rgba_vec,
#>     encode_pattern_params_as_hex_colour, is_valid_pattern_encoding

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Encode the parameters for 3 different patterns into 3 different colours
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
gear4_colour <- svgpatternsimple::encode_pattern_params_as_hex_colour(
  pattern_name = 'null', 
  colour       = '#123456'
)

gear6_colour <- svgpatternsimple::encode_pattern_params_as_hex_colour(
  pattern_name = 'stipple', 
  colour       = '#ff4455', 
  spacing      = 10
)

gear8_colour <- svgpatternsimple::encode_pattern_params_as_hex_colour(
  pattern_name  = 'hex', 
  angle         = 0, 
  spacing       = 20, 
  fill_fraction = 0.1,
  colour        = '#125634'
)

c(gear4_colour, gear6_colour, gear8_colour)
#> [1] "#024D2BFF" "#9D213FFF" "#A09708FF"

上面这个就把三种模式编码成三个颜色，最后的输出我们可以看到，就是三个颜色。

svgout(filename = "man/figures/example-manual.svg", pattern_pkg = 'svgpatternsimple')
ggplot(mtcars) + 
  geom_bar(aes(as.factor(cyl), fill = as.factor(cyl)), colour = 'black') + 
  labs(title = basename("Example - manual pattern specification")) + 
  theme_bw() +
  theme(legend.key.size = unit(1.5, "cm")) + 
  scale_fill_manual(
    values = c(
      '4' = gear4_colour,
      '6' = gear6_colour,
      '8' = gear8_colour
    )
  )
invisible(dev.off())

然后我们来画图，用ggplot2，该怎么画还怎么画，我们手动指定被编码的三个颜色，ggplot2的语句一点都没变，你图还是你图，照常画就行。magic就在svgout这一句中，加了pattern_pkg参数，那么所指定的svgpatternsimple就会尝试去解码颜色，这和你画图没关系，这是渲染出图的环节，所以不会为你画图增加一些东西，你照常画就好，这一点非常好。

正如我们编码的一样，第一种颜色，啥也不干，所以还是原来的样子，第二种变成点，第三种变成六边形。

为了让你更容易用，作者又提供了一个scale_fill_pattern_simple()，于是你可以使用标尺，自动去填充。

svgout(pattern_pkg = 'svgpatternsimple', filename = "man/figures/example-scale-fill-2.svg")
ggplot(mtcars) + 
  geom_bar(aes(as.factor(cyl), fill = as.factor(cyl)), colour = 'black') + 
  labs(title = "scale_fill_pattern_simple() - defaults") + 
  theme_bw() +
  theme(legend.key.size = unit(1.5, "cm")) +
  svgpatternsimple::scale_fill_pattern_simple()
invisible(dev.off())

不过等等，这也太丑了，因为颜色和形状/纹理模式，可不好对等，自动选通常就会这么丑。那怎么办？纹理模式是可以以一种渐变的模式来呈现的，也就是定义一个函数来生成，通过调整参数出来不一样的模式。以这种方式的话，那么我们就可以填充不一样的模式，但这些模式又比较相似，看起来比较舒服。

scale_fill_pattern_simple()就可以干这样的事情，它支持下面这个参数：

pattern_name = c('stripe', 'dot', 'hatch', 'check', 'stipple', 'hex')
angle = c(22., 45, 67.5)
spacing = seq(5, 50, length.out = 7)
fill_fraction = seq(0.1, 0.9, length.out = 3)

我们来看一下实例：

svgout(pattern_pkg = 'svgpatternsimple', filename = "man/figures/example-patternsimple-scale-fill.svg",
       width = 8, height = 6)
ggplot(mtcars) + 
  geom_density(aes(mpg, fill = interaction(cyl, am)), alpha = 1) +
  theme_bw() +
  theme(legend.key.size = unit(1.2, "cm")) +
  labs(title = "scale_fill_pattern_simple() - custom") +
  svgpatternsimple::scale_fill_pattern_simple(
    pattern_name  = c('stripe', 'hatch'),
    fill_fraction = seq(0.1, 0.4, length.out = 5), 
    angle         = c(45), 
    spacing       = c(10, 20)) 
invisible(dev.off())

这样就漂亮多了，做为画图设备，当然只在于最后出图，跟你的图用什么函数，什么画图系统并没有什么关系，所以ggplot2和base plot是通杀的。下面这个例子，用base plot画一个饼图。

colours <- c(
  svgpatternsimple::encode_pattern_params_as_hex_colour(
    pattern_name = 'null', 
    colour       = '#123456'
  ),

  svgpatternsimple::encode_pattern_params_as_hex_colour(
    pattern_name = 'stipple', 
    colour       = '#ff4455', 
    spacing      = 10
  ),

  svgpatternsimple::encode_pattern_params_as_hex_colour(
    pattern_name = 'hex', 
    colour       = '#ddff55', 
    spacing      = 8
  ),

  svgpatternsimple::encode_pattern_params_as_hex_colour(
    pattern_name = 'check', 
    colour       = '#ee55ff', 
    spacing      = 10
  )
)


devoutsvg::svgout(pattern_pkg = 'svgpatternsimple', filename = "man/figures/example-pie.svg")
pie(c(cool = 4, but = 2, use = 1, less = 8), col = colours)
invisible(dev.off())

画个地图试试

library(sf)
library(svgpatternusgs)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Select some data
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
nc$mid <- sf::st_centroid(nc$geometry)
nc <- nc[nc$NAME %in% c('Surry', 'Stokes', 'Rockingham', 'Yadkin', 'Forsyth', 'Guilford'), ]

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Encode specific USGS pattern numbers into colours
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
colours <- c(
  Surry      = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 601, spacing = 100, fill='#77ff99'),
  Stokes     = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 606, spacing = 100),
  Rockingham = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 629, spacing = 100),
  Yadkin     = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 632, spacing = 100),
  Forsyth    = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 706, spacing = 100),
  Guilford   = svgpatternusgs::encode_pattern_params_as_hex_colour(usgs_code = 717, spacing = 100)
)

devoutsvg::svgout(filename = "man/figures/example-usgs.svg", pattern_pkg = 'svgpatternusgs')
ggplot(nc) +
  geom_sf(aes(fill = NAME)) +
  scale_fill_manual(values = colours) + 
  theme(legend.key.size = unit(0.6, "cm")) + 
  labs(title = "U.S. Geological Survey Patterns with `geom_sf()`") +
  theme_bw()
invisible(dev.off())

想出PDF怎么办？

好是好，炫是炫，但出的是svg，学术圈偏好PDF，想出PDF怎么办？你可以转换格式啊！

• Inkscape

• rsvg on the command line

• rsvg-convert -f pdf -o t.pdf t.svg

• CairoSVG on the command line (python based)

• cairosvg in.svg -o out.pdf

• Imagemagick

• convert file.svg file.pdf

• Chrome headless

• chrome --headless --disable-gpu --print-to-pdf="output.pdf" "input.svg"

• Web-based. e.g.

• https://cloudconvert.com/svg-to-pdf