Column join while ignoring duplicates and NA

I have dataframe follows, and I would like to combine the two columns, namely Var1and Var2. I want the joined column ( Var3) to not contain duplicates <alpha><digit>. that is, Var1 == A1and Var2 == A1therefore Var3 == A1, but not Var3 == A1-A1or if, Var1 == A4-E9and Var2 == A4therefore Var3 == A4-E9, but notVar3 == 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)

Below is my code. I would like to improve its readability, as well as get rid of NAthat which is present in the line 3 entry for Var3, ie 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

Here is my desired result:

# 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
+4
source share
3 answers

'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, "id", summarise "Var3" paste sort ed unique "Var3" left_join "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]
+5

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: !

  • 262,144

:

  • : 3,97
  • Sotos: 2,46
  • Akrun: 1.34
  • Adamm: > 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 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)
+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

lapply

Time difference of 1.812106 secs

sapply

Time difference of 2.289345 mins

Sotos

Time difference of 1.515296 secs
+2

Source: https://habr.com/ru/post/1681590/


All Articles