R: How to run function on two lists?

问题

I want to run the following function on two lists:

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)
}

which works fine on a matrix and a vector. However, I need to run this function on a list of matrices and a list of vectors. I tried so far lapply/mapply following this example, see below. Here some example data showing the structure of my data:

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

Here the lapply code I tried (I changed all Z and p in the function for X and Y, don't know if needed):

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)
} )

I seems that I have a problem indexing the the objects of the list, but I am relatively new with lists. Do you have any ideas what I'm doing wrong? Further the objects (of Z and p) need to be matched by name, as I have more than 1000 objects in the lists (Info: both lists have the same object/item length, and rows/cols of the matrices in Z have the same length as the vectors in p).

Here my expected result:

$'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

I really appreciate your ideas.

回答1:

You can use mapply , which is kind of multivariate version of lapply, for this task

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

来源：https://stackoverflow.com/questions/33475029/r-how-to-run-function-on-two-lists

标签

list

function

lapply