4

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.

Community
  • 1
  • 1
N.Varela
  • 910
  • 1
  • 11
  • 25
  • Do an `lapply` on the index: `lapply(1:min(length(v1), length(v2)), function(i) { v1[i] + v2[i] })` – sdgfsdh Nov 02 '15 at 10:05
  • I am not sure if this is what you mean I should do: `lapply(1:min(length(Z), length(p)), function(i) { imp[i] <- as.vector(cbind(imp=rowSums(Z[i]))) exp[i] <- as.vector(t(cbind(exp=colSums(Z[i])))) x[i] = p[i] + imp[i] ac[i] = p[i] + imp[i] - exp[i] einsdurchx[i] = 1/as.vector(x[i]) einsdurchx[i][is.infinite(einsdurchx[i])] <- 0 A[i] = Z[i] %*% diag(einsdurchx[i]) R[i] = solve(diag(length(p[i]))-A[i]) %*% diag(p[i]) C[i] = ac[i] * einsdurchx[i] R_bar[i] = diag(as.vector(C[i])) %*% R[i] rR_bar[i] = round(R_bar[i]) return(rR_bar[i]) } )` However, I still get error – N.Varela Nov 02 '15 at 10:15

1 Answers1

6

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
dickoa
  • 18,217
  • 3
  • 36
  • 50
  • 1
    Why not just `Map(fun, Z, p)`? – David Arenburg Nov 02 '15 at 10:24
  • 1
    @DavidArenburg You are right since `Map` is a shortcut for `mapply(..., simplify = FALSE)` but I think it's easier to remember `mapply` because of `*apply` idiom in R – dickoa Nov 02 '15 at 10:30
  • thanks, thats great. I didn't really understood before the use of mapply. :) – N.Varela Nov 02 '15 at 10:34
  • sorry, but I still have one problem with my original data: running the code as in your answer I get the error: `Error in solve.default(diag(length(p)) - A) : Lapack routine dgesv: system is exactly singular: U[205,205] = 0`, which is caused in this line `R = solve(diag(length(p))-A) %*% diag(p)`. Changing `length(p)` into `length(p[[i]])`does not help and also setting the absolute value of 206 (which is the number needed here, as length of every p object is 206, and is same as col/rows in the matrices of Z). Any ideas? – N.Varela Nov 02 '15 at 11:00
  • @N.Varela Without the data it will be difficult to tell but looks like a problem of non-invertible matrix. This is another problem so maybe you should ask another question and provide enough data to reproduce the error. – dickoa Nov 02 '15 at 11:17