R：根据选择器减少数组

Question

假设您有一个 3 维 4x4x2 数组：

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

此外，您还有一个矩阵，它是第一维 (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

如何创建以下两个数组？

数组 1 有 p1 和 p2 行（由 bar 选择）以及 f1 和 f2 列（因为 p1 和 p2 在 t1 或 t2 中都与 f3 和 f4 无关）：

, , t1

   f1 f2
p1  1  1
p2  0  1

, , t2

   f1 f2
p1  0  0
p2  0  1

数组 2 有 p3 和 p4 行（同样由 bar 选择）和 f2、f3 和 f4 列（因为 p3 和 p4 在 t1 或 t2 中都与 f1 无关）。另外，第三维降为t2：

, , t2

   f2 f3 f4
p3  1  1  1
p4  0  0  1

我正在按照子集（）、应用（）和哪个（）的思路思考，但这并没有让我得到任何结果。

这是一个玩具示例。最终代码应该应用于类似于 2 模式网络（模式 p 和 f）随时间 (t) 变化的矩阵。

非常感谢任何帮助。

Answer 1

喜欢这样吗？

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

这是另一种选择：

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

生产：

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

您可以忽略警告。它们只是 any 将值强制为逻辑值。如果他们打扰您，您可以随时执行function(x) any(as.logical(x)) 之类的操作。