如何使用 tidyr::unite 函数删除 NA？

Question

在将几列与 tidyr::unite() 组合后，来自缺失数据的 NA 仍保留在我的字符向量中，这是我不想要的。

我每行（每列 1 个）有一系列医疗诊断，并希望对一系列代码进行基准搜索通过。%in% 和 grepl()。

Github 上有一个关于这个问题的未解决问题，是否有任何动作或解决方法？我想保持向量用逗号分隔。

这是一个有代表性的例子：

library(dplyr)
library(tidyr)

df <- data_frame(a = paste0("A.", rep(1, 3)), b = " ", c = c("C.1", "C.3", " "), d = "D.4", e = "E.5")

cols <- letters[2:4]
df[, cols] <- gsub(" ", NA_character_, as.matrix(df[, cols]))
tidyr::unite(df, new, cols, sep = ",")

当前输出：

# # A tibble: 3 x 3
#   a     new        e    
#   <chr> <chr>      <chr>
# 1 A.1   NA,C.1,D.4 E.5  
# 2 A.1   NA,C.3,D.4 E.5  
# 3 A.1   NA,NA,D.4  E.5 

期望的输出：

# # A tibble: 3 x 3
#   a     new        e    
#   <chr> <chr>      <chr>
# 1 A.1   C.1,D.4    E.5  
# 2 A.1   C.3,D.4    E.5  
# 3 A.1   D.4        E.5 

Answer 1

您可以在创建 NA 后使用正则表达式删除它们：

library(dplyr)
library(tidyr)

df <- data_frame(a = paste0("A.", rep(1, 3)), 
                 b = " ", 
                 c = c("C.1", "C.3", " "), 
                 d = "D.4", e = "E.5")

cols <- letters[2:4]
df[, cols] <- gsub(" ", NA_character_, as.matrix(df[, cols]))
tidyr::unite(df, new, cols, sep = ",") %>% 
     dplyr::mutate(new = stringr::str_replace_all(new, 'NA,?', ''))  # New line

输出：

# A tibble: 3 x 3
  a     new     e    
  <chr> <chr>   <chr>
1 A.1   C.1,D.4 E.5  
2 A.1   C.3,D.4 E.5  
3 A.1   D.4     E.5  

Answer 2

如果在使用联合函数时删除它们，可能会出现一些错误。我会在事后将它们从列中删除。

df <- data_frame(a = paste0("A.", rep(1, 3)), b = " ", c = c("C.1", "C.3", " "), d = "D.4", e = "E.5")

cols <- letters[2:4]
df[, cols] <- gsub(" ", NA_character_, as.matrix(df[, cols]))
df <- tidyr::unite(df, new, cols, sep = ",")

df$new <- gsub("NA,","",df$new)

Answer 3

您可以通过遍历行来避免插入它们：

library(tidyverse)

df <- data_frame(
    a = c("A.1", "A.1", "A.1"),
    b = c(NA_character_, NA_character_, NA_character_),
    c = c("C.1", "C.3", NA),
    d = c("D.4", "D.4", "D.4"),
    e = c("E.5", "E.5", "E.5")
)

cols <- letters[2:4]

df %>% mutate(x = pmap_chr(.[cols], ~paste(na.omit(c(...)), collapse = ',')))
#> # A tibble: 3 x 6
#>   a     b     c     d     e     x      
#>   <chr> <chr> <chr> <chr> <chr> <chr>  
#> 1 A.1   <NA>  C.1   D.4   E.5   C.1,D.4
#> 2 A.1   <NA>  C.3   D.4   E.5   C.3,D.4
#> 3 A.1   <NA>  <NA>  D.4   E.5   D.4

或者使用tidyr的底层stringi包，

df %>% mutate(x = pmap_chr(.[cols], ~stringi::stri_flatten(
    c(...), collapse = ",", 
    na_empty = TRUE, omit_empty = TRUE
)))
#> # A tibble: 3 x 6
#>   a     b     c     d     e     x      
#>   <chr> <chr> <chr> <chr> <chr> <chr>  
#> 1 A.1   <NA>  C.1   D.4   E.5   C.1,D.4
#> 2 A.1   <NA>  C.3   D.4   E.5   C.3,D.4
#> 3 A.1   <NA>  <NA>  D.4   E.5   D.4

问题在于，对行进行迭代通常需要进行 很多 次调用，因此在规模上可能会非常缓慢。不幸的是，似乎没有一个很好的矢量化替代方法可以在加入字符串之前删除NAs。

Answer 4

谢谢大家，我已经汇总了解决方案并根据我的数据进行了基准测试：

library(microbenchmark)
library(dplyr)
library(stringr)
library(tidyr)
library(biometrics) # has my helper function for column selection

cols <- biometrics::variables(c("diagnosis", "dagger", "ediag"), 20) 
system.time({
  df <- dat[, cols]
  df <- gsub(" ", NA_character_, as.matrix(df)) %>% tbl_df()
})

microbenchmark(
  ## search by base R `match()` function
  match_spaces = apply(dat, 1, function(x) any(c("A37.0","A37.1","A37.8","A37.9") %in% x[cols])), # original search (match)

  match_NAs = apply(df, 1, function(x) any(c("A37.0","A37.1","A37.8","A37.9") %in% x[cols])), # matching with " " replaced by NAs with gsub 

  ## search by base R 'grep()' function - the same regex is used in each case
  regex_str_replace_all = tidyr::unite(df, new, cols, sep = ",") %>% # grepl search with NAs removed with `stringr::str_replace_all()`
    mutate(new = str_replace_all(new, "NA,?", "")) %>%
    apply(1, function(x) grepl("A37.*", x, ignore.case = T)),

  regex_toString = tidyr::unite(df, new, cols, sep = ",") %>%  # grepl search with NAs removed with `apply()` & `toString()`
    mutate(new = apply(df[cols], 1, function(x) toString(na.omit(x)))) %>%
    apply(1, function(x) grepl("A37.*", x, ignore.case = T)),

  regex_row_iteration = df %>% # grepl search after iterating over rows (using syntax I'm not familiar with and need to learn!)
    mutate(new = pmap_chr(.[cols], ~paste(na.omit(c(...)), collapse = ','))) %>%
    select(new) %>%
    apply(1, function(x) grepl("A37.*", x, ignore.case = T)),

  regex_stringi = df %>% mutate(new = pmap_chr(.[cols], ~stringi::stri_flatten( # grepl after stringi
    c(...), collapse = ",", 
    na_empty = TRUE, omit_empty = TRUE
  ))) %>%
    select(new) %>%
    apply(1, function(x) grepl("A37.*", x, ignore.case = T)),

  times = 10L
)

# Unit: milliseconds
#                   expr        min        lq      mean    median        uq       max neval
#           match_spaces 14820.2076 15060.045 15558.092 15573.885 15901.015 16521.855    10
#              match_NAs   998.3184  1061.973  1191.691  1203.849  1301.511  1378.314    10
#  regex_str_replace_all  1464.4502  1487.473  1637.832  1596.522  1701.718  2114.055    10
#         regex_toString  4324.0914  4341.725  4631.998  4487.373  4977.603  5439.026    10
#    regex_row_iteration  5794.5994  6107.475  6458.339  6436.273  6720.185  7256.980    10
#          regex_stringi  4772.3859  5267.456  5466.510  5436.804  5806.272  6011.713    10

看起来%in% 是赢家 - 在用 NA 替换空值 (" ") 之后。如果我使用正则表达式，那么使用 stringr::string_replace_all() 删除 NA 是最快的。

Answer 5

在新的 tidyr 中，您现在可以使用 na.rm 参数删除 NA 值。

library(tidyr)
library(dplyr)

df %>% unite(new, cols, sep = ",", na.rm = TRUE)

#   a     new     e    
#  <chr> <chr>   <chr>
#1 A.1   C.1,D.4 E.5  
#2 A.1   C.3,D.4 E.5  
#3 A.1   D.4     E.5  

但是，如果列是因子，NAs 将不会被删除。在使用unite 之前，我们需要将它们更改为字符。

df %>% 
  mutate_all(as.character) %>%
  unite(new, cols, sep = ",", na.rm = TRUE)

---

您也可以使用基本 R apply 方法。

apply(df[cols], 1, function(x) toString(na.omit(x)))
#[1] "C.1, D.4" "C.3, D.4" "D.4" 

数据

df <- data_frame(
a = c("A.1", "A.1", "A.1"),
b = c(NA_character_, NA_character_, NA_character_),
c = c("C.1", "C.3", NA),
d = c("D.4", "D.4", "D.4"),
e = c("E.5", "E.5", "E.5")
)

cols <- letters[2:4]