Count of a string of values between values

Viewed 52

I have a simple dataframe that is a set of ID columns and values of 0 or 1, for an example:

data.frame(replicate(10,sample(0:1,1000,rep=TRUE)))

  X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1  1  1  0  1  0  0  1  1  1   0
2  0  0  0  1  0  1  0  0  1   0
3  0  1  1  1  1  0  1  1  1   1
4  0  0  0  1  1  1  1  1  1   0
5  1  0  1  0  1  1  0  1  1   0
6  0  1  1  1  1  1  0  1  1   1

I want to write a code or loop that for every column, counts the number of 0's until encountering another 1, and continues down the column. So ideally the output is a new dataframe with the same ID column head, and a list of counts:

  X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1  3  1  2  1  2  1  1  1  NA  2
2  1  2  1  1  NA 1  2  NA NA  2

   

I'm not sure how to do this and also the row outcome may be of different lengths. If each column has to create a new dataframe that's fine.

3 Answers

Here's a base R solution. I used a size-10 example instead of a size 1000 example so we can actually see what's going on and make sure it looks right.

set.seed(47)
d = data.frame(replicate(10,sample(0:1,10,rep=TRUE)))
d
#    X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
# 1   0  0  0  0  0  0  1  1  0   0
# 2   0  1  0  1  0  0  0  0  0   0
# 3   1  1  1  0  1  0  0  0  1   0
# 4   0  0  0  0  0  1  1  1  1   1
# 5   1  1  0  1  0  0  1  1  1   0
# 6   0  1  1  1  1  1  1  1  0   1
# 7   1  1  0  0  1  0  0  1  1   0
# 8   0  0  1  0  1  0  1  0  0   0
# 9   0  0  0  1  1  1  0  0  1   1
# 10  1  1  1  0  1  0  1  1  0   0

results = lapply(d, function(x) with(rle(x), lengths[values == 0]))
max_length = max(lengths(results))
results = lapply(results, function(x) {length(x) = max_length; x})
results = do.call(cbind, results)
results
#      X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
# [1,]  2  1  2  1  2  3  2  2  2   3
# [2,]  1  1  2  2  2  1  1  2  1   1
# [3,]  1  2  1  2 NA  2  1 NA  1   2
# [4,]  2 NA  1  1 NA  1 NA NA  1   1

One dplyr and purrr option could be:

map(.x = names(df),
    ~ df %>%
     mutate(rleid = with(rle(get(.x)), rep(seq_along(lengths), lengths))) %>%
     filter(get(.x) == 0) %>%
     group_by(rleid = cumsum(!duplicated(rleid))) %>%
     summarise(!!.x := n())) %>%
 reduce(full_join, by = c("rleid" = "rleid"))

  rleid    X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
  <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
1     1     1     1     2     2     9     2     3     4     1     1
2     2     1     1    NA     3    NA     1     1     2     1     1
3     3     1     3    NA    NA    NA     2     1    NA     2     2
4     4     1    NA    NA    NA    NA     1    NA    NA     1     2

Sample data:

set.seed(123)
df <- data.frame(replicate(10, sample(0:1, 10, rep = TRUE)))

   X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1   0  1  1  1  0  0  1  1  0   0
2   1  0  1  1  0  0  0  1  1   1
3   0  1  1  1  0  1  0  1  0   0
4   1  1  1  1  0  0  0  0  1   1
5   1  0  1  0  0  1  1  0  0   0
6   0  1  1  0  0  0  0  0  0   0
7   1  0  1  1  0  0  1  0  1   1
8   1  0  1  0  0  1  1  1  1   0
9   1  0  0  0  0  1  1  0  1   0
10  0  1  0  0  1  0  0  0  0   1

Here's an alternate approach that uses the indices of the 1 values to determine the runs of zero (using Gregor's data):

library(purrr)

map(df, ~ {
  y <- diff(c(0, which(.x == 1), nrow(df) + 1)) - 1
  y[y != 0]
  }) %>%
  map_df(`length<-`, max(lengths(.)))

# A tibble: 4 x 10
     X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     2     1     2     1     2     3     2     2     2     3
2     1     1     2     2     2     1     1     2     1     1
3     1     2     1     2    NA     2     1    NA     1     2
4     2    NA     1     1    NA     1    NA    NA     1     1

Or same in base R:

res <- lapply(df, function(x) {
  y <- diff(c(0, which(x == 1), nrow(df) + 1)) - 1
  y[y != 0]})

data.frame(do.call(cbind, lapply(res, `length<-`, max(lengths(res)))))
Related