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

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告诉"Shoot"列中的"Root"列。 然后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 包(v2.0.1) 创建于 2022-06-09}

---

编辑

在评论中提出问题

假设我想更改截止的数值，我会更改这部分代码（ 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 包(v2.0.1) 创建于 2022-06-09}

---

编辑 2

要将多个colpattern给上述函数，请使用lapply循环。

在下面的两个例子中，首先我使用 R 4.2.0 中引入的新管道运算符，第二个是标准lapply 。

tissue_type <- c("Root", "Shoot")

tissue_type |>
  lapply(\(pat, data) special_subset(data, pat), data = df1)
#> [[1]]
#>   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
#> 
#> [[2]]
#>   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

lapply(tissue_type, \(pat, data) special_subset(data, pat), data = df1)
#> [[1]]
#>   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
#> 
#> [[2]]
#>   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 包于 2022-06-17 创建 (v2.0.1)}