how to separate_rows in case of a complex data

Viewed 259

Truly speaking this problem isn't originally mine. This problem prompted me to put it up in a simplified case.

So, I have to separate data entered into cells (in columns) into separate rows on the basis of delimiter which is ; in the present scenario. This can be done easily using tidyr::separate_rows(). The data in nearly columns is already concatenated. Now the problem, actually two, are -

  1. There may be text separated by ; but may be inside closed parenthesis () e.g. (text_A;text_B) which is to be left concatenated and not to be separated.
  2. There may be uneven number of concatenations between cells of different columns in each row. In such case the row is to be broken into separate rows equal to maximum number of concatenations. For every other column where fewer concatenations are there, last text_value may be just repeated.

A reproducible example is as below

input <- data.frame(
  stringsAsFactors = FALSE,
  col_1 = c("A", "B", "C"),
  Col_2 = c("Text_A;Text_B","Text_C","Text_D;(Text_E;Text_F)"),
  Col_3 = c("Text_1", "Text_2;Text_3", "Text_4"),
  Col_4 = c("Text_a;(Text_b;Text_c);(Text_d;Text_dd)","Text_e","Text_f;Text_g")
)

input
  col_1                  Col_2         Col_3                                   Col_4
1     A          Text_A;Text_B        Text_1 Text_a;(Text_b;Text_c);(Text_d;Text_dd)
2     B                 Text_C Text_2;Text_3                                  Text_e
3     C Text_D;(Text_E;Text_F)        Text_4                           Text_f;Text_g

The desired output is as under:

output
#>   col_1           Col_2  Col_3            Col_4
#> 1     A          Text_A Text_1           Text_a
#> 2     A          Text_B Text_1  (Text_b;Text_c)
#> 3     A          Text_B Text_1 (Text_d;Text_dd)
#> 4     B          Text_C Text_2           Text_e
#> 5     B          Text_C Text_3           Text_e
#> 6     C          Text_D Text_4           Text_f
#> 7     C (Text_E;Text_F) Text_4           Text_g

Answers other than tidyverse are also acceptable.

2 Answers

Here is my approach, assuming only that there is no sequence "<sep>" in your columns:

input %>%
  mutate(across(-col_1,
                ~ str_replace_all(., "\\([^)]*\\)",
                                  \(x) str_replace_all(x, ";", "<sep>")))) %>%
  pmap(\(...) {
    args <- list(...)
    entries <- map(args[-1], ~ first(str_split(., ";")))
    map(entries, \(e) {
      c(e, rep(e[length(e)], do.call(max, map(entries, length)) - length(e)))
    }) %>%
    bind_rows() %>%
    bind_cols(args[1], .)
  }) %>%
  bind_rows() %>%
  mutate(across(-col_1, ~ str_replace_all(., "<sep>", ";")))

Returns:

# A tibble: 7 x 4
  col_1 Col_2           Col_3  Col_4
  <chr> <chr>           <chr>  <chr>
1 A     Text_A          Text_1 Text_a
2 A     Text_B          Text_1 (Text_b;Text_c)
3 A     Text_B          Text_1 (Text_d;Text_dd)
4 B     Text_C          Text_2 Text_e
5 B     Text_C          Text_3 Text_e
6 C     Text_D          Text_4 Text_f
7 C     (Text_E;Text_F) Text_4 Text_g

Extract wanted groups. Calculate maximum length in each row and fill values.

input <- input %>%
  mutate(across(everything(), str_extract_all, pattern = "(\\([^\\(\\)]+\\)|[^;]+)")) 

input_l <- pmap_int(input, ~max(map_int(list(...), length)))

input %>%
  split(seq_len(nrow(.))) %>%
  map(flatten) %>%
  map2_dfr(input_l, function(row, l) map_dfr(row, ~c(.x, rep(last(.x), l - length(.x))))) 

This gives the following output

  col_1 Col_2           Col_3  Col_4                
  <chr> <chr>           <chr>  <chr>                
1 A     Text_A          Text_1 Text_a               
2 A     Text_B          Text_1 (Text_b;Text_c)      
3 A     Text_B          Text_1 (Text_d;Text_dd)
4 B     Text_C          Text_2 Text_e               
5 B     Text_C          Text_3 Text_e               
6 C     Text_D          Text_4 Text_f               
7 C     (Text_E;Text_F) Text_4 Text_g 
Related