在基础R中创建渐变填充箭头

时间:2014-09-14 21:55:04

标签: r

我正在寻找一种方法来将箭头添加到基础R中的绘图中,这样箭头就会用灰色渐变颜色填充,如下所示:

enter image description here

我已经看到了this解决方案,但这看起来相当复杂而且不那么灵活:我需要在很多情节中绘制一个很棒的mahy箭头,所有这些都可能具有不同的长度和宽度。 我知道shape包,但似乎只能填充箭头,并且不提供可填写的"基础"箭头 有什么建议吗?

2 个答案:

答案 0 :(得分:1)

根据@ MrFlick的建议,这是一种让你入门的方法。您可能希望将此封装在一个函数中,该函数将允许您对箭头的大小,基部和箭头的宽度,渐变的平滑度等施加更多影响。

#empty box
plot(c(-1, 2), c(-1, 10), ,type="n",axes=FALSE, xlab = "", ylab = "")
# plot the arrow, without a fill
polygon(c(0,0,-.25,.5,1.25,1,1,0), y = c(0,6,6, 8,6,6,0,0), border = NA)
# create gradient colors
nslices = 100
cols <- colorRampPalette(colors = c("white", "black"))(nslices)
# split the base of the arrow in nslices and fill each progressively
ys <- seq(0,6, len = nslices + 1)
for (i in 1:nslices) {
  polygon(c(0,0,1,1), c(ys[i], ys[i+1], ys[i+1], ys[i]), col = cols[i], border = NA)
}
# add a filled arrowhead
polygon(c(-.25, .5, 1.25, -.25), c(6, 8, 6, 6), col = "black")

这会给你一个这样的箭头:

enter image description here

HTH,彼得

答案 1 :(得分:1)

使用链接问题中定义的箭头,现在使用基本图形

# create a black arrow, saved as external file
library(grid)
png("mask.png")
grid.polygon(c(-0.06, 0.06, 0.06, 0.15, 0, -0.15, -0.06),
             c(-5, -5, 2.5, 2, 5, 2, 2.5), gp=gpar(fill="black"),
             def="native",
             vp=viewport(xs=c(-0.15, 0.15), ys=c(-5, 5)))
dev.off()

## read back in as colour matrix
library(png)
m <- readPNG("mask.png", native=FALSE)
mask <- matrix(rgb(m[,,1],m[,,2],m[,,3]),
               nrow=nrow(m))

rmat <- matrix(grey(seq(0,1,length=nrow(m))),
               nrow=nrow(m), ncol=ncol(m))
rmat[mask == "#FFFFFF"] <- NA


## use in base plot
set.seed(12321)
plot(1:10, rnorm(10))
rasterImage(rmat, 2, -1, 2.5, 0)

enter image description here

编辑:

不必使用临时文件来创建掩码,它比摆弄逻辑矩阵更方便(更多)。这是一个直接创建箭头的起点,

marrow <- function(nr=500, nc=300, col = grey(seq(0, 1, length=nr))){

  skin <- matrix(col, nrow=nr, ncol=nc)
  head <- lower.tri(matrix(TRUE, nrow=nc/2, ncol=nc/2))
  skull <- cbind(head[seq(nc/2,1),], head[seq(nc/2,1),seq(nc/2,1)])

  rib <- matrix(TRUE, nrow=nr-nrow(skull), ncol=nc/4)
  trunk <- cbind(rib, !rib, !rib, rib)
  skeleton <- rbind(skull, trunk)
  skin[skeleton] <-  NA_character_
  skin
}

grid.newpage()
grid.raster(marrow(), 
            width = unit(1,"npc"), 
            height=unit(1,"npc"))

enter image description here