有效地对R中的列进行有条件分类的方法？

Question

我正在尝试将数据框分类。类似于您需要的维恩图，但是我想以某种方式“ grepl”采样列标题。意思是，只要共享模式并且满足数字阈值，就可以将其分类为所述类别。

示例数据：

df <- data.frame(a_b_c = c(1,3,5,0,0), a_b=c(0,0,4,0,0), a_b_c_d=c(1,2,2,3,0),
                 b_d=c(0,0,3,2,3), a_c = c(1,5,1,0,0))
df

>  a_b_c a_b a_b_c_d b_d a_c    
>     1   0       1   0   1     
>     3   0       2   0   5     
>     5   4       2   3   1   
>     0   0       3   2   0   
>     0   0       0   3   0 

所需的输出

df_final <- data.frame(df, category = c("Other", "Shared c", "Shared all", "Shared d", "Appears once"))

df_final

>  a_b_c a_b a_b_c_d b_d a_c     category
>     1   0       1   0   1        Other
>     3   0       2   0   5     Shared c
>     5   4       2   3   1   Shared all
>     0   0       3   2   0     Shared d
>     0   0       0   3   0 Appears once

我以为它涉及到带有case_when()和/或ifelse()语句的整洁的mutate语句，但是我无法正确理解逻辑。这是一个示例测试数据集，我的实际数据有> 20列。因此，这就是为什么我想使用通配符对列标题进行分类。

接受所有建议。

Answer 1

我建议使用“枢轴”，case_when和“联接”来获得您的结果。

library(dplyr)
# library(tidyr) # pivot_longer

df <- data.frame(a_b_c = c(1,3,5,0,0), a_b=c(0,0,4,0,0), a_b_c_d=c(1,2,2,3,0),
                 b_d=c(0,0,3,2,3), a_c = c(1,5,1,0,0)) %>%
  mutate(row = row_number())

df %>%
  tidyr::pivot_longer(-row) %>%
  group_by(row) %>%
  summarize(
    category = case_when(
      all(value > 0)                     ~ "Shared all",
      sum(value > 0) == 1L               ~ "Appears once",
      all(!grepl("c", name) | value > 0) ~ "Shared c",
      all(!grepl("d", name) | value > 0) ~ "Shared d",
      TRUE                               ~ "Other"
    )
  ) %>%
  left_join(df, ., by = "row")
#   a_b_c a_b a_b_c_d b_d a_c row     category
# 1     1   0       1   0   1   1     Shared c
# 2     3   0       2   0   5   2     Shared c
# 3     5   4       2   3   1   3   Shared all
# 4     0   0       3   2   0   4     Shared d
# 5     0   0       0   3   0   5 Appears Once

我必须添加row列，以确保该类别将与原始行配对，因为否则这些行将不会被唯一标识（除非通过完全唯一性，否则我将不会依靠）。我pivot的使用是为了避免我们不依赖于特定的列名或仅存在五个列（这对于3和300来说同样适用，给出或采用您的逻辑规则。最后，!grepl(...) | value>0的使用是特定的反转以确保所有c-包括（和d）名称的值都大于0；它易于扩展，尽管根据您的实际用例，您可能需要更强的正则表达式（例如，单词边界）。

Answer 2

在base R中，我们可以基于逻辑创建一个数字索引，然后将该索引用作位置索引以更改值

i1 <- apply(df > 0, 1, function(x) {
      x1 <- x[x]
       c1 <- all(grepl('c', names(x1)))
       d1 <- all(grepl('d', names(x1)))
       all(x) + 2 * c1 + 4 * d1 +  8 * (length(x1) == 1)})
df$category <- c('Shared all', 'Shared c', 'Shared d',
            'Appears once', 'other')[as.integer(factor(i1))]
df$category
#[1] "Shared c"     "Shared c"     "Shared all"   "Shared d"     "Appears once"