R:如何在两个列表上运行函数？

Question

我想在两个列表上运行以下函数:

function(Z, p) {
  imp <- as.vector(cbind(imp=rowSums(Z)))
  exp <- as.vector(t(cbind(exp=colSums(Z))))
  x = p + imp
  ac = p + imp - exp  
  einsdurchx = 1/as.vector(x)    
  einsdurchx[is.infinite(einsdurchx)] <- 0
  A = Z %*% diag(einsdurchx)
  R = solve(diag(length(p))-A) %*% diag(p)
  C = ac * einsdurchx
  R_bar = diag(as.vector(C)) %*% R
  rR_bar = round(R_bar)
  return(rR_bar)
}

在 matrix 上运行良好和一个 vector .但是，我需要在 list of matrices 上运行此功能和一个 list of vectors .我到目前为止尝试过 lapply/mapply关注此 example ， 见下文。这里有一些示例数据显示了我的数据结构:

Z <- list("111.2012"= matrix(c(0,0,100,200,0,0,0,0,50,350,0,50,50,200,200,0),
                             nrow = 4, ncol = 4, byrow = T),
           "112.2012"= matrix(c(10,90,0,30,10,90,0,10,200,50,10,350,150,100,200,10),
                              nrow = 4, ncol = 4, byrow = T))
p <- list("111.2012"=c(200, 1000, 100, 10), "112.2012"=c(300, 900, 50, 100))

这里 lapply我试过的代码(我在 X 和 Y 的函数中更改了所有 Z 和 p，不知道是否需要):

lapply(X=Z, Y=p, function(Z, p) {
  imp <- as.vector(cbind(imp=rowSums(X)))
  exp <- as.vector(t(cbind(exp=colSums(X))))
  x = Y + imp
  ac = Y + imp - exp  
  einsdurchx = 1/as.vector(x)    
  einsdurchx[is.infinite(einsdurchx)] <- 0
  A = X %*% diag(einsdurchx)
  R = solve(diag(length(Y))-A) %*% diag(Y)
  C = ac * einsdurchx
  R_bar = diag(as.vector(C)) %*% R
  rR_bar = round(R_bar)
  return(rR_bar)
} )

我似乎在索引列表的对象时遇到问题，但我对列表比较陌生。你有什么想法我做错了什么吗？此外，对象(Z 和 p)需要按名称匹配，因为列表中有 1000 多个对象(信息:两个列表具有相同的对象/项目长度，Z 中矩阵的行/列具有与 p 中的向量长度相同)。

这是我的预期结果:

$'112.2012'
     [,1] [,2] [,3] [,4]
[1,]  174  191   31    4
[2,]    0  450    0    0
[3,]   11  188   49    1
[4,]   14  171   20    5

$'111.2012'
     [,1] [,2] [,3] [,4]
[1,]   45   14    0    1
[2,]    8  670    0    2
[3,]  190  157   44   59
[4,]   57   59    6   38

我真的很欣赏你的想法。

Answer 1

您可以使用 mapply ，这是 lapply 的一种多元版本，对于这个任务

fun <- function(Z, p) {
  imp <- as.vector(cbind(imp=rowSums(Z)))
  exp <- as.vector(t(cbind(exp=colSums(Z))))
  x = p + imp
  ac = p + imp - exp  
  einsdurchx = 1/as.vector(x)    
  einsdurchx[is.infinite(einsdurchx)] <- 0
  A = Z %*% diag(einsdurchx)
  R = solve(diag(length(p))-A) %*% diag(p)
  C = ac * einsdurchx
  R_bar = diag(as.vector(C)) %*% R
  rR_bar = round(R_bar)
  return(rR_bar)
}

Z <- list("111.2012"= matrix(c(0,0,100,200,0,0,0,0,50,350,0,50,50,200,200,0),
                             nrow = 4, ncol = 4, byrow = T),
           "112.2012"= matrix(c(10,90,0,30,10,90,0,10,200,50,10,350,150,100,200,10),
                              nrow = 4, ncol = 4, byrow = T))
p <- list("111.2012"=c(200, 1000, 100, 10),
          "112.2012"=c(300, 900, 50, 100))


mapply(fun, Z, p, SIMPLIFY = FALSE)
## $`111.2012`
##      [,1] [,2] [,3] [,4]
## [1,]  174  191   31    4
## [2,]    0  450    0    0
## [3,]   11  188   49    1
## [4,]   14  171   20    5

## $`112.2012`
##      [,1] [,2] [,3] [,4]
## [1,]   45   14    0    1
## [2,]    8  670    0    2
## [3,]  190  157   44   59
## [4,]   57   59    6   38