Time-based series categorisation

Viewed 30

I have a data collection that contains various measurements taken during the week. I would like to identify the start and end of the weekly measurements and group them as follow.

If there is no gap between the start and end day then:

 a.) 0 days (all week filled witth 0's)
 b.) 1 day (start=end); 
 c.) 2 days; 
 d.) 3 days; 
 e.) 4 days; 
 f.) 5 days; 
 g.) 6 days and 
 h.) 7 days.

If there is a gap between the measurement I would like to keep the id and weekly measurement structure.

Output

![enter image description here

Sample data:

    df<-structure(list(Id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 
29, 30, 31, 32, 33, 34, 35, 36, 37, 38), A = c(0, 0, 0, 0, 41, 
0, 51, 0, 0, 41, 0, 0, 0, 0, 0, 43, 49, 0, 0, 29, 0, 48, 0, 0, 
0, 0, 0, 0, 52, 62, 47, 21, 0, 42, 0, 3, 0, 0), B = c(0, 0, 0, 
0, 0, 0, 51, 0, 0, 7, 45, 0, 46, 0, 44, 21, 51, 48, 0, 0, 47, 
42, 0, 0, 0, 0, 43, 0, 59, 56, 0, 57, 0, 46, 0, 44, 0, 0), C = c(0, 
0, 0, 0, 25, 0, 50, 0, 0, 0, 55, 0, 49, 0, 46, 17, 51, 41, 0, 
49, 51, 23, 0, 0, 0, 0, 38, 0, 57, 70, 46, 53, 0, 4, 0, 2, 0, 
0), D = c(0, 0, 0, 0, 42, 0, 63, 0, 0, 8, 0, 0, 0, 0, 47, 24, 
29, 0, 0, 0, 53, 35, 0, 0, 48, 0, 0, 0, 0, 14, 0, 60, 0, 53, 
0, 49, 0, 0), E = c(0, 0, 0, 0, 0, 0, 46, 0, 0, 48, 0, 0, 46, 
0, 43, 0, 0, 0, 0, 0, 46, 0, 0, 0, 48, 0, 26, 0, 0, 58, 46, 51, 
0, 40, 0, 48, 0, 0), F = c(0, 0, 0, 0, 0, 0, 0, 0, 55, 0, 0, 
0, 0, 0, 40, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 22, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0), G = c(0, 0, 0, 0, 0, 0, 0, 0, 60, 0, 0, 
0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0), Total = c(0, 0, 0, 0, 108, 0, 261, 0, 55, 
104, 100, 0, 141, 0, 220, 105, 180, 89, 0, 78, 197, 148, 0, 0, 
96, 0, 129, 0, 168, 260, 139, 242, 0, 185, 0, 146, 0, 0)), class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -38L), spec = structure(list(
    cols = list(Id = structure(list(), class = c("collector_double", 
    "collector")), A = structure(list(), class = c("collector_double", 
    "collector")), B = structure(list(), class = c("collector_double", 
    "collector")), C = structure(list(), class = c("collector_double", 
    "collector")), D = structure(list(), class = c("collector_double", 
    "collector")), E = structure(list(), class = c("collector_double", 
    "collector")), F = structure(list(), class = c("collector_double", 
    "collector")), G = structure(list(), class = c("collector_double", 
    "collector")), Total = structure(list(), class = c("collector_double", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), skip = 1L), class = "col_spec")) 
1 Answers

You could solve this by "coding" your days with measurements. For this

  1. define a helper function that picks either "0" for no measurements and "v" for a measurement value
  2. code your week

To evaluate uninterrupted stretches of measurements:

  1. kill any leading or trailing 0. This accounts for measurements not starting on the first or ending on last day - as this is permissible.
  2. check whether there is an interruption (i.e. break) in the remaining code
  3. if no break, the length, i.e. number of characters nchars(), gives the number of days with measurement.

To showcase what is going on, I store the intermediate codes in separate columns. You can combine this or remove the intermediate columns when done.

# helper function
check_value <- function(x){
   ifelse(x == 0, "0", "v")     # returns "0" for no measurement, else "v"
}


df %>% mutate(
# ------------ code your week = combinations of "0" or "v"
    combis = paste0(check_value(A), check_value(B), check_value(C), check_value(D), 
                    check_value(E), check_value(F))

# ------------ eliminate leading and trailing "0"
    , seqs = gsub(pattern = "(^0+)|(0+$)", "", combis)

# ------------ check for breaks
    , breaks = grepl(pattern = "0", x = seqs)

# ------------ if uninterrupted, count number of days
    , days = ifelse(breaks == FALSE, nchar(seqs), NA)

# ----------- construct comment summary
    , comment = case_when(
         breaks == TRUE & is.na(days) ~ "With"
        ,breaks == FALSE ~ paste0("Without-", days, " days")
        ,TRUE ~ as.character(NA))
    )

This yields for the first 10 rows:

# A tibble: 38 x 14
      Id     A     B     C     D     E     F     G Total combis seqs    breaks  days comment       
   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>  <chr>   <lgl>  <int> <chr>         
 1     1     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 2     2     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 3     3     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 4     4     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 5     5    41     0    25    42     0     0     0   108 v0vv00 "v0vv"  TRUE      NA With          
 6     6     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 7     7    51    51    50    63    46     0     0   261 vvvvv0 "vvvvv" FALSE      5 Without-5 days
 8     8     0     0     0     0     0     0     0     0 000000 ""      FALSE      0 Without-0 days
 9     9     0     0     0     0     0    55    60    55 00000v "v"     FALSE      1 Without-1 days
10    10    41     7     0     8    48     0     0   104 vv0vv0 "vv0vv" TRUE      NA With   
Related