Question

＆＃34;＆＃34;是一个列表和＆＃34; b＆＃34;是一个矩阵。

a<-list(matrix(c(0,2,0,1,0,2,0,0,1,0,0,0,0,0,2,2),4), 
        matrix(c(0,1,0,0,0,1,1,0,0,0,0,0),3),
        matrix(c(0,0,0,0,2,0,1,0,0,0,0,0,2,0,2,1,0,1,1,0),5))
b<-matrix(c(2,2,1,1,1,2,1,2,1,1,2,1,1,1,1,1,1,2,2,2,1,2,1,1),6) 

> a
[[1]]
     [,1] [,2] [,3] [,4]
[1,]    0    0    1    0
[2,]    2    2    0    0
[3,]    0    0    0    2
[4,]    1    0    0    2

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

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

> b
     [,1] [,2] [,3] [,4]
[1,]    2    1    1    2
[2,]    2    2    1    2
[3,]    1    1    1    1
[4,]    1    1    1    2
[5,]    1    2    1    1
[6,]    2    1    2    1

列表中有3个对象＆＃34; a＆＃34;。我想测试列表中每个对象中是否所有非零元素＆＃34; a＆＃34;匹配矩阵＆＃34; b＆＃34;中相同行的相应位置。如果匹配，则输出匹配的行号b。

例如，第二个对象是

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

我们可以看到第1行中的非零数字是1，它位于行的第3位，它可以匹配1-5行矩阵＆＃34; b＆＃34;，非第2行中的-zero数是1，它位于该行的第一位，它可以匹配3-5行矩阵＆＃34; b＆＃34;，第3行中的非零数字是1，它位于该行的第二位，它可以匹配3-4行矩阵＆＃34; b＆＃34;。所以只有Matrix的第3或第4行＆＃34; b＆＃34;可以匹配此对象中的所有行，因此输出结果为＆＃34; 3 4＆＃34;。

我的尝试代码如下：

temp<-Map(function(y) t(y), Map(function(a) 
           apply(a,1,function(x){
                 apply(b,1, function(y) identical(x[x!=0],y[x!=0]))}),a))
lapply(temp, function(a) which(apply(a,2,prod)==1))

结果如下：

[[1]]
integer(0)

[[2]]
[1] 3 4

[[3]]
[1] 6

是对的。但我想知道是否有更快的代码来处理这个问题？

Answer 1

有几列并尝试利用＆gt;列; 1个唯一值或没有非零值来减少计算：

ff = function(a, b)
{
    i = seq_len(nrow(b))  #starting candidate matches
    for(j in seq_len(ncol(a))) {
        aj = a[, j]
        nzaj = aj[aj != 0L]
        if(!length(nzaj)) next  #if all(a[, j] == 0) save some operations
        if(sum(tabulate(nzaj) > 0L) > 1L) return(integer())  #if no unique values in a column break looping 
        i = i[b[i, j] == nzaj[[1L]]]  #update candidate matches
    }

    return(i)
}
lapply(a, function(x) ff(x, b))
#[[1]]
#integer(0)
#
#[[2]]
#[1] 3 4
#
#[[3]]
#[1] 6

使用您实际尺寸的数据：

set.seed(911)
a2 = replicate(300L, matrix(sample(0:3, 20 * 5, TRUE, c(0.97, 0.01, 0.01, 0.01)), 20, 5), simplify = FALSE)
b2 = matrix(sample(1:3, 15 * 5, TRUE), 15, 5)
identical(OP(a2, b2), lapply(a2, function(x) ff(x, b2)))
#[1] TRUE
microbenchmark::microbenchmark(OP(a2, b2), lapply(a2, function(x) ff(x, b2)), times = 50)
#Unit: milliseconds
#                              expr        min         lq       mean     median         uq       max neval cld
#                        OP(a2, b2) 686.961815 730.840732 760.029859 753.790094 785.310056 863.04577    50   b
# lapply(a2, function(x) ff(x, b2))   8.110542   8.450888   9.381802   8.949924   9.872826  15.51568    50  a

OP是：

OP = function (a, b) 
{
    temp = Map(function(y) t(y), Map(function(a) apply(a, 1, 
        function(x) {
            apply(b, 1, function(y) identical(x[x != 0], y[x != 
                0]))
        }), a))
    lapply(temp, function(x) which(apply(x, 2, prod) == 1))
}

Answer 2

您对所需内容以及可能的矩阵外观的解释并不清楚。根据我的推断，您希望匹配b中与a中矩阵的每列中唯一的非零数字匹配的行号。如果是这样，这里有一个更简单的选择：

lapply(a, function(x){    # loop across the matrices in a
    x[x == 0] <- NA       # replace 0s with NA
    which(apply(b, 1, function(y){            # loop across the rows of b, trying to match
        all(y == colMeans(x, na.rm = TRUE))   # the rows of b with the colmeans of x
    }))
})
# [[1]]
# [1] 2
# 
# [[2]]
# [1] 5
# 
# [[3]]
# [1] 6

将列表匹配到R

2 个答案: