根据唯一值过滤整个数据框并在 R 中创建一个新列答案

【问题标题】：filtering entire data frame based on a unique value and create a new column in R根据唯一值过滤整个数据框并在 R 中创建一个新列
【发布时间】：2019-01-20 13:47:38
【问题描述】：

我已经尝试解决了几个小时，但我似乎无法获得我正在寻找的解决方案。如何在 R 中过滤数据框以获取某个唯一值，然后使用满足该条件的列名创建一个新列？

我有这个数据框：

 dput(head(df1,10))
structure(list(WMA = c("20", "19", "19", "19", "18", "19", "20", 
"20", "20", "19"), Waterbody = c("02040201070010-01", "02040202060040-01", 
"02040202060050-01", "02040202060060-01", "02040202150070-01", 
"02040202030080-01", "02040201080010-01", "02040201080020-01", 
"02040201080030-01", "02040202070010-01"), Name = c("Back Creek (above Yardville-H Sq Road)", 
"Barton Run (above Kettle Run Road)", "Barton Run (below Kettle Run Road)", 
"Bear Swamp River", "Birch Creek", "Bisphams Mill Creek (below McDonalds Br)", 
"Blacks Creek (above 40d06m10s)", "Blacks Creek (Bacons Run to 40d06m10s)", 
"Blacks Creek (below Bacons Run)", "Bobbys Run"), DO = c("Insufficient Data", 
"Non-attaining", "Non-attaining", "Insufficient Data", "Attaining", 
"Attaining", "Attaining", "Attaining", "Attaining", "Insufficient Data"
), `DO Trout` = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", 
"N/A", "N/A", "N/A"), pH = c("Insufficient Data", "Non-attaining", 
"Non-attaining", "Insufficient Data", "Attaining", "Attaining", 
"Attaining", "Attaining", "Attaining", "Insufficient Data"), 
    `Total Phosphorus` = c("Non-attaining", "Attaining", "Non-attaining", 
    "Insufficient Data", "Insufficient Data", "Non-attaining", 
    "Non-attaining", "Non-attaining", "Non-attaining", "Insufficient Data"
    ), Nitrate = c("Attaining", "Attaining", "Attaining", "Insufficient Data", 
    "Insufficient Data", "Attaining", "Attaining", "Attaining", 
    "Attaining", "Insufficient Data"), `Total Suspended Solids` = c("Attaining", 
    "Attaining", "Attaining", "Insufficient Data", "Insufficient Data", 
    "Insufficient Data", "Attaining", "Attaining", "Non-attaining", 
    "Insufficient Data"), `Total Dissolved Solids` = c("Insufficient Data", 
    "Attaining", "Attaining", "Insufficient Data", "Insufficient Data", 
    "Insufficient Data", "Attaining", "Attaining", "Attaining", 
    "Insufficient Data"), Turbidity = c("Insufficient Data", 
    "Attaining", "Attaining", "Insufficient Data", "Attaining", 
    "Insufficient Data", "Attaining", "Attaining", "Attaining", 
    "Insufficient Data"), `Unionized Ammonia` = c("Attaining", 
    "Attaining", "Attaining", "Insufficient Data", "Attaining", 
    "Insufficient Data", "Attaining", "Attaining", "Attaining", 
    "Insufficient Data"), `Unionized Ammonia Trout` = c("N/A", 
    "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A"
    ), E.coli = c("Insufficient Data", "Attaining", "Attaining", 
    "Attaining", "Attaining", "Attaining", "Attaining", "Non-attaining", 
    "Non-attaining", "Attaining"), Enterococcus = c("N/A", "N/A", 
    "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A"), 
    `Total Coliform` = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", 
    "N/A", "N/A", "N/A", "N/A")), .Names = c("WMA", "Waterbody", 
"Name", "DO", "DO Trout", "pH", "Total Phosphorus", "Nitrate", 
"Total Suspended Solids", "Total Dissolved Solids", "Turbidity", 
"Unionized Ammonia", "Unionized Ammonia Trout", "E.coli", "Enterococcus", 
"Total Coliform"), row.names = c(NA, -10L), class = c("tbl_df", 
"tbl", "data.frame"))

我想对每一列执行筛选，以查看哪些列具有唯一值“未达到”。然后，我想根据该列创建一个新列，该列显示符合此条件的列名。

这是我想要的电子表格：

