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 {1}}

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}行的第3行条目中出现的NA，即Var3。

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

Answer 1

如果'df1'是输出，那么我们删除-后跟sub

的'NA'

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'分组，{{ 1}}'Var3'列summarise'{1}} paste元素'Var3'和sort元素与原始数据集'df'

unique

注意：left_join甚至可以将一个简单的代码显示在多行中，但如果需要，我们可以将所有这些语句放在一行，术语为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

这是一个单行

%>%

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，然后再次折叠字符串。

希望这有帮助！

编辑：速度比较的乐趣！


262,144行


平均运行时间：


Florian：3.97秒

Sotos：2.46秒

Akrun： 1.34秒

Adamm：＆gt; 120秒

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))

带有tidyverse

的Akrun解决方案1

Time difference of 1.452809 secs

带有data.table

的Akrun解决方案2

Time difference of 0.4530261 secs

拥有lapply

的Florian Maas解决方案

Time difference of 1.812106 secs

我的解决方案sapply

Time difference of 2.289345 mins

Sotos解决方案

Time difference of 1.515296 secs

组合列，同时忽略重复和NA

3 个答案: