Count number of sequences of a specific value per group

user_12114010 0
Viewed 84

Lets say I have a data frame with an ID and a variable in which the response is either ON or OFF. I want to count the number of runs of "ON" per group. I had nearly managed this but realised my solution wasn't working on the first or last value in the group depending on whether I was trying to use lead or lag.

I have searched SO and can find similar problems but non seem to match this exactly.

id <- c("a", "a", "a", "a", "a", "b", "b", "b", "b", "b","c", "c","c","c","c","c","c","c" )
category <- c("ON", "OFF", "OFF", "ON", "ON", "ON", "OFF", "OFF", "ON", "ON", "OFF", "OFF","OFF","OFF","OFF", "ON", "ON","ON")
dat<-data.frame(id, category)

My attempt so far which is not working I think because it doesn't work if the run starts as "ON" in a group

summary(dat %>% group_by(id)%>% filter(category == "ON", lead(category!="ON"))%>% count(category) %>% arrange(n))

Very grateful for any assistance. My actual dataset is 40,000 rows with 120 id's and in each id the category may start as either ON or OFF

Output would be something like this:

# id    category       n    
# a:1   OFF:0    Min.   :1  
# b:1   ON :2    1st Qu.:1  
# c:0            Median :1  
#                Mean   :1  
#                3rd Qu.:1  
#                Max.   :1

So that the interpretation would be 2 id's has a run of "ON" at any point and the median number of runs of ON (in this tiny sample) was 1

sequence count r
2 Answers
# step 1
out <- dat %>%
  group_by(id) %>%
  nest()

# outcome step 1
out
# # A tibble: 3 x 2
# # Groups:   id [3]
#   id    data            
#   <chr> <list>          
# 1 a     <tibble [5 x 1]>
# 2 b     <tibble [5 x 1]>
# 3 c     <tibble [8 x 1]>

# step 2
out <- out %>%
  mutate(run = map(data, ~ {
    out_map <- rle(.x$category)
    out_map <- tibble(length = out_map[[1]], category = out_map[[2]])
    return(out_map)
  })) %>%
  select(-data)

# outcome step 2
out
# # A tibble: 3 x 2
# # Groups:   id [3]
#   id    run             
#   <chr> <list>          
# 1 a     <tibble [3 x 2]>
# 2 b     <tibble [3 x 2]>
# 3 c     <tibble [2 x 2]>

# step 3
out <- out %>%
  unnest(cols = c(run)) %>%
  # this line lets you filter for category and the minimum line of the run
  filter(category == "ON", length > 1) %>%
  ungroup() %>%
  mutate_if(is.character, as_factor)
    
out
# # A tibble: 3 x 3
#   id    length category
#   <fct>  <int> <fct>   
# 1 a          2 ON      
# 2 b          2 ON      
# 3 c          3 ON      

count(out, id, category, sort = TRUE)
# # A tibble: 3 x 3
#   id    category     n
#   <fct> <fct>    <int>
# 1 a     ON           1
# 2 b     ON           1
# 3 c     ON           1

summary(out)
#  id        length      category
#  a:1   Min.   :2.000   ON:3    
#  b:1   1st Qu.:2.000           
#  c:1   Median :2.000           
#        Mean   :2.333           
#        3rd Qu.:2.500           
#        Max.   :3.000
user_111297270

in base-R we can use

tapply(dat$category, dat$id, function(x) with(rle(as.character(x)),sum(values == "ON")))

a b c 
2 2 1
user_104424230
Related