我尝试使用 dplyr 动词，但没有取得任何成功。任何帮助或指导表示赞赏。提前致谢！

【问题讨论】：

您能否确保显示与您的预期结果相对应的图像？
@Ozan147 对不起。修好了！

标签： r dataframe dplyr filtering

【解决方案1】：

您可以使用which(cond, arr.ind=TRUE)。以下是使用 data.table 的方法：

library(data.table)
DT = as.data.table(df1)

w = as.data.table(which(DT == "Non-attaining", arr.ind = TRUE))[, .(cols = toString(names(DT)[col])), by=row]

DT[w$row, NAcols := w$cols]

这给了...

>     DT[, c(1, 17)]
    WMA                                           NAcols
 1:  20                                 Total Phosphorus
 2:  19                                           DO, pH
 3:  19                         DO, pH, Total Phosphorus
 4:  19                                             <NA>
 5:  18                                             <NA>
 6:  19                                 Total Phosphorus
 7:  20                                 Total Phosphorus
 8:  20                         Total Phosphorus, E.coli
 9:  20 Total Phosphorus, Total Suspended Solids, E.coli
10:  19                                             <NA>

【讨论】：

谢谢！我还想保留 WMA、Waterbody 和 Name 列……这可能吗？
@KWANGER 是的，您可以选择带有数字或名称向量的列，例如 DT[, c("WMA", "Waterbody", "Name", "NAcols")]（我只打印了 1 和 17，因为表格太大了）

【解决方案2】：

您可以像这样应用自定义函数：

myfun <- function(x) {
    paste(colnames(df)[x == "Non-attaining"], collapse=", ")
}

df$newcol <- apply(df, 1, myfun)

或者一举搞定：

df$newcol <- apply(df, 1, function(x) paste(colnames(df)[x == "Non-attaining"], collapse=", "))

【讨论】：

对我来说适用于您的示例数据。检查您是否在“未达到”（大写很重要）中没有拼写错误。另请注意，我已将您的数据命名为 df。将df 更改为您所称的数据框。
数据框被应用强制转换为矩阵，所以你的转换不是必要的，除非你想故意让它显式
谢谢——我会简化我的回答。太糟糕了，帮助文件从不列出此类信息，我们只能自行整理。但你是对的，apply 的源代码在顶部有 as.matrix :)

【解决方案3】：

如果您想要一个 tidyverse 解决方案，您可以：

library(dplyr)
library(tidyr)
df1 %>% 
  select(WMA, Waterbody, Name) %>% 
  left_join(df1 %>% 
              gather(ColName, Value, -WMA, -Waterbody, -Name) %>% 
              filter(grepl("Non-attaining", Value, ignore.case = TRUE, perl = TRUE)) %>% 
              group_by(WMA, Waterbody, Name) %>% 
              summarise(Imp = paste(ColName, collapse = ',')) %>% 
              ungroup(), by = c("WMA", "Waterbody", "Name"))

这给出了：

# A tibble: 10 x 4
   WMA   Waterbody         Name                                     Imp                                           
   <chr> <chr>             <chr>                                    <chr>                                         
 1 20    02040201070010-01 Back Creek (above Yardville-H Sq Road)   Total Phosphorus                              
 2 19    02040202060040-01 Barton Run (above Kettle Run Road)       DO,pH                                         
 3 19    02040202060050-01 Barton Run (below Kettle Run Road)       DO,pH,Total Phosphorus                        
 4 19    02040202060060-01 Bear Swamp River                         NA                                            
 5 18    02040202150070-01 Birch Creek                              NA                                            
 6 19    02040202030080-01 Bisphams Mill Creek (below McDonalds Br) Total Phosphorus                              
 7 20    02040201080010-01 Blacks Creek (above 40d06m10s)           Total Phosphorus                              
 8 20    02040201080020-01 Blacks Creek (Bacons Run to 40d06m10s)   Total Phosphorus,E.coli                       
 9 20    02040201080030-01 Blacks Creek (below Bacons Run)          Total Phosphorus,Total Suspended Solids,E.coli
10 19    02040202070010-01 Bobbys Run                               NA

【讨论】：

【解决方案4】：

这里还有一个不涉及重塑数据的tidyverse 解决方案。相反，我们可以使用 pmap 映射数据帧的行，然后折叠生成的字符向量。

library(tidyverse)
tbl <- structure(list(WMA = c("20", "19", "19", "19", "18", "19", "20", "20", "20", "19"), Waterbody = c("02040201070010-01", "02040202060040-01", "02040202060050-01", "02040202060060-01", "02040202150070-01", "02040202030080-01", "02040201080010-01", "02040201080020-01", "02040201080030-01", "02040202070010-01"), Name = c("Back Creek (above Yardville-H Sq Road)", "Barton Run (above Kettle Run Road)", "Barton Run (below Kettle Run Road)", "Bear Swamp River", "Birch Creek", "Bisphams Mill Creek (below McDonalds Br)", "Blacks Creek (above 40d06m10s)", "Blacks Creek (Bacons Run to 40d06m10s)", "Blacks Creek (below Bacons Run)", "Bobbys Run"), DO = c("Insufficient Data", "Non-attaining", "Non-attaining", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Attaining", "Attaining", "Insufficient Data"), `DO Trout` = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A"), pH = c("Insufficient Data", "Non-attaining", "Non-attaining", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Attaining", "Attaining", "Insufficient Data"), `Total Phosphorus` = c("Non-attaining", "Attaining", "Non-attaining", "Insufficient Data", "Insufficient Data", "Non-attaining", "Non-attaining", "Non-attaining", "Non-attaining", "Insufficient Data"), Nitrate = c("Attaining", "Attaining", "Attaining", "Insufficient Data", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Attaining", "Insufficient Data"), `Total Suspended Solids` = c("Attaining", "Attaining", "Attaining", "Insufficient Data", "Insufficient Data", "Insufficient Data", "Attaining", "Attaining", "Non-attaining", "Insufficient Data"), `Total Dissolved Solids` = c("Insufficient Data", "Attaining", "Attaining", "Insufficient Data", "Insufficient Data", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Insufficient Data"), Turbidity = c("Insufficient Data", "Attaining", "Attaining", "Insufficient Data", "Attaining", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Insufficient Data"), `Unionized Ammonia` = c("Attaining", "Attaining", "Attaining", "Insufficient Data", "Attaining", "Insufficient Data", "Attaining", "Attaining", "Attaining", "Insufficient Data"), `Unionized Ammonia Trout` = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A"), E.coli = c("Insufficient Data", "Attaining", "Attaining", "Attaining", "Attaining", "Attaining", "Attaining", "Non-attaining", "Non-attaining", "Attaining"), Enterococcus = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A"), `Total Coliform` = c("N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A", "N/A")), .Names = c("WMA", "Waterbody", "Name", "DO", "DO Trout", "pH", "Total Phosphorus", "Nitrate", "Total Suspended Solids", "Total Dissolved Solids", "Turbidity", "Unionized Ammonia", "Unionized Ammonia Trout", "E.coli", "Enterococcus", "Total Coliform"), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))

with_imp <- tbl %>%
  mutate(
    Imp = pmap(., function(...) names(list(...))[which(c(...) == "Non-attaining")]),
    Imp = Imp %>%
      map(str_c, collapse = ",") %>%
      map_if(~ length(.) == 0, ~ NA_character_) %>%
      flatten_chr
    )
with_imp[, c(1:3, 17)]
#> # A tibble: 10 x 4
#>    WMA   Waterbody      Name                    Imp                       
#>    <chr> <chr>          <chr>                   <chr>                     
#>  1 20    0204020107001~ Back Creek (above Yard~ Total Phosphorus          
#>  2 19    0204020206004~ Barton Run (above Kett~ DO,pH                     
#>  3 19    0204020206005~ Barton Run (below Kett~ DO,pH,Total Phosphorus    
#>  4 19    0204020206006~ Bear Swamp River        <NA>                      
#>  5 18    0204020215007~ Birch Creek             <NA>                      
#>  6 19    0204020203008~ Bisphams Mill Creek (b~ Total Phosphorus          
#>  7 20    0204020108001~ Blacks Creek (above 40~ Total Phosphorus          
#>  8 20    0204020108002~ Blacks Creek (Bacons R~ Total Phosphorus,E.coli   
#>  9 20    0204020108003~ Blacks Creek (below Ba~ Total Phosphorus,Total Su~
#> 10 19    0204020207001~ Bobbys Run              <NA>

由reprex package (v0.2.0) 于 2018 年 8 月 13 日创建。

【讨论】：