如何为散点图添加一个强调的标志

05 Jul 2013

---

相对于其他统计软件生成的统计图形，R的优势是可以对图形进行微观修饰，因此得到的图形更为美观，传递的信息量也比较大。一方面这需要对plot（）中的par参数有更深的了解，另一方面需要掌握其他图形修饰方法。比如下面的多边形绘图函数”grid.path()”.

例如，我们要绘制一个三角形：

library(grid)  #加载grid包
x <- c(0.1, 0.5, 0.9)  #三角形三个顶点横坐标
y <- c(0.1, 0.8, 0.1)  #三角形三个顶点纵坐标
grid.path(x, y, gp = gpar(fill = "grey")) #描绘图形

得到的图形为：

需要注意的是，描述多边形路径的坐标值均是位于0到1之内的数，对于横坐标而言，0表示从左边界开始，1表示右边界，对于纵坐标而言，0表示下边界，1表示上边界。坐标不能出现（0,1）之外的值。可以说，这些坐标采用的是”npc”单位形式。

如何同时画出多个图呢？这就要用到”id”了。

x <- c(0.1, 0.5, 0.9, 
       0.1, 0.2, 0.3)
y <- c(0.1, 0.8, 0.1, 
       0.7, 0.6, 0.7)

id <- rep(1:2, each = 3)  #id=1的坐标构成第一个图形，id=2的坐标构成第二个图形
grid.path(x, y, id = id, gp = gpar(fill = "grey"))

注意到的是，我们在构建图的坐标时，都是按照顺时针方向的。只有这样它们才会围成你想要的图形。如果你逆时针构建，默认的是路径向外的图形。

按照上述方法，我们绘制一个更加复杂的图形：

这个图形我们分成五部分来画。第一块是圆环，另外四块是四个三角形。路径够有六条，分别用id=1:6标识。第一条路径和第二条路径围成圆环，剩下的四条路径分别围成四个三角形。下面是我封装的一个函数：

fun <- function(x0, y0, len) {
  ## x1,y1为圆环外圆的坐标，坐标方向为顺时针
  x1 <- x0 + len * 0.87 * cos(seq(2*pi, 0, length = 200)) 
  y1 <- y0 + len * 0.87 *sin(seq(2*pi, 0, length = 200))
  ## x2,y2为圆环内圆的坐标，坐标方向逆时针
  x2 <- x0 + len * .6 * cos(seq(0, 2*pi, length = 200))
  y2 <- y0 + len * .6 * sin(seq(0, 2*pi, length = 200))
  
  ## x3,y3为最上侧三角形坐标，坐标方向为顺时针
  x3 <- c(x0-len/5, x0+len/5, x0)
  y3 <- c(y0 + len * 0.96, y0 + len * 0.96, y0 + len * 0.3)
  id <- c(rep(1:2, each = 200), rep(3, 3))
  
  ## x4, y4可由x3, y3旋转而来，旋转后仍保持顺时针，围成成右侧三角形
  fun1 <- function(x) {
    (x-c(x0, y0)) %*% matrix(c(0, 1, -1, 0), nrow =2) + c(x0, y0)
  }
  x4 <- apply(cbind(x3, y3), 1, fun1)[1, ]
  y4 <- apply(cbind(x3, y3), 1, fun1)[2, ]
  id <- c(rep(1:2, each = 200), rep(3:4, each = 3))
  ## x5, y5可由x3, y3旋转而来，旋转后仍保持顺时针，围成成下侧三角形
  fun2 <- function(x) {
    (x-c(x0, y0)) %*% matrix(c(-1, 0, 0, -1), nrow =2) + c(x0, y0)
  }
  x5 <- apply(cbind(x3, y3), 1, fun2)[1, ]
  y5 <- apply(cbind(x3, y3), 1, fun2)[2, ]
  
  ## x6, y6可由x3, y3旋转而来，旋转后仍保持顺时针，围成成左侧三角形
  fun3 <- function(x) {
    (x - c(x0, y0)) %*% matrix(c(0, -1, 1, 0), nrow =2) + c(x0, y0)
  }
  x6 <- apply(cbind(x3, y3), 1, fun3)[1, ]
  y6 <- apply(cbind(x3, y3), 1, fun3)[2, ]
  
  x <- c(x1, x2, x3, x4, x5, x6)
  y <- c(y1, y2, y3, y4, y5, y6)
  ## id标识六条路径
  id <- c(rep(1:2, each = 200), rep(3:6, each = 3))
  grid.path(x, y, id = id,gp=gpar(lwd=3))
  grid.path(x, y, id = id, gp=gpar(col=NA, fill="grey"))
}

fun函数的三个参数的含义：第一个参数和第二个参数分别为强调标志的位置，第三个参数表明标志的大小。举例如下：

fun(0.2, 0.5, len = 0.05)
fun(0.2, 0.5, len = 0.15)
fun(0.6, 0.8, len = 0.05)
fun(0.6, 0.2, len = 0.05)
fun(0.6, 0.5, len = 0.03)

如何将强调标志添加到散点图中？如下一个散点图：

library(lattice)
xyplot(mpg ~ disp, mtcars)

问题的焦点在于如何把点的坐标转化为”npc”单位。以“Ferrari Dino”为例：

> name = "Ferrari Dino"
> mtcars$disp[rownames(mtcars) == name]
[1] 145
> mtcars$mpg[rownames(mtcars) == name]
[1] 19.7

问题就是如何把145和19.7转化为0-1之间的数。所使用的函数为convertX和convertY:

> convertX(unit(mtcars$disp[rownames(mtcars) == name], "native"),
+                     "npc", valueOnly=TRUE)
[1] 0.2231011
> convertY(unit(mtcars$mpg[rownames(mtcars) == name], "native"),
+                     "npc", valueOnly=TRUE)
[1] 0.408548

有了坐标我们就可以为”Ferrari Dino”添加一个强调标志：

downViewport("plot_01.panel.1.1.vp")
fun(convertX(unit(mtcars$disp[rownames(mtcars) == name], "native"),
                    "npc", valueOnly=TRUE),
      convertY(unit(mtcars$mpg[rownames(mtcars) == name], "native"),
                    "npc", valueOnly=TRUE),
      0.04)

可以把函数进一步封装：

 
highlight1 <- function(name) {

  fun(convertX(unit(mtcars$disp[rownames(mtcars) == name], "native"),
                    "npc", valueOnly=TRUE),
      convertY(unit(mtcars$mpg[rownames(mtcars) == name], "native"),
                    "npc", valueOnly=TRUE),
      0.04)

}

直接用highlight1函数就可以画出强调标志。

---

参考文献：

• It’s not what you draw, it’s what you don’t draw
• R帮助文档

---