R: Mutate last sequence of specific values-CodePudding

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

CodePudding user response：

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

CodePudding user response：

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

CodePudding user response：

purrr::map variant

.x[1:which(.x != 1)[2] finds the last column row that does not equal 1

rep(0, length(.x) - length(.x[1:which(.x != 1)[2]] adds zero's for the difference in length between the column and the last row without a 1.

library(purrr)

map_dfc(c, ~ c(.x[1:which(.x != 1)[2]], rep(0, length(.x) - length(.x[1:which(.x != 1)[2]]) ) ))