CODEWITHSUNDEEP
rmatrix
Ondřej Lhotka
Ondřej Lhotka

Reputation: 37

R: Preserve consecutive numbers in matrix

In a vector composed of 0 and 1, the '1' should be preserved only if there are at least three consecutive '1'. Here is an example: 

x=c(0,0,0,0,0,1,1,0,1,0,0,1,1,0,1,1,1,0,0,0)

x_consecutive=numeric() 
for (i in 1:20)
  x_consecutive[i]=((x[i]>0) & (x[i+1]>0) & (x[i+2]>0)) | ((x[i]>0) & (x[i+1]>0) & (x[i-1]>0)) | ((x[i]>0) & (x[i-1]>0) & (x[i-2]>0)) 

x_consecutive
 [1] NA NA  0  0  0  0  0  0  0  0  0  0  0  0  1  1  1  0  0  0

This works quite well for me, but I need to perform this operation for all rows of a matrix like this:

matrix(sample(c(0:1),50, replace=T), nrow=5, ncol=10)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    1    1    1    1    1    0    1    1    0     1
[2,]    0    0    0    0    0    1    1    1    0     0
[3,]    1    1    1    1    0    0    1    1    1     0
[4,]    1    0    0    1    0    0    0    0    1     1
[5,]    0    0    0    1    1    0    1    1    0     0

To be transformed into this:

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    1    1    1    1    1    0    0    0    0     0
[2,]    0    0    0    0    0    1    1    1    0     0
[3,]    1    1    1    1    0    0    1    1    1     0
[4,]    0    0    0    0    0    0    0    0    0     0
[5,]    0    0    0    0    0    0    0    0    0     0

Is there a some smooth solution?

Upvotes: 1

Views: 67

Answers (2)

user2100721
user2100721

Reputation: 3587

Another approach using @akrun's m1 maybe

t(apply(m1,1,function(t) rep(ifelse(rle(t)$lengths>2,1,0),rle(t)$lengths)))

Or 

t(apply(m1,1, function(t) with(rle(t), rep(as.integer(lengths>2),lengths))))

Upvotes: 0

akrun
akrun

Reputation: 887168

We can use rle on the logical vector (x==1), change the 'values' where the lengths is less than 3 and are 1 to 'FALSE', use inverse.rle to reconvert it back to the original vector.

x1 <- as.integer(inverse.rle(within.list(rle(x==1), 
         values[lengths < 3 & values] <- FALSE)))
x1
#[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0

This can be applied to all the rows of the matrix with apply

t(apply(m1, 1, FUN = function(x) as.integer(inverse.rle(within.list(rle(x==1), 
         values[lengths < 3 & values] <- FALSE)))))
#    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,]    1    1    1    1    1    0    0    0    0     0
#[2,]    0    0    0    0    0    1    1    1    0     0
#[3,]    1    1    1    1    0    0    1    1    1     0
#[4,]    0    0    0    0    0    0    0    0    0     0
#[5,]    0    0    0    0    0    0    0    0    0     0

The above code can be also made slightly compact without undermining the efficiency by

t(apply(m1, 1, FUN = function(x) inverse.rle(within.list(rle(x),
                 values[lengths < 3] <- 0))))

NOTE: Here I am calling rle only once and not many times.

data

m1 <- structure(c(1L, 0L, 1L, 1L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 
0L, 0L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 
0L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 
1L, 0L, 0L, 1L, 0L), .Dim = c(5L, 10L))

Upvotes: 3

Related Questions