2

how can I merge columns with variable number of delimiters so I can obtain something like the output (assuming everything is a character)?

 dt1
   letter
1       a
2     b+c
3       c
4 d+e+f+g
5   a+g+e

 dt2
  letter number
1      a      1
2      b      2
3      c      3
4      d      4
5      e      5
6      f      6
7      g      7

> output
   letter  number
1       a       1
2     b+c     2+3
3       c       3
4 d+e+f+g 4+5+6+7
5   a+g+e   1+7+5
dt1<-data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"))

dt2<-data.frame(letter=c("a","b","c","d","e","f","g"),number=c("1","2","3","4","5","6","7"))

output<-data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"), number=c("1","2+3","3","4+5+6+7","1+7+5"))
Sotos
  • 51,121
  • 6
  • 32
  • 66
Garn_R
  • 77
  • 5

6 Answers6

2

A base R solution can be,

dt1$res <- sapply(strsplit(dt1$letter, '+', fixed = TRUE), function(i)paste(dt2$number[dt2$letter %in% i], collapse = '+'))

#   letter     res
#1       a       1
#2     b+c     2+3
#3       c       3
#4 d+e+f+g 4+5+6+7
#5   a+g+e   1+5+7
Sotos
  • 51,121
  • 6
  • 32
  • 66
  • Any chance the code could be improved so it actually would keep the order of the factors being merged? My issue is actually with a much complex dataset and some cells result in, for example: letter=d+e+f+g and res=5+4+6+7. I believe that must be related to how things are ordered in dt2. @Sotos – Garn_R Dec 17 '21 at 00:21
1

A solution using the tidyverse.

library(tidyverse)

output <- dt1 %>%
  mutate(ID = 1:n()) %>%
  separate_rows(letter, sep = "\\+") %>%
  left_join(dt2, by = "letter") %>%
  group_by(ID) %>%
  summarize(across(.fns = ~paste0(., collapse = "+"))) %>%
  ungroup() %>%
  select(-ID)
output
# # A tibble: 5 x 2
#   letter  number 
#   <chr>   <chr>  
# 1 a       1      
# 2 b+c     2+3    
# 3 c       3      
# 4 d+e+f+g 4+5+6+7
# 5 a+g+e   1+7+5 
www
  • 38,575
  • 12
  • 48
  • 84
1

There is no need to split any data as you simply want to replace a specific letter for a specific number.

dt1<-data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"), stringsAsFactors = F)
dt2<-data.frame(letter=c("a","b","c","d","e","f","g"),number=c("1","2","3","4","5","6","7"), stringsAsFactors = F)

library(stringi)

dt1 %>% mutate(number = stri_replace_all_regex(letter, dt2$letter, dt2$number, vectorize_all = F))

   letter  number
1       a       1
2     b+c     2+3
3       c       3
4 d+e+f+g 4+5+6+7
5   a+g+e   1+7+5

Another solution could be even shorter

dt1 <- data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"), stringsAsFactors = F)

v <- c("1","2","3","4","5","6","7")
names(v) <- c("a","b","c","d","e","f","g")

dt1 %>% mutate(number = str_replace_all(letter, v))
Merijn van Tilborg
  • 5,452
  • 1
  • 7
  • 22
0
library(tidyverse)
dt1 <- data.frame(letter = c("a", "b+c", "c", "d+e+f+g", "a+g+e"))
dt2 <- data.frame(letter = c("a", "b", "c", "d", "e", "f", "g"),
  number = c("1", "2", "3", "4", "5", "6", "7"))

dt1 %>%
  as_tibble() %>%
  mutate(
    number = letter %>% map_chr(~ .x %>%
      str_split("[+]") %>%
      simplify() %>%
      map_chr(~ deframe(dt2)[.x]) %>%
      paste0(collapse = "+")
    )
  )
#> # A tibble: 5 x 2
#>   letter  number
#>   <chr>   <chr>  
#> 1 a       1      
#> 2 b+c     2+3    
#> 3 c       3      
#> 4 d+e+f+g 4+5+6+7
#> 5 a+g+e   1+7+5

Created on 2021-12-14 by the reprex package (v2.0.1)

danlooo
  • 10,067
  • 2
  • 8
  • 22
0
dt1<-data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"))

dt2<-data.frame(letter=c("a","b","c","d","e","f","g"),number=c("1","2","3","4","5","6","7"))

library(tidyverse)
dt1 %>% 
  rowwise() %>% 
  mutate(tmp = str_split(letter, pattern = "\\+")) %>% 
  ungroup() %>% 
  mutate(number = map_chr(tmp, ~paste0(match(.x, dt2$letter), collapse = "+"))) %>% 
  select(-tmp)
#> # A tibble: 5 x 2
#>   letter  number 
#>   <chr>   <chr>  
#> 1 a       1      
#> 2 b+c     2+3    
#> 3 c       3      
#> 4 d+e+f+g 4+5+6+7
#> 5 a+g+e   1+7+5

Created on 2021-12-14 by the reprex package (v2.0.1)

Yuriy Saraykin
  • 8,390
  • 1
  • 7
  • 14
0

A fast and readable library(stringi) approach:

library(stringi)    

dt1 <- data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"))
dt2 <- data.frame(letter=c("a","b","c","d","e","f","g"), number=c("1","2","3","4","5","6","7"))

dt1$number <- stri_replace_all_fixed(dt1$letter, pattern = dt2$letter, replacement = dt2$number, vectorize_all = FALSE)

dt1

Result:

> dt1
   letter  number
1       a       1
2     b+c     2+3
3       c       3
4 d+e+f+g 4+5+6+7
5   a+g+e   1+7+5

Also see this related answer.


Edit: A Benchmark of the currently available answers:

Unit: microseconds
             expr     min      lq    mean  median      uq     max neval
            Sotos  2689.6  2689.6  2689.6  2689.6  2689.6  2689.6     1
    ismirsehregal    26.4    26.4    26.4    26.4    26.4    26.4     1
              www 42247.8 42247.8 42247.8 42247.8 42247.8 42247.8     1
 MerijnvanTilborg  1723.5  1723.5  1723.5  1723.5  1723.5  1723.5     1
    YuriySaraykin 21859.2 21859.2 21859.2 21859.2 21859.2 21859.2     1
          danlooo  4165.7  4165.7  4165.7  4165.7  4165.7  4165.7     1

To reproduce the benchmark:

library(microbenchmark)
library(tidyverse)
library(stringi)  

dt1 <- data.frame(letter=c("a","b+c","c","d+e+f+g","a+g+e"))
dt2 <- data.frame(letter=c("a","b","c","d","e","f","g"), number=c("1","2","3","4","5","6","7"))

microbenchmark(
  Sotos = {
    sapply(strsplit(dt1$letter, '+', fixed = TRUE), function(i)
      paste(dt2$number[dt2$letter %in% i], collapse = '+'))
  },
  ismirsehregal = {
    stri_replace_all_fixed(
      dt1$letter,
      pattern = dt2$letter,
      replacement = dt2$number,
      vectorize_all = FALSE
    )
  },
  www = {
    dt1 %>%
      mutate(ID = 1:n()) %>%
      separate_rows(letter, sep = "\\+") %>%
      left_join(dt2, by = "letter") %>%
      group_by(ID) %>%
      summarize(across(.fns = ~ paste0(., collapse = "+"))) %>%
      ungroup() %>%
      select(-ID)
  },
  MerijnvanTilborg = {
    dt1 %>% mutate(MerijnvanTilborg = stri_replace_all_regex(letter, dt2$letter, dt2$number, vectorize_all = F))
  },
  YuriySaraykin = {
    dt1 %>%
      rowwise() %>%
      mutate(tmp = str_split(letter, pattern = "\\+")) %>%
      ungroup() %>%
      mutate(number = map_chr(tmp, ~ paste0(match(.x, dt2$letter), collapse = "+"))) %>%
      select(-tmp)
  },
  danlooo = {
    dt1 %>%
      as_tibble() %>%
      mutate(number = letter %>% map_chr(
        ~ .x %>%
          str_split("[+]") %>%
          simplify() %>%
          map_chr( ~ deframe(dt2)[.x]) %>%
          paste0(collapse = "+")
      ))
  },
  times = 1L
)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78