Shift indicator value in column based on groups in second column

Viewed 46

I have a dataset with many (arranged) groups of varying sizes and a second column that represents a systematic indicator for the selection of rows. E.g. in the example below, starting from row 3 every fourth value (row 3, 7, 11, etc.) is selected.

However, an additional rule is that each group must only be selected once. In the example below, group C is large, so it got selected twice (rows seven and eleven). When that happens, I would like to shift the second selected value downwards on the list until it matches the next "free" group. In this case row 17 of group E (which has only NAs), as group D already had a row selected. The other selected rows should remain the same (following the systematic pattern). Also note that it can happen that some of the smaller groups are skipped (e.g. group B), but that's okay. In the real dataset, the intervals are larger than the majority of the groups, so it is more likely that a group is not selected than that it is selected twice.

Any ideas about how to approach this?

df <- tibble(group    = c(rep("A", 4), rep("B", 2), rep("C", 6), rep("D", 4), rep("E", 2), rep("F", 2)),
             selected = rep(c(NA, NA, 1, NA), times = 5))


    # A tibble: 20 x 2
   group selected
   <chr>    <dbl>
 1 A           NA
 2 A           NA
 3 A            1
 4 A           NA
 5 B           NA
 6 B           NA
 7 C            1
 8 C           NA
 9 C           NA
10 C           NA
11 C            1 # second time that group C has been selected. Not allowed.
12 C           NA
13 D           NA
14 D           NA
15 D            1 # group D already occupied, but group E is free
16 D           NA
17 E           NA
18 E           NA
19 F            1
20 F           NA

What I would like to have:

# A tibble: 20 x 2
   group selected
   <chr>    <dbl>
 1 A           NA
 2 A           NA
 3 A            1
 4 A           NA
 5 B           NA
 6 B           NA
 7 C            1
 8 C           NA
 9 C           NA
10 C           NA
11 C         **NA** # second selected value of group C is now NA
12 C           NA
13 D           NA
14 D           NA
15 D            1
16 D           NA
17 E          **1** # instead the first value of E is selected.
18 E           NA
19 F            1
20 F           NA
1 Answers

Try this:

library(dplyr)
df %>%
  group_by(group) %>%
  mutate(excess = (!is.na(selected) & duplicated(selected))) %>%
  ungroup() %>%
  mutate(excess2 = cumsum(excess)) %>%
  group_by(group) %>%
  mutate(useexcess = (all(is.na(selected)) & row_number() == 1L & excess2 > 0)) %>%
  ungroup() %>%
  mutate(selected = case_when(is.na(selected) & !excess & (cumsum(excess) - lag(cumsum(useexcess), default = 0)) > 0 & useexcess ~ 1, !is.na(selected) & excess ~ NA_real_, TRUE ~ selected)) %>%
  select(-excess, -excess2, useexcess)
# # A tibble: 20 x 3
#    group selected useexcess
#    <chr>    <dbl> <lgl>    
#  1 A           NA FALSE    
#  2 A           NA FALSE    
#  3 A            1 FALSE    
#  4 A           NA FALSE    
#  5 B           NA FALSE    
#  6 B           NA FALSE    
#  7 C            1 FALSE    
#  8 C           NA FALSE    
#  9 C           NA FALSE    
# 10 C           NA FALSE    
# 11 C           NA FALSE    
# 12 C           NA FALSE    
# 13 D           NA FALSE    
# 14 D           NA FALSE    
# 15 D            1 FALSE    
# 16 D           NA FALSE    
# 17 E            1 TRUE     
# 18 E           NA FALSE    
# 19 F            1 FALSE    
# 20 F           NA FALSE    
Related