Question

我一直试图在互联网上找到解决方案，但没有设法解决我的具体问题。我有一个矩阵D告诉我一组矩形（列）的最大和最小x和y坐标。现在我想知道，它们中的一些经常交叉。我想要评估其中两个是否相交的方法需要在所有可能的列组合上运行（也是＃34;向后＆＃34;）。现在，对我来说，第一个直观的解决方案是将一个for循环嵌入到另一个循环中，执行相同的操作。这是一个例子：

n <- 5

D <- matrix(c(1,2,1,2,1,3,1,3,2,4,2,4,3,5,1,2,3,4,2,4),nrow=4,ncol=n)

E <- mat.or.vec(nr=n, nc=n)
for (i in 1:n){
    for (j in 1:n){
        if (i != j &&
           (D[1,i] <= D[1,j] & D[1,j] < D[2,i]) &&
           ((D[3,i] <= D[3,j] & D[3,j] < D[4,i]) | (D[3,i] < D[4,j] & D[4,j] <= D[4,i]))) { 
            E[i,j] <- 1
        }
    }
}

     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    0    0    0
[2,]    1    0    1    0    0
[3,]    0    0    0    0    1
[4,]    0    0    0    0    0
[5,]    0    0    0    0    0

我一直在尝试各种替代解决方案，包括使用foreach，outer，不同版本的apply及其组合。我发现很多版本都给了我相同的正确结果，但是由于某种原因，双循环执行的速度比任何其他方法都要快。
问题是，矩阵中有大约4000列，我必须运行整个结果函数大约50次。所以循环所用的时间仍然太长。任何人都可以告诉我为什么其他解决方案表现得更差（因为我认为循环是最糟糕的事情）并且可能建议一些能够快速处理大量数据的东西吗？

编辑：我尝试了用918矩形建议的两个解决方案并对它们进行了基准测试。

D1 <- t(D)
D1 <- D1[,c(1,3,2,3,2,4,1,4)]
ID <- paste0('rect',seq_len(nrow(D1)))
polys <- SpatialPolygons(mapply(function(poly, id) {
  xy <- matrix(poly, ncol=2, byrow=TRUE)
  Polygons(list(Polygon(xy)), ID=id)
  }, split(D1, row(D1)), ID))
polys.df <- SpatialPolygonsDataFrame(polys,data.frame(id=ID,row.names=ID))

res <-  gOverlaps(polys.df, byid = TRUE) | 
        gContains(polys.df, byid = TRUE) |
        gWithin(polys.df, byid = TRUE)
diag(res) <-0

intersecting_rects <- function(edge1, edge2){
  #* index 1 is left edge, index 2 is right edge
  #* index 3 is lower edge, index 4 is upper edge
  (edge1[1] < edge2[2] && edge1[2] > edge2[1] &&
     edge1[3] < edge2[4] && edge1[4] > edge2[3])
}
microbenchmark(
  poly = {
    res <-  gOverlaps(polys.df, byid = TRUE) | 
      gContains(polys.df, byid = TRUE) | 
      gWithin(polys.df, byid = TRUE) | 
      gCovers(polys.df, byid = TRUE)
    diag(res) <- 0
  },
  full_loop = {
    E <- mat.or.vec(nr=n, nc=n)
    for (i in 1:n){
      for (j in 1:n){
        E[i, j] <- as.numeric(intersecting_rects(D[, i], D[, j]))
      }
    }
  },
  partial_loop = {
    E <- mat.or.vec(nr=n, nc=n)
    for (i in 1:n){
      for (j in (i:n)[-1]){
        E[i, j] <- as.numeric(intersecting_rects(D[, i], D[, j]))
      }
    }
    E[lower.tri(E)] <- t(E)[lower.tri(E)]
  }
)
Unit: seconds
         expr      min       lq      mean    median        uq       max neval
         poly 5.280785 5.985167  6.277424  6.288105  6.567685  7.141447   100
    full_loop 8.328631 9.700908 10.091188 10.112840 10.490162 11.450817   100
 partial_loop 4.335070 4.921649  5.203672  5.188610  5.503550  6.000614   100

我们看到部分循环已经比完整循环显着改进，但仅略微优于具有空间对象的解决方案。因此，我决定采用Rolands解决方案。再次感谢！

Answer 1

这不是我的专业领域，但你应该使用空间包。

library(sp)
library(rgeos)
n <- 5

D <- matrix(c(1,2,1,2,1,3,1,3,2,4,2,4,3,5,1,2,3,4,2,4),nrow=4,ncol=n)

D1 <- t(D)
D1 <- D1[, c(1, 3, 2, 3, 2, 4, 1, 4)]
ID <- paste0('rect', seq_len(nrow(D1)))

# Create SP
#http://stackoverflow.com/a/26620550/1412059
polys <- SpatialPolygons(mapply(function(poly, id) {
  xy <- matrix(poly, ncol=2, byrow=TRUE)
  Polygons(list(Polygon(xy)), ID=id)
}, split(D1, row(D1)), ID))

# Create SPDF
polys.df <- SpatialPolygonsDataFrame(polys, data.frame(id=ID, row.names=ID))

plot(polys.df, col=rainbow(50, alpha=0.5))

然后您可以测试它们是否重叠：

gOverlaps(polys.df, byid = TRUE)
#      rect1 rect2 rect3 rect4 rect5
#rect1 FALSE FALSE FALSE FALSE FALSE
#rect2 FALSE FALSE  TRUE FALSE FALSE
#rect3 FALSE  TRUE FALSE FALSE FALSE
#rect4 FALSE FALSE FALSE FALSE FALSE
#rect5 FALSE FALSE FALSE FALSE FALSE

，例如rect2和rect3重叠，您尚未确定：

plot(polys.df[2:3,], col=rainbow(50, alpha=0.5))

或者它们是否相互包含？

gContains(polys.df, byid = TRUE)

，例如rect2包含rect1：

plot(polys.df[1:2,], col=rainbow(50, alpha=0.5))

依旧......

最后你可以这样做：

res <-  gOverlaps(polys.df, byid = TRUE) | 
        gContains(polys.df, byid = TRUE) | 
        gWithin(polys.df, byid = TRUE) | 
        gCovers(polys.df, byid = TRUE)
diag(res) <- 0

#      rect1 rect2 rect3 rect4 rect5
#rect1     0     1     0     0     0
#rect2     1     0     1     0     0
#rect3     0     1     0     0     1
#rect4     0     0     0     0     0
#rect5     0     0     1     0     0

当然，仅测试两个条件然后在对角线上镜像矩阵就足够了（或者甚至保留三角形稀疏矩阵以节省内存）。

Answer 2

我喜欢罗兰的答案有很多理由比我在这里给出的答案要好。

代码更能说明正在做什么。（从现在起六个月后重要）
它更具概括性，可以处理空间对象可以处理的任何形状
它有很好的设施来说明问题。

尽管如此，我还是会提供一种可能比空间方法运行得更快的替代解决方案。但是，这仅适用于矩形。

首先，我们依赖于基于this question's answer的重叠矩形的逻辑测试。然后我们可以编写一个函数来执行此测试

intersecting_rects <- function(edge1, edge2){
#* index 1 is left edge, index 2 is right edge
#* index 3 is lower edge, index 4 is upper edge
  (edge1[1] < edge2[2] && edge1[2] > edge2[1] &&
    edge1[3] < edge2[4] && edge1[4] > edge2[3])
}

我们可以将它直接包含在for循环中，但我觉得这样更容易阅读。

接下来，让我们计算矩阵E。但是，在这种情况下，我们只会在j j大于i

n <- 5
D <- matrix(c(1,2,1,2,1,3,1,3,2,4,2,4,3,5,1,2,3,4,2,4),nrow=4,ncol=n)

E<-mat.or.vec(nr=n,nc=n)
for (i in 1:n){
  for (j in (i:n)[-1]){
    E[i, j] <- as.numeric(intersecting_rects(D[, i], D[, j]))
  }
}

E[lower.tri(E)] <- t(E)[lower.tri(E)]
E

还不错！但它与罗兰的答案相比如何呢？让我们把它全部设置起来并进行粗略的比较（主要的CAVEAT：这个比较是在一个非常小的矩形集上，我不会认为这会很好地扩展，但如果你可以在100你的矩形，它应该让你知道最快的结果）

library(sp)
library(rgeos)
library(microbenchmark)

#* Rectangles Comparison Function
intersecting_rects <- function(edge1, edge2){
  (edge1[1] < edge2[2] && edge1[2] > edge2[1] &&
    edge1[3] < edge2[4] && edge1[4] > edge2[3])
}

n <- 5
D <- matrix(c(1,2,1,2,1,3,1,3,2,4,2,4,3,5,1,2,3,4,2,4),nrow=4,ncol=n)


#* Set up the Spatial Obects
D1 <- t(D)
D1 <- D1[, c(1, 3, 2, 3, 2, 4, 1, 4)]
ID <- paste0('rect', seq_len(nrow(D1)))

    # Create SP
    #https://stackoverflow.com/a/26620550/1412059
polys <- SpatialPolygons(mapply(function(poly, id) {
  xy <- matrix(poly, ncol=2, byrow=TRUE)
  Polygons(list(Polygon(xy)), ID=id)
}, split(D1, row(D1)), ID))

    # Create SPDF
polys.df <- SpatialPolygonsDataFrame(polys, data.frame(id=ID, row.names=ID))

#* Benchmark the speeds
microbenchmark(
  poly = {
    res <-  gOverlaps(polys.df, byid = TRUE) | 
            gContains(polys.df, byid = TRUE) | 
            gWithin(polys.df, byid = TRUE) | 
            gCovers(polys.df, byid = TRUE)
    diag(res) <- 0
  },
  full_loop = {
    E <- mat.or.vec(nr=n, nc=n)
    for (i in 1:n){
      for (j in 1:n){
        E[i, j] <- as.numeric(intersecting_rects(D[, i], D[, j]))
      }
    }
  },
  partial_loop = {
    E <- mat.or.vec(nr=n, nc=n)
    for (i in 1:n){
      for (j in (i:n)[-1]){
        E[i, j] <- as.numeric(intersecting_rects(D[, i], D[, j]))
      }
    }
    E[lower.tri(E)] <- t(E)[lower.tri(E)]
  }
)

Unit: microseconds
         expr      min        lq       mean    median        uq      max neval cld
         poly 2656.800 2720.8745 2812.72787 2767.2080 2811.4875 4200.736   100   b
    full_loop  108.795  116.5650  122.77029  120.8170  127.2690  175.947   100  a 
 partial_loop   69.500   76.3905   87.01193   85.7745   94.1325  166.857   100  a

因此，如果您真的对速度感兴趣，那么for循环可能不是一个糟糕的选择。

如何在访问矩阵的所有列的组合时避免双循环？

2 个答案: