emd2d function from emdist segfaults

Question

I'm trying to apply a function to a list using apply but I'm having trouble doing so. I'm trying to calculate the earth-movers distance using the emdist package. Every index in the list has two subindices. I want to calculate the earth-movers distance for these subindices iteratively (the real list has thousands of indices). The problem is Rstudio crashes each time I try to run the code on a test dataset. An example of the test dataset:

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 

Now when I do this:

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

Rstudio simply crashes. I have also tried:

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

But to no avail. Any ideas? I'm running this on a 2013 macbook air with 2gb of RAM.

Answer 1

this works fine:

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

this does not:

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

Seems emd2d() might hate it when you compare two all zero matrices...

At least for me on OSX as this succeeds for me:

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..

as does 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

Maybe you need to contact the package creator about this then, in the mean time you could create a function that checks if both matrices are all zeros, e.g.

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