emdist segfaults 中的 emd2d 函数

Question

我正在尝试使用 apply 将函数应用于列表，但我在执行此操作时遇到了麻烦。我正在尝试使用 emdist 包计算推土机距离。列表中的每个索引都有两个子索引。我想迭代地计算这些子索引的推土机距离（实际列表有数千个索引）。问题是每次我尝试在测试数据集上运行代码时，Rstudio 都会崩溃。测试数据集示例：

set.seed(42) 
output1 <- list(list(matrix(0,8,11),matrix(0,8,11)), list(matrix(rnorm(80),8,10),matrix(rnorm(80),8,10))) 

[[1]] 
[[1]][[1]] 
       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] 
[1,]    0    0    0    0    0    0    0    0    0     0     0 
[2,]    0    0    0    0    0    0    0    0    0     0     0 
[3,]    0    0    0    0    0    0    0    0    0     0     0 
[4,]    0    0    0    0    0    0    0    0    0     0     0 
[5,]    0    0    0    0    0    0    0    0    0     0     0 
[6,]    0    0    0    0    0    0    0    0    0     0     0 
[7,]    0    0    0    0    0    0    0    0    0     0     0 
[8,]    0    0    0    0    0    0    0    0    0     0     0 

[[1]][[2]] 
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] 
[1,]    0    0    0    0    0    0    0    0    0     0     0 
[2,]    0    0    0    0    0    0    0    0    0     0     0 
[3,]    0    0    0    0    0    0    0    0    0     0     0 
[4,]    0    0    0    0    0    0    0    0    0     0     0 
[5,]    0    0    0    0    0    0    0    0    0     0     0 
[6,]    0    0    0    0    0    0    0    0    0     0     0 
[7,]    0    0    0    0    0    0    0    0    0     0     0 
[8,]    0    0    0    0    0    0    0    0    0     0     0 

现在当我这样做时：

library(emdist)
sapply(output1,function(x) {emd2d(x[[seq_along(x)[1]]],x[[seq_along(x)[2]]]) }) 

Rstudio 只是崩溃了。我也试过：

mapply(emd2d,sapply(output1,`[`,1),sapply(output1,`[`,2)) 

但无济于事。有任何想法吗？我在具有 2GB RAM 的 2013 macbook air 上运行它。

Answer 1

这很好用：

> emd2d(output1[[2]][[1]],output1[[2]][[2]])
[1] -6.089909

这不是：

emd2d(output1[[1]][[1]],output1[[1]][[2]])

当您比较 两个全零矩阵时，emd2d() 似乎会讨厌它...

至少在 OSX 上对我来说是这样，因为这对我来说是成功的：

set.seed(666)
output2 <- list(list(matrix(5,8,11),matrix(5,8,11)),  
           list(matrix(rnorm(80),8,10),matrix(rnorm(80),8,10)))
sapply(output2,function(x) {emd2d(x[[1]],x[[2]]) })
#[1]  0.000000 -7.995288
# not i removed your seq_along because I don't think you really want this..

就像这样：

> set.seed(666)
> output2 <- list(list(matrix(0,8,11),matrix(5,8,11)), list(matrix(rnorm(80),8,10),matrix(rnorm(80),8,10)))
> sapply(output2,function(x) {emd2d(x[[1]],x[[2]]) })
[1]       NaN -7.995288

也许您需要就此联系包创建者，同时您可以创建一个函数来检查两个矩阵是否全为零，例如

foo <- function(z){ if( sum(length(z[[1]][ z[[1]] != 0]),
                            length(z[[2]][ z[[2]] != 0]) ) > 0){
                        emd2d(z[[1]],z[[2]]) 
                    }else{ 
                      0 
                    }   
                  }

# i use length and subsetting, not just sum(), in case somehow 
# the two matrices sum to zero because you have minus values in them

> sapply(output1, foo)
[1]  0.000000 -6.089909