Create new columns with information extracted from another column on R

Viewed 77

I have a data frame where one of the columns have several information separated by ";", like the following:

DF = data.frame(a = c(1,1,1,2,2), b = c('aaa','aaa','aba','abc','ccc'), 
                extra_info = c(
                  'animal=horse;color=orange;shape=circle',
                  'animal=monkey;shape=square;value=532',
                  'animal=horse;color=blue;shape=square;value=321',
                  'animal=dog;color=green;value=678',
                  'color=pink;shape=triangle'
                ))

I can't use read.table because I'm already using a different function to read the data (and also the content of each row in the column extra_info is different, and the columns would be messed up). What I wish to do is separate all this information to different columns, and assign proper names accordingly, such as:

a   b   animal  color   shape    value
1  aaa  horse   orange  circle   NA
1  aaa  monkey  NA      square   532
1  aba  horse   blue    square   321
2  abc  dog     green   NA       678
2  ccc  NA      pink    triangle NA

So far, I've tried:

new_cols = DF %>% separate(extra_info, c(LETTERS[1:4]), sep = ";")

new_cols %>% separate(A, c("key","value"), sep = '=') %>% 
  separate(B, c("key","value"), sep = '=') %>%
  separate(C, c("key","value"), sep = '=') %>%
  separate(D, c("key","value"), sep = '=') %>%
  pivot_wider(names_from = c("key"), values_from = c("value"))

But it doesn't work as expected.

4 Answers

Here's an approach where I change the syntax of your key-value pairs into valid JSON syntax and use jsonlite::fromJSON to parse it:

library(purrr)
library(dplyr)
library(stringr)
library(jsonlite)
DF %>%
  mutate(
    json = str_replace_all(extra_info, pattern = "\\b", replacement = '"'),
    json = str_replace_all(json, pattern = fixed("="), replacement = ":"),
    json = str_replace_all(json, pattern = fixed(";"), replacement = ","),
    json = paste("{", json, "}"),
  ) %>%
  pull(json) %>%
  map(jsonlite::fromJSON) %>%
  map(as.data.frame) %>%
  bind_rows %>%
  cbind(DF, .)
#   a   b                                     extra_info animal  color    shape value
# 1 1 aaa         animal=horse;color=orange;shape=circle  horse orange   circle  <NA>
# 2 1 aaa           animal=monkey;shape=square;value=532 monkey   <NA>   square   532
# 3 1 aba animal=horse;color=blue;shape=square;value=321  horse   blue   square   321
# 4 2 abc               animal=dog;color=green;value=678    dog  green     <NA>   678
# 5 2 ccc                      color=pink;shape=triangle   <NA>   pink triangle  <NA>

Here is a base R option using gsub + eval + str2expression

v <- DF$extra_info
p <- gsub(";", ",", gsub("(?<=\\=)(\\w+)", "'\\1'", v, perl = TRUE))
nms <- unique(unlist(regmatches(v, gregexpr("\\w+(?=\\=)", v, perl = TRUE))))
q <- unname(Map(function(x) setNames(eval(str2expression(x))[nms], nms), sprintf("c(%s)", p)))
cbind(DF[c("a","b")], type.convert(data.frame(do.call(rbind, q)), as.is = TRUE))

which gives

  a   b animal  color    shape value
1 1 aaa  horse orange   circle    NA
2 1 aaa monkey   <NA>   square   532
3 1 aba  horse   blue   square   321
4 2 abc    dog  green     <NA>   678
5 2 ccc   <NA>   pink triangle    NA

It's a bit neater with the stringr package, but if you just want base R you can use the following. In the pattern structure (?<=animal=)\\w+(?=\\b) here, the \\w+ is what's actually being returned, it is any word character (\\w) and there has to be at least one of them (+). This is swapped with \\d+ for 'value' since digits are required. Alternatively you could replace both with [:alnum:]+. Then the (?<=animal=) structure is used to specify that it must be preceded by "animal=", and the (?=\\b) structure indicates that it has to be followed by a word boundary (\\b). You could get a bit more specific and replace \\b with (,|;|$) which stands for comma or semicolon or end of line (EDIT: the original question had commas in some places). There might be a nice way of writing a loop over the four words that creates the variable names and patterns dynamically.

pattern <- "(?<=animal=)\\w+(?=\\b)"
DF$animal <- sapply(regmatches(DF$extra_info, regexec(pattern, DF$extra_info , perl=T)), "[", 1)
pattern <- "(?<=color=)\\w+(?=\\b)"
DF$color<- sapply(regmatches(DF$extra_info, regexec(pattern, DF$extra_info , perl=T)), "[", 1)
pattern <- "(?<=shape=)\\w+(?=\\b)"
DF$shape<- sapply(regmatches(DF$extra_info, regexec(pattern, DF$extra_info , perl=T)), "[", 1)
pattern <- "(?<=value=)\\d+(?=\\b)"
DF$value <- sapply(regmatches(DF$extra_info, regexec(pattern, DF$extra_info , perl=T)), "[", 1)

If you're happy to use tidyverse/stringr, here is the code.

DF <- DF %>% 
  mutate(animal = str_extract(extra_info, "(?<=animal=)\\w+(?=\\b)" )) %>% 
  mutate(color = str_extract(extra_info, "(?<=color=)\\w+(?=\\b)" )) %>% 
  mutate(shape = str_extract(extra_info, "(?<=shape=)\\w+(?=\\b)" )) %>% 
  mutate(value = str_extract(extra_info, "(?<=value=)\\d+(?=\\b)" ))

For more info on string manipulation and regular expressions, see the stringr cheat sheet here: https://github.com/rstudio/cheatsheets/blob/master/strings.pdf

library(stringr) 
col_names <- unlist(str_extract_all(DF$extra_info[3], "(?<=^|;)\\w+"))
DF %>% 
  mutate(animal =  str_extract(extra_info, paste0("(?<=", col_names[1], "=)\\w+")),
         color = str_extract(extra_info, paste0("(?<=", col_names[2], "=)\\w+")), 
         shape = str_extract(extra_info, paste0("(?<=", col_names[3], "=)\\w+")),
         value = str_extract(extra_info, paste0("(?<=", col_names[4], "=)\\w+"))
  a   b                                     extra_info animal  color    shape value
1 1 aaa         animal=horse;color=orange;shape=circle  horse orange   circle  <NA>
2 1 aaa           animal=monkey;shape=square;value=532 monkey   <NA>   square   532
3 1 aba animal=horse;color=blue;shape=square;value=321  horse   blue   square   321
4 2 abc               animal=dog;color=green;value=678    dog  green     <NA>   678
5 2 ccc                      color=pink;shape=triangle   <NA>   pink triangle  <NA>
Related