合并列，同时忽略重复项和 NA

Question

我有一个数据框如下，我想合并两列，即 Var1 和 Var2。我希望组合列 (Var3) 不包含 <alpha><digit> 的重复项。即，如果 Var1 == A1 和 Var2 == A1，则 Var3 == A1 而不是 Var3 == A1-A1，或者如果 Var1 == A4-E9 和 Var2 == A4，则 Var3 == A4-E9 而不是 Var3 == A4-E9-A4

df <- read.table(header = TRUE, text = 
"id  Var1    Var2
A   A1       A1
B   F2       A2
C   NA       A3
D   A4-E9    A4
E   E5       A5
F   NA       NA
G   B2-R4    A3-B2
H   B3-B4    E1-G5", stringsAsFactors = FALSE)

以下是我的代码。我想提高它的可读性，并去掉第 3 行条目中 Var3 中的 NA，即 A3-NA.

library(dplyr)
library(tidyr)
df %>% 
  mutate(Var3 = paste(Var1, Var2, sep = "-"))  %>%
  separate_rows(Var3, sep = "-") %>%
  group_by(id, Var3) %>%
  slice(1) %>%
  group_by(id) %>%
  mutate(Var3 = paste(unlist(Var3[!is.na(Var3)]), collapse = "-")) %>%
  slice(1) %>%
  ungroup

这是我想要的输出：

# A tibble: 8 x 4
     id  Var1  Var2        Var3
  <chr> <chr> <chr>       <chr>
1     A    A1    A1          A1
2     B    F2    A2       A2-F2
3     C  <NA>    A3          A3
4     D A4-E9    A4       A4-E9
5     E    E5    A5       A5-E5
6     F  <NA>  <NA>        <NA>
7     G B2-R4 A3-B2    A3-B2-R4
8     H B3-B4 E1-G5 B3-B4-E1-G5

Answer 1

如果 'df1' 是输出，那么我们删除 - 之后的 'NA' 和 sub

df1 %>% 
    mutate(Var3 = sub("-NA", "", Var3))
# A tibble: 8 x 4
#     id  Var1  Var2        Var3
#  <chr> <chr> <chr>       <chr>
#1     A    A1    A1          A1
#2     B    F2    A2       A2-F2
#3     C  <NA>    A3          A3
#4     D A4-E9    A4       A4-E9
#5     E    E5    A5       A5-E5
#6     F  <NA>  <NA>          NA
#7     G B2-R4 A3-B2    A3-B2-R4
#8     H B3-B4 E1-G5 B3-B4-E1-G5

我们也可以将 tidyverse 通过 gather 转换为 'long' 格式，然后使用 separate_rows 拆分 'value' 列，分组依据'id'、summarise 'Var3' 列 paste 对 'Var3' 和 left_join 的 sorted unique 元素与原始数据集 'df'

library(tidyverse)
gather(df, key, value, -id) %>%
       separate_rows(value)  %>%
       group_by(id) %>% 
       summarise(Var3 = paste(sort(unique(value)), collapse='-')) %>% 
       mutate(Var3 = replace(Var3, Var3=='', NA)) %>% 
       left_join(df, .)
#   id  Var1  Var2        Var3
#1  A    A1    A1          A1
#2  B    F2    A2       A2-F2
#3  C  <NA>    A3          A3
#4  D A4-E9    A4       A4-E9
#5  E    E5    A5       A5-E5
#6  F  <NA>  <NA>        <NA>
#7  G B2-R4 A3-B2    A3-B2-R4
#8  H B3-B4 E1-G5 B3-B4-E1-G5

注意：%>% 甚至可以让一个简单的代码出现在多行中，但如果需要，我们可以将所有这些语句放在一行中，术语如 one-liner

这是单行本

library(data.table)
setDT(df)[, Var3 := paste(sort(unique(unlist(strsplit(unlist(.SD),"-")))), collapse="-"), id]

Answer 2

你可以一行完成

df$Var3 = lapply(strsplit(paste(df$Var1, df$Var2, sep = "-"),"-"),
                 function(x)paste(unique(x)[unique(x)!="NA"],collapse="-"))

输出：

  id  Var1  Var2        Var3
1  A    A1    A1          A1
2  B    F2    A2       F2-A2
3  C  <NA>    A3          A3
4  D A4-E9    A4       A4-E9
5  E    E5    A5       E5-A5
6  F  <NA>  <NA>            
7  G B2-R4 A3-B2    B2-R4-A3
8  H B3-B4 E1-G5 B3-B4-E1-G5

lapply 函数的第一部分类似于您第一次调用 dplyr。首先将列连接起来，然后我们再次拆分它们。
lapply 中的函数删除所有 NA，然后再次折叠字符串。

希望对您有所帮助！

EDIT: Speed comparison for fun!

262,144 rows

Average runtimes:

Florian: 3.97 seconds

Sotos: 2.46 seconds

Akrun: 1.34 seconds

Adamm: >120 seconds

df <- read.table(header = TRUE, text = 
                   "id  Var1    Var2
A   A1       A1
B   F2       A2
C   NA       A3
D   A4-E9    A4
E   E5       A5
F   NA       NA
G   B2-R4    A3-B2
H   B3-B4    E1-G5", stringsAsFactors = FALSE)

for(i in 1:15)
{
  df = rbind(df,df)
}

library(microbenchmark)

# Florian's method
microbenchmark(
lapply(strsplit(paste(df$Var1, df$Var2, sep = "-"),"-"),
                 function(x)paste(unique(x)[unique(x)!="NA"],collapse="-")),times=5)

# Sotos'method
microbenchmark(
gsub('NA-|-NA', '', vapply(strsplit(do.call(paste, df[-1]), " |-"), function(i) paste(unique(i), collapse = "-"), character(1L))), times=5)

# akrun method
library(data.table)
microbenchmark(
setDT(df)[, Var3 := paste(sort(unique(unlist(strsplit(unlist(.SD),"-")))), collapse="-"), id], times=5)

# Adamm method
microbenchmark(
sapply(1:nrow(df), function(i) ifelse(df[i,2]!=df[i,3] & !is.na(df[i,2]) & !is.na(df[i,3]), paste(df[i,2], df[i,3], sep="-"), ifelse(!is.na(df[i,3]), df[i,3], df[i,2]))), times=5)

Answer 3

如果你想要复杂的解决方案；长单行，嵌套 ifelse().

df$Var3 <- sapply(1:nrow(df), function(i) ifelse(df[i,2]!=df[i,3] & !is.na(df[i,2]) & !is.na(df[i,3]), paste(df[i,2], df[i,3], sep="-"), ifelse(!is.na(df[i,3]), df[i,3], df[i,2])))

> df
  id  Var1  Var2        Var3
1  A    A1    A1          A1
2  B    F2    A2       F2-A2
3  C  <NA>    A3          A3
4  D A4-E9    A4    A4-E9-A4
5  E    E5    A5       E5-A5
6  F  <NA>  <NA>        <NA>
7  G B2-R4 A3-B2 B2-R4-A3-B2
8  H B3-B4 E1-G5 B3-B4-E1-G5

为了提高效率，我做了一个小实验，并测量了每个建议解决方案的时间，结果如下：

首先我需要更多行：

n <- 10000                       
df <- do.call("rbind", replicate(n, df, simplify = FALSE))

Akrun 解决方案 1 tidyverse

Time difference of 1.452809 secs

Akrun 解决方案 2 data.table

Time difference of 0.4530261 secs

Florian Maas 解决方案 lapply

Time difference of 1.812106 secs

我的解决方案 sapply

Time difference of 2.289345 mins

Sotos解决方案

Time difference of 1.515296 secs

合并列，同时忽略重复项和 NA

Combining columns, while ignoring duplicates and NAs

r

dataframe

dplyr

tidyr