R: Reducing an array according to a selector

Question

Suppose you have a 3-dimensional 4x4x2 array:

foo <- structure(c(1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1), .Dim = c(4L, 4L, 2L), .Dimnames = list(c("p1", "p2", "p3", "p4"), c("f1", "f2", "f3", "f4"), c("t1", "t2")))
foo

, , t1

   f1 f2 f3 f4
p1  1  1  0  0
p2  0  1  0  0
p3  0  0  0  0
p4  0  0  0  0

, , t2

   f1 f2 f3 f4
p1  0  0  0  0
p2  0  1  0  0
p3  0  1  1  1
p4  0  0  0  1

In addition, you have a matrix which is a selector for the 1st dimension (p):

bar <- structure(c(1, 1, 2, 2), .Dim = c(4L, 1L), .Dimnames = list(c("p1", "p2", "p3", "p4"), NULL))       [,1]
bar
p1    1
p2    1
p3    2
p4    2

How can I create the two following arrays?

Array 1 has rows p1 and p2 (as selected by bar) and columns f1 and f2 (because p1 and p2 are not related to f3 and f4 in either t1 or t2):

, , t1

   f1 f2
p1  1  1
p2  0  1

, , t2

   f1 f2
p1  0  0
p2  0  1

Array 2 has rows p3 and p4 (again as selected by bar) and columns f2, f3, and f4 (because p3 and p4 are not related to f1 in either t1 or t2). In addition, the third dimension is reduced to t2:

, , t2

   f2 f3 f4
p3  1  1  1
p4  0  0  1

I'm thinking along the lines of subset(), apply(), and which(), but this hasn't gotten me anywhere.

This is a toy example. The final code is supposed to be applied to matrices resembling 2-mode networks (modes p and f) over time (t).

Any help is warmly appreciated.

Answer 1

like this?

lapply(unique(bar),function(x){
  flip<-Reduce('+',lapply(dimnames(foo)[[3]],function(z){
    t(foo[names(bar[bar==x]),,z])
  }
         ))
  n<-dimnames(flip[rowSums(flip)!=0,])
  foo[n[[2]],n[[1]],]
}
       )

[[1]]
, , t1

   f1 f2
p1  1  1
p2  0  1

, , t2

   f1 f2
p1  0  0
p2  0  1


[[2]]
, , t1

   f2 f3 f4
p3  0  0  0
p4  0  0  0

, , t2

   f2 f3 f4
p3  1  1  1
p4  0  0  1

Answer 2

Here is another option:

lapply(unique(bar), function(i) {
  foo.row <- foo[rownames(foo) %in% rownames(bar)[bar == i],,]
  foo.row[, apply(foo.row, 2, any), apply(foo.row, 3, any), drop=F]
} )

Produces:

[[1]]
, , t1

   f1 f2
p1  1  1
p2  0  1

, , t2

   f1 f2
p1  0  0
p2  0  1


[[2]]
, , t2

   f2 f3 f4
p3  1  1  1
p4  0  0  1

You can ignore the warnings. They are just any coercing values to logical. If they bother you you can always do something like function(x) any(as.logical(x)).