厚缊

诹图——区域缩放图

厚缊 / 2019-05-03


大好的五一假期,外面人山人海,热闹不凡,而我窝在深圳天天听雨滴落的声音,显得有几分冷清,也有一份别样的惬意。不过话说回来,深圳真的有点冷,差不多快要穿上外套了。如此冷的一天,我都在思考怎么让R处理图例更从容一些,结果图例的东西没整好,写了个画缩放小图的函数,权当练笔。

缩放小图在很多地方都有用到,比如中国地图的南海九段线,一般放大后放在右下角,一些高频的时间序列图,有时候也需要放大某一区域看到更多细节。R中处理的思路一般有两种,第一种是先把缩放小图画好,画完大图后将缩放小图用图像处理工具(如magick包)等叠加在大图上,另一种是把要缩放的区域坐标做映射变换到小图图框区域内,和主图同时绘制。我今天的解决方案接近于第一种,但不同的是充分利用了grid*Grob( )类函数生成图形对象的机制,ggplot2底层是基于grid的,这一机制同样适用。

*Grob( )类图形对象

什么是图形对象?我觉得以我的水平也说不太清楚,只能凭感觉和自我理解来胡说一番。一般来说,若一个函数的调用对外部环境产生影响,包括更改全局设置、在屏幕上打印输出文本、在图形设备上绘图等,那么这个函数是有副作用(side effect)的,这里副作用不带有任何感情色彩,只是表面函数对调用它的环境产生了影响。我们见到的很多绘图函数(如plot( )barplot( ))都是得益于它们的副作用。grid包提供了另外一种机制,*Grob( )函数的图形对象机制,有点类似于R中的延迟计算,这一类函数并不会直接显示图形,而是把绘图需要的元素保存在对象(或者变量)中,需要手动调用grid.draw( )才会产生图形,ggplot2之所以能设计得如此美妙,grid的这一机制至关重要。我们可能会有疑问,当我们用ggplot2函数绘图时,都是和基础绘图系统一样直接出图的,感觉没什么不一样。这是由于ggplot2包内置了ggplot对象的打印输出方法,所以很多时候不能感觉到它的不同。

下面的例子我们把ggplot的绘图对象赋值给gg变量,可以发现此时并没有图形输出。gg变量是ggggplot类。当去掉类属性后,ggplot绘图对象本质上就是列表,有兴趣可以str( )函数查看里面的详细结构。最后重新添加类属性,调用grid.draw( )画图完全可以还原。

library(ggplot2)
library(grid)
gg <- ggplot(mpg, aes(displ, hwy, colour = class)) + geom_point() 
class(gg)
uclsgg <- unclass(gg)
typeof(uclsgg)
gg <- structure(uclsgg, class = c('gg', 'ggplot'))
grid.draw(gg)

## [1] "gg"     "ggplot"
## [1] "list"

讲到这里,我们要解决缩放小图的思路已经十分清楚了,就是把缩放小图的绘图对象存在一个变量中,大图绘制完成后把小图画在大图相应的位置上即可,问题的关键就是如何确定位置,如何把一个ggplot对象画在另一个图形上。

生成缩放小图对象

ggplot2包中内置了两套限定绘图坐标区域的工具,一套是基于坐标变换的缩放工具,这套工具不改变原绘图绘图数据,只是超过坐标限定范围的不显示出来;另一套工具是和基础绘图系统类似的工具,主要通过xlim( )ylim( )函数限定绘图坐标区域,和前者的差别是这个工具会丢弃超过绘图区的数据,在新数据基础上画图。当我们所画的图只是单一的、不经过统计变化的散点图之类的,两者在结果上没有区别,但当画经过统计变换后的图,如平滑曲线,两者就会存在明显的差异。

下面的例子中,左侧是基于坐标变换的(coord_cartesian( ))的区域缩放,曲线很平滑,一条向右下倾斜的曲线。右侧是基于xlim( )ylim( )的,曲线波动很大,从外观上看和左侧根本就是两个图。尽管两者有差异,但是在不同的场景下使用需要仔细选择:当类似于拿着放大镜查看原图的细节,请使用基于坐标变换的缩放方法;当类似于整群抽样时,可以使用基于xlim( )ylim( )的缩放方法。

library(patchwork) # 方便拼图
set.seed(20190503)
n = 1000
df <- data.frame(x = 1:n, y = cumsum(rnorm(n)))
gg_coord <- ggplot(df, aes(x, y)) + geom_smooth() + 
  coord_cartesian(xlim = c(430, 470), ylim = c(15, 20)) 
gg_lim <- ggplot(df, aes(x, y)) + geom_smooth() + xlim (430, 470) +
  ylim(15, 20)
gg_coord + gg_lim  ## 按列拼接两个图

插入缩放小图

这里用到了grid视图的概念,首先在画好的ggplot大图上确定要画的缩放小图的位置和大小,然后定义个新的视图,把小图画在里面完工。这里我写了两个工具函数,让插入ggplot图形对象更加简便一些。当然,写这个的目的是为了处理图例,写这篇文章也是心血来潮,有不对的地方也在所难免。

“路痴”导航器

grid视图的坐标原点是左下角,坐标定位点可以是左下、左上、右上和右下四个点,当坐标定位点不在左下角的时候,我自己很容易忘记用unit(1, 'npc)(代表整个图形设备的长度或宽度)减相应的值,从下面的图中也能看出,刚开始接触很容易出错。为了减轻健忘带来的痛苦,写了下面的函数。just_tools( )函数中X和Y坐标点均是相对于坐标定位点的距离,宽度(width)和高度(height)是X和Y坐标点到对角点的横向、纵向距离,返回值是grid标准的X、Y坐标列表。

just_tools <- function(x, y, just){
  rl <- just[1]
  bt <- just[2]
  if(!(rl %in% c('left', 'right')))
    stop("'just[1]' should be 'left' or 'right'.", call. = FALSE)
  if(!(bt %in% c('bottom', 'top')))
    stop("'just[2]' should be 'bottom' or 'top'.", call. = FALSE)
  if(rl == 'left'){
    x <- x
  }else{
    x <- grid::unit(1, 'npc') - x
  }
  if(bt == 'bottom'){
    y <- y
  }else{
    y <- grid::unit(1, 'npc') - y
  }
  invisible(list(x = x, y = y))
}

## 测试
(just_tools(x = unit(2, 'mm'), y = unit(2, 'mm'), just = c('left', 'bottom')))
(just_tools(x = unit(2, 'mm'), y = unit(2, 'mm'), just = c('left', 'top')))
(just_tools(x = unit(2, 'mm'), y = unit(1, 'cm'), just = c('right', 'top')))
(just_tools(x = unit(2, 'mm'), y = unit(1, 'cm'), just = c('right', 'bottom')))
## $x
## [1] 2mm
## 
## $y
## [1] 2mm
## 
## $x
## [1] 2mm
## 
## $y
## [1] 1npc-2mm
## 
## $x
## [1] 1npc-2mm
## 
## $y
## [1] 1npc-1cm
## 
## $x
## [1] 1npc-2mm
## 
## $y
## [1] 1cm

缩放小图函数

函数看起来有点长,核心部分只有最后的十行:定义个新的视图,X、Y坐标是调用时提供的相对坐标点,widthheight是将插入图的宽度和高度;print(gg, newpage = FALSE)插入ggplot绘图对象,newpage = FALSE表示在当前设备插入,默认会新开绘图设备。

draw_gg <- function(gg, # “ggplot”图形对象
                        x = grid::unit(4, "mm"), # 偏离定位坐标点的宽度
                        y = grid::unit(4, "mm"), # 偏离定位坐标点的长度
                        just = c('left', 'bottom'), # 定位坐标点
                        box = FALSE, # 缩放小图是否有边框
                        space = NULL, # 边框和缩放小图的空白
                                       #(上下左右是均是space的一半,默认4mm
                        width = NULL, # 缩放小图宽度,须是units类
                        height = NULL, # 缩放小图高度,须是units类
                        box_lty = NULL, # 边框线型类型
                        box_lwd = NULL, # 边框线宽度
                        box_lcol = NULL, # 边框线颜色
                        box_fill = NULL # 边框矩形填充色
                    ){
  if(!is.ggplot(gg))
    stop("'gg' is not a 'ggplot' object.", call. = FALSE)
  xy <- just_tools(x = x, y = y, just = just)
  xx <- xy[[1]]
  yy <- xy[[2]]
  if(is.null(width))
    width = grid::widthDetails(gg)
  if(is.null(height))
    height = grid::heightDetails(gg)
  if(box){
    
    if(is.null(box_lty)) box_lty <- grid::get.gpar('lty')[[1]]
    if(is.null(box_lwd)) box_lwd <- grid::get.gpar('lwd')[[1]]
    if(is.null(box_lcol)) box_lcol <- grid::get.gpar('col')[[1]]
    if(is.null(box_fill)) box_fill <- grid::get.gpar('fill')[[1]]
    if(is.null(space)) space <- unit(4, 'mm')
    grid::pushViewport(
      grid::viewport(x = xx,
                     y = yy,
                     width = width + space,
                     height = height + space,
                     just = just,
                     name = 'gg-box'
      ))
    
    grid::grid.rect(
      gp = gpar(
        lty = box_lty,
        lwd = box_lwd,
        col = box_lcol,
        fill = box_fill
      )
    )
    grid::upViewport()
  }
  
  
  if(box){
    ggxy <- just_tools(x = x + 1/2 * space, y = y + 1/2 * space, just = just)
    xx <- ggxy[[1]]
    yy <- ggxy[[2]]
  }
  grid::pushViewport(
    grid::viewport(x = xx,
                   y = yy,
                   width = width,
                   height = height,
                   just = just,
                   name = 'gg-draw'
    ))
  print(gg, newpage = FALSE)
  grid::upViewport()
  
}

前面两条ggplot2绘图的内容比较简单,不用过多解释。后面一条调用前面定义的函数:

  • just = c('right', 'top')表示坐标控制点是右上角;

  • x = unit(0.2, 'npc')表示缩放小图右上角X坐标与控制点X坐标相差0.2个图形设备宽度;

  • y = unit(0.5, 'cm')表示缩放小图右上角Y坐标与控制点Y坐标相差0.5cm;

  • width = unit(0.2, 'npc')表示缩放小图的宽度是0.2个图形设备宽度;

  • height = unit(0.3, 'npc')表示缩放小图的高度是0.3个图形设备宽度

  • box = TRUE表示缩放小图添加矩形框;

  • space = unit(1, 'mm')表示缩放小图的空白是1mm;

  • box_lty = 'dashed'表示缩放小图的矩形框线型为虚线;

  • box_fill = NA表示缩放小图的矩形框不填充。

arrow_df <- data.frame(x1 = 562, x2 = 480, y1 = 20, y2 = 17)
ggplot(df, aes(x, y)) + geom_line() + 
  geom_rect(xmin = 430, xmax = 470, ymin = 15, ymax = 20, color = 'red', fill = NA) +
  geom_segment(data = arrow_df, aes(x = x1, y = y1, xend = x2, yend = y2), 
               arrow = arrow(length = unit(3, 'mm')), size = 1.2, color = 'red')
ggzoom <- ggplot(df, aes(x, y)) + geom_line() +
  coord_cartesian(xlim = c(430, 470), ylim = c(15, 20)) + theme_void()

draw_gg(ggzoom, 
        x = unit(0.2, 'npc'), y = unit(0.5, 'cm'), just = c('right', 'top'),
        width = unit(0.2, 'npc'), height = unit(0.3, 'npc'), 
        box = TRUE, space = unit(1, 'mm'), box_lty = 'dashed', box_fill = NA)

地图缩放小图

draw_gg( )函数原则上可以在绘图设备的任何地方,插入任何基于grid的绘图对象。处理地图的过程和前面的缩放图一致,有一个特殊的地方是这里我直接用downViewport('panel.7-5-7-5')定位到了ggplot的绘图区,不同的绘图函数绘图区的名字不一样,需要自己去找。找的技巧是在grid::current.vpTree()函数返回值中查看,绘图区视图以panel开头,后面接一串数字。当使用分面绘图后,可能存在多个绘图区。画完两幅地图,感叹R绘图系统处理大数据的能力还是比较弱,出一幅图都快够我喝杯茶了,不像商业gis软件,点点就完成工作。

我使用了绝对距离进行定位,在输出图形较小,或者图形设备没有全屏打开,存在覆盖问题。经过我的测试,输出分辨率设置为1400*1000时效果比较好。

县级行政区划图

library(dplyr)
library(sf)
library(circlize)
china <- st_read('your/path/to/data/BOUNT_poly.shp') #县级行政边界
nineline <- readr::read_csv('your/path/to/data/nineline.csv') #南海九段线坐标

## 随机生成数据
df2 <- data.frame(sh2 = china$SH2, x = runif(3407, min = 0, max = 5))
df2 <- df2 %>% group_by(sh2) %>% arrange(x)
x <- df2$x
x[sample(1:3407, 500)] <- sample(seq(4.5, 5, length.out = 5), 500, replace = TRUE)
x[sample(1:3407, 500)] <- sample(seq(0, 0.5, length.out = 5), 500, replace = TRUE)
china$x <- df2$x

## 处理颜色
col <- colorRamp2(c(0, 2.5, 5), c('#0000FF', '#00FF00','#FC8D62'))(seq(0,5, length.out = 20))

##主图
ggplot(china) + 
  geom_sf(aes(fill = x), colour = 'grey80', size = 0.1) + 
  geom_line(data = nineline, aes(x = long, y = lat, group = ID)) +
  scale_fill_gradientn(colours = col) + 
  coord_sf(datum = st_crs(4610)) 
## 南海小图
chnzoom <- ggplot(china) + 
  geom_sf(aes(fill = x), colour = 'grey80', size = 0.3) + 
  geom_line(data = nineline, aes(x = long, y = lat, group = ID)) + 
  scale_fill_gradientn(colours = col) + 
  coord_sf(datum = sf::st_crs(4610), xlim = c(106.55, 123.58), ylim = c(4.61, 25.45)) + 
  theme(legend.position = 'none', 
        axis.text = element_blank(), 
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        plot.margin = unit(c(0,0,0,0), 'mm'))

## 定位到ggplot绘图区
downViewport('panel.7-5-7-5')

## 插入南海小图
draw_gg(chnzoom, 
        x = unit(0, 'cm'), y = unit(0, 'cm'), just = c('right', 'bottom'),
        width = unit(2.59, 'inches'), height = unit(3.2, 'inches'), 
        box = TRUE, space = unit(0.2, 'mm'), box_lty = 'solid', box_fill = NA)

省级行政区划图

china_sh <- st_read('your/path/to/data/bou2_4p.shp')

ggplot(china_sh) + 
  geom_sf(aes(fill = AREA), colour = 'grey40', size = 0.5) +  
  geom_line(data = nineline, aes(x = long, y = lat, group = ID)) + 
  scale_fill_gradientn(colors = c('green', 'yellow')) +
  coord_sf(datum = st_crs(4610)) 
chnshzoom <- ggplot(china_sh) + 
  geom_sf(aes(fill = AREA), colour = 'grey40', size = 0.5) + 
  geom_line(data = nineline, aes(x = long, y = lat, group = ID)) + 
  scale_fill_gradientn(colors = c('green', 'yellow')) + 
  coord_sf(datum = sf::st_crs(4610), xlim = c(106.55, 123.58), ylim = c(4.61, 25.45)) + 
  theme(legend.position = 'none', 
        axis.text = element_blank(), 
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        plot.margin = unit(c(0,0,0,0), 'mm'))

downViewport('panel.7-5-7-5')

draw_gg(chnshzoom, 
        x = unit(0, 'cm'), y = unit(0, 'cm'), just = c('right', 'bottom'),
        width = unit(2.59, 'inches'), height = unit(3.2, 'inches'), 
        box = TRUE, space = unit(0.2, 'mm'), box_lty = 'solid', box_fill = NA)

后记

尽管可以向ggplot图中插入各种绘图元素,但只要有其它的解决方案,我都不建议采用这种方法,实在有点慢。