R: Mutate last sequence of specific values

user_17570583 0
Viewed 101

I have a dataframe containing columns with 0's and 1's. I want to mutate the last sequence of 1's into zeros like this:

# data
  
a <- c(0,1,1,0,1,1,1)
b <- c(0,1,1,1,0,1,1)

c <- data.frame(cbind(a,b))
head(c,7)

# desired output

a_desired <- c(0,1,1,0,0,0,0)
b_desired <- c(0,1,1,1,0,0,0)

c_desired <- data.frame(cbind(a_desired,b_desired))
head(c_desired,7)

such that I end up with the same sequence except that the last sequence of 1's has been mutated into 0's. I've tried using tail() but haven't found a solution so far

dataframe sequence r
5 Answers

You may try using rle

apply(c, 2, function(x){
  y <- max(which(rle(x == 1)$values))
  x[(sum(rle(x == 1)$lengths[1:(y-1)]) + 1): sum(rle(x == 1)$lengths[1:y])] <- 0
  x
})

     a b
[1,] 0 0
[2,] 1 1
[3,] 1 1
[4,] 0 1
[5,] 0 0
[6,] 0 0
[7,] 0 0
user_167291750

purrr::map variant

library(purrr)

map(c, function(x){
  
  last1 <- max(which(x == 1))
  last0 <- which(x[1:last1] == 0)
  
  c(x[seq_len(max(last0))], rep(0, length(x) - max(last0))) 

})
Admin1

You can try a combination of cumsum of x == 0 and replace the values where this is equal to max.

sapply(c, function(x) {
  . <- cumsum(diff(c(0,x)==1)==1)
  `[<-`(x, . == max(.), 0L)
  #replace(x, . == max(.), 0L) #Alternaive to [<-
})
#     a b
#[1,] 0 0
#[2,] 1 1
#[3,] 1 1
#[4,] 0 1
#[5,] 0 0
#[6,] 0 0
#[7,] 0 0

Or the same but written i a different way (thanks to @thelatemail )

sapply(c, function(x) {
  cs <- cumsum(diff(c(0,x)==1)==1)
  x[cs == max(cs)] <- 0L
  x
})

Or another variant iterating from the last element to the beginning until 0 is found.

sapply(c, function(x) {
  n <- length(x)
  i <- n
  while(x[i] != 1 & i>1L) i <- i-1L
  while(x[i] != 0 & i>1L) i <- i-1L
  x[i:n] <- 0L
  x  
})
user_104885040

You can write your own function:

fun <- function(x){
  y <- rle(x)
  y$values[length(y$values)] <- 0
  inverse.rle(y)
}

Now run:

data.frame(sapply(c, fun))
  a b
1 0 0
2 1 1
3 1 1
4 0 1
5 0 0
6 0 0
7 0 0
user_83802720

If you sequences always end with 1s, you can try (given df <- data.frame(a,b))

> df * sapply(df, function(x) rev(cumsum(rev(x != 1)) != 0))
  a b
1 0 0
2 1 1
3 1 1
4 0 1
5 0 0
6 0 0
7 0 0
user_121587570
Related