根据多个条件对数据框进行子集化

Question

我有以下数据框（我的真实数据框有更多的行和列，但表面上是这样构造的）：

Root_R1 = c(1,2,3,4,5)
Root_R2 = c(1,0,3,0,0)
Root_R3 = c(1,0,3,0,0)
Shoot_R1 = c(1,0,3,4,5)
Shoot_R2 = c(0,0,31,4,5)
Shoot_R3 = c(0,0,0,0,0)
data.frame(Root_R1, Root_R2, Root_R3, Shoot_R1, Shoot_R2, Shoot_R3)

Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
1    Root    Root    Root    Shoot    Shoot    Shoot
2       1       1       1        1        0        0
3       2       0       0        0        0        0
4       3       3       3        3       31        0
5       4       0       0        4        4        0
6       5       0       0        5        5        0

我想要做的是过滤此数据框并找到与组织类型（根、芽等）关联的至少两列的值大于 0 的所有行。因此，对于与“Roots”（第 1、2、3 列）关联的列，应返回第 1 - 3 行，而与“Shoots”关联的列将返回第 4 - 6 行。我认为ifelse 代码会起作用，但这似乎效率低下。来自dplyr 的filter 会更合适吗？

Answer 1

这是一个基本的 R 解决方案。 grep 告诉 "Root" 列来自 "Shoot" 列。然后apply 循环返回逻辑（行）索引，which 负责对 data.frame 进行子设置。

Root_R1 = c("Root",1,2,3,4,5)
Root_R2 = c("Root",1,0,3,0,0)
Root_R3 = c("Root",1,0,3,0,0)
Shoot_R1 = c("Shoot",1,0,3,4,5)
Shoot_R2 = c("Shoot",0,0,31,4,5)
Shoot_R3 = c("Shoot",0,0,0,0,0)
df1 <- data.frame(Root_R1, Root_R2, Root_R3, Shoot_R1, Shoot_R2, Shoot_R3)

df1 <- df1[-1,]
df1[] <- lapply(df1, as.integer)

root <- grep("Root", names(df1))
shoot <- grep("Shoot", names(df1))
ok_root <- which(apply(df1[root], 1, \(x) sum(x > 0L) >= 2L))
ok_shoot <- which(apply(df1[shoot], 1, \(x) sum(x > 0L) >= 2L))

df1[ok_root, ]
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 2       1       1       1        1        0        0
#> 4       3       3       3        3       31        0
df1[ok_shoot, ]
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 4       3       3       3        3       31        0
#> 5       4       0       0        4        4        0
#> 6       5       0       0        5        5        0

^{由reprex package (v2.0.1) 于 2022-06-09 创建}

---

编辑

关注question in comments

假设我想更改截止的数值，我会更改这部分代码 (sum(x > 0L))，如果我想更改符合截止的行数，我会改变这个：>= 2L?

这是一个解决问题的函数。

special_subset <- function(x, colpattern, cutoff = 0L, numrows = 2L) {
  i_cols <- grep(colpattern, names(x))
  ok <- which(apply(x[i_cols], 1, \(y) sum(y > cutoff) >= numrows))
  x[ok, ]
}

special_subset(df1, "Root")
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 2       1       1       1        1        0        0
#> 4       3       3       3        3       31        0

special_subset(df1, "Shoot", cutoff = 1)
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 4       3       3       3        3       31        0
#> 5       4       0       0        4        4        0
#> 6       5       0       0        5        5        0

^{由reprex package (v2.0.1) 于 2022-06-09 创建}

---

编辑 2

要将多个colpattern 传递给函数，请检查其参数长度，如果它大于一个，则将其折叠成具有替代项的模式（"|" 元字符）。

special_subset <- function(x, colpattern, cutoff = 0L, numrows = 2L) {
  if(length(colpattern) > 1) {
    colpattern <- paste(colpattern, collapse = "|")
  }
  i_cols <- grep(colpattern, names(x))
  ok <- which(apply(x[i_cols], 1, \(y) sum(y > cutoff) >= numrows))
  x[ok, ]
}

special_subset(df1, c("Root", "Shoot"))
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 2       1       1       1        1        0        0
#> 4       3       3       3        3       31        0
#> 5       4       0       0        4        4        0
#> 6       5       0       0        5        5        0

tissue_type <- c("Root", "Shoot")
special_subset(df1, tissue_type)
#>   Root_R1 Root_R2 Root_R3 Shoot_R1 Shoot_R2 Shoot_R3
#> 2       1       1       1        1        0        0
#> 4       3       3       3        3       31        0
#> 5       4       0       0        4        4        0
#> 6       5       0       0        5        5        0

^{由reprex package (v2.0.1) 于 2022-06-17 创建}