R count sum of partial string matches over multiple columns

user_12671149 0
Viewed 549

I am working with an untidy registration form for a summer camp. The form output is given below:

          leaders         teen_adventure
1 camp, overnight                   <NA>
2            <NA>                   <NA>
3 camp, overnight camp, float, overnight

I want to generate new columns that sum the tally for each possible answer.

          leaders         teen_adventure camps overnights floats
1 camp, overnight                   <NA>     1          1      0
2            <NA>                   <NA>     0          0      0
3 camp, overnight camp, float, overnight     2          2      1

I feel in my bones that this has a dplyr solution, something like:

reprex %>%
  mutate(camps = sum(case_when(
    str_detect(select(., everything()), "camp") ~ 1,
    TRUE ~ 0
  )))

or perhaps using across().

Here is the sample data set:

# data
reprex <- structure(list(leaders = c("camp, overnight", NA, "camp, overnight"), 
          teen_adventure = c(NA, NA, "camp, float, overnight")), 
          row.names = c(NA, -3L), class = "data.frame")
stringr dplyr r
4 Answers

We can extract the words with str_extract_all by looping over the columns (map), then get the frequency count with mtabulate, bind the list elements, summarise the numeric columns to get the sum

library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(qdapTools)
library(data.table)
reprex %>% 
   map_dfr(~ str_extract_all(.x, "\\w+") %>%
             mtabulate, .id = 'grp') %>%
   group_by(grp = rowid(grp)) %>% 
   summarise(across(everything(), sum, na.rm = TRUE), 
       .groups = 'drop') %>%
   select(-grp) %>% 
   bind_cols(reprex, .)

-output

#            leaders         teen_adventure camp overnight float
#1 camp, overnight                   <NA>    1         1     0
#2            <NA>                   <NA>    0         0     0
#3 camp, overnight camp, float, overnight    2         2     1
user_37322710

One way:

library(stringr)
library(tidyr)
reprex %>%
  replace_na(list(leaders='unknown',teen_adventure='unknown'))%>%
  mutate(camp=as.numeric(str_detect(leaders, 'camp')+str_detect(teen_adventure,'camp')),
         float=as.numeric(str_detect(leaders,'float')+str_detect(teen_adventure,'float')),
         overnight=as.numeric(str_detect(leaders,'overnight')+str_detect(teen_adventure,'overnight')))

Output:

          leaders         teen_adventure camp float overnight
1 camp, overnight                unknown    1     0         1
2         unknown                unknown    0     0         0
3 camp, overnight camp, float, overnight    2     1         2
user_97442590

A base R option

v <- unique(unlist(strsplit(na.omit(unlist(reprex)), ",\\s+")))
reprex <- cbind(
  reprex,
  do.call(
    rbind,
    lapply(
      1:nrow(reprex),
      function(k) table(factor(unlist(strsplit(na.omit(unlist(reprex[k, ])), ",\\s+")), levels = v))
    )
  )
)

which gives

          leaders         teen_adventure camp overnight float
1 camp, overnight                   <NA>    1         1     0
2            <NA>                   <NA>    0         0     0
3 camp, overnight camp, float, overnight    2         2     1
user_121587570

This solution will work for any number columns and values:

reprex %>%
 as_tibble %>%
 # split the values by `, `
 mutate_all(strsplit, ", ") %>%
 # map through each column then each cell in order make it a named vector
 # for example the first cell : c("camp", "overnight") => c("camp"=1, "overnight"=1)
 # then pivot it longer by the row_number (this is done for quickly suming the values)
 map_dfr( function(x) x %>% map_dfr( ~ set_names(rep(1, length(.x<-.x[!is.na(.x)])), .x)) %>%
     mutate(id = row_number()) %>% 
     pivot_longer(!id) ) %>%
 # group by id and name so group the same variables that are found in the same row
 group_by(id, name) %>%
 # get the sum
 summarise_all(sum, na.rm=T) %>%
 ungroup %>%
 # return the tibble to wide format
 pivot_wider %>%
 # remove the id column
 select(-id) %>%
 # add the original data.frame to it
 tibble(reprex, .)

# A tibble: 3 x 5
  leaders         teen_adventure          camp float overnight
  <chr>           <chr>                  <dbl> <dbl>     <dbl>
1 camp, overnight NA                         1     0         1
2 NA              NA                         0     0         0
3 camp, overnight camp, float, overnight     2     1         2
user_39808200
Related