Create a group variable based on different criteria of consecutive scores

user_14409664 0
Viewed 39

I have a dataset that contains just the subject id and scores from different time points. Is there a way for me to create a group variable based on their scores? For example, if a subject has 6 consecutive scores of 1 or 2, I would put them in group "a" | if they had 4 consecutive scores of 3, I would put them in group "b" | if they had 6 consecutive scores of 4 or higher, I would put them in group "c".

Here is an example dataset:

id  score1  score2  score3  score4  score5  score6  score7  score8 group
101 2       2       2      2        1       2       2       1      a
102 4       4       3      3        3       3       4       4      b
103 4       5       5      5        5       6       5       5      c

Here is the R code for the above table without the "group" column

structure(list(id = c(101, 102, 103), score1 = c(2, 4, 4), score2 = c(2, 
4, 5), score3 = c(2, 3, 5), score4 = c(2, 3, 5), score5 = c(1, 
3, 5), score6 = c(2, 3, 6), score7 = c(2, 4, 5), score8 = c(1, 
4, 5)), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"
))

Any ideas are appreciated! Thank you so much :)

grouping count r time
3 Answers

Loop over the rows of numeric columns of the data with apply (MARGIN = 1), replace the values 1 to 2 to 1, and those that are greater than or equal to 4 to 4, then get the rle (run-length-encoding) on the replaced values in the row, extract the 'values' and 'lengths', create a logical expression based on the conditions specified in OP's post and return the desired group values if those conditions are met

library(dplyr)
df1$group <- apply(df1[-1], 1, function(x) {
     x <- case_when(x %in% 1:2 ~ 1, x >=4 ~ 4, TRUE ~ x)
     v1 <- rle(x)
     na.omit(case_when(v1$values == 1 & v1$lengths >= 6 ~  'a',
       v1$values == 3 & v1$lengths >=4 ~ 'b',
         v1$values ==4 & v1$lengths >= 6 ~  'c' )) })
df1$group
#[1] "a" "b" "c"

Or using tidyverse

library(data.table)
library(tidyr)
df1 %>%
   pivot_longer(cols = -id) %>% 
   mutate(newvalue = case_when(value %in% 1:2 ~ 1, 
         value >= 4 ~ 4, TRUE ~ value)) %>%
   add_count(id, grp = rleid(newvalue)) %>%
   group_by(id) %>%
   summarise( group = first(na.omit(case_when(newvalue == 1 & n >= 6 ~ 'a',
           newvalue == 3 & n >= 4  ~'b',
           newvalue == 4 & n >= 6 ~ 'c'))), .groups = 'drop') %>% 
  left_join(df1, .)

-output

# A tibble: 3 x 10
#     id score1 score2 score3 score4 score5 score6 score7 score8 group
#  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl> <chr>
#1   101      2      2      2      2      1      2      2      1 a    
#2   102      4      4      3      3      3      3      4      4 b    
#3   103      4      5      5      5      5      6      5      5 c
user_37322710

The function at the heart of all solutions is rle(). How you handle everything around is up to you.

library(tidyverse, quietly = TRUE)
score_df %>% 
  pivot_longer(score1:score8) %>% 
  mutate(value = 
           case_when(
             value <= 2 ~ 1,
             value >= 4 ~ 4,
             TRUE ~ value
           )) %>% 
  group_by(id) %>% 
  group_map(~{
    r <- rle(.$value)
    highest_val <- max(r$values)
    longest_len <- max(r$lengths)
    case_when(max(r$value) == 1 ~ "a",
              any(r$lengths[which(r$value == 3)] >= 4) ~ "b",
              any(r$lengths[which(r$value == 4)] >= 6) ~ "c",
              TRUE ~ NA_character_)
  }) %>% 
  unlist()
#> [1] "a" "b" "c"
user_48211420

Using base R, you could do:

pat <- c(a = "[12]{6}", b="3{4}", c="[4-9]{6}")

cbind(df, group = names(pat)[max.col(sapply(pat, grepl, do.call(paste0, df[-1])))])

   id score1 score2 score3 score4 score5 score6 score7 score8 group
1 101      2      2      2      2      1      2      2      1     a
2 102      4      4      3      3      3      3      4      4     b
3 103      4      5      5      5      5      6      5      5     c
user_83802720
Related