R中图像矩阵绘制矩形的效率

Question

我有一个函数drawRect，它会在n x m x 3矩阵上绘制一个矩形（每个颜色通道一个图层）。

它有两个主要参数：矩形参数c(xleft, xright, ytop, ybottom)和图像矩阵im

drawRect <- function(rect, im, color=2){
  int = 255
  im[rect[3]:rect[4],rect[1],color] = int
  im[rect[3]:rect[4],rect[2],color] = int
  im[rect[3],rect[1]:rect[2],color] = int
  im[rect[4],rect[1]:rect[2],color] = int
  return(im)
}

该功能可以正常工作。但是，我试图在3400 x 5200 x 3图像上绘制〜2000个矩形，这就是它变得非常慢的地方。

我有一个2000 x 4矩形参数矩阵，如下所示：

#xleft xright ytop ybottom
313    413  143     243
413    513  143     243
513    613  143     243
613    713  143     243
713    813  143     243
811    911  143     243
...

关于如何提高速度的任何想法？...

注意我的图像是使用readJPEG包的jpeg函数读入的，并使用writeJPEG函数写入文件。

---

编辑：我尝试传入矩形参数矩阵并使用apply函数来避免函数的多次调用，但仍然没有明显的改进。

drawRect2 <- function(rects, im, color=2, int = 255){

  x=apply(rects, 1, function(rect){
      im[rect[3]:rect[4],rect[1],color] = int
      im[rect[3]:rect[4],rect[2],color] = int
      im[rect[3],rect[1]:rect[2],color] = int
      im[rect[4],rect[1]:rect[2],color] = int
  })

  return(im)
}

Answer 1

我不知道是否存在rect的矢量化版本，但您可以使用矢量化的poylygon。你只需要在矩形之间添加NA。这个答案的灵感来自优秀的答案here。

cuts <- function(x)
{
  n <- length(x) %/% 4
  map <- rep(c(rep(TRUE,4),FALSE), n)
  result <- rep(NA, n*5)
  result[map] <- x
  result
}


n <- 2000

xbottom <- runif(n)
ybottom <- runif(n)
xtop <- xbottom+runif(n)
ytop <- ybottom+runif(n)

x <- cbind(xbottom,xbottom,xtop,xtop)
y <- cbind(ybottom,ytop,ytop,ybottom)
cols <- heat.colors(n)[order(x[,1])]
plot(0, xlim=c(min(x),max(x)), ylim=c(min(y),max(y)))
polygon(x=cuts(t(x)), y=cuts(t(y)), col=cols)

这将立即创建2000个矩形。