найти максимальное количество последовательных 1 в строке?

Question

Есть ли простой способ получить максимальное количество последовательных 1 в строке, например: "000010011100011111001111111100"?

Я, безусловно, могу сделать это с помощью циклов, но я бы хотел избежать этого, так как мой фактический набор данных имеет около 500 000 записей.

Спасибо за вашу помощь заранее.

Answer 1

Использование rle:

x <- "000010011100011111001111111100" 
rr <- rle(strsplit(x,"")[[1]]) 

Run Length Encoding 
    lengths: int [1:9] 4 1 2 3 3 5 2 8 2 
    values : chr [1:9] "0" "1" "0" "1" "0" "1" "0" "1" "0" 

Примечание: я удалил as.numeric часть, как это не нужно. Отсюда вы можете получить максимальное количество последовательных 1 с:

max(rr$lengths[which(rr$values == "1")]) 
# [1] 8 

Answer 2

Использование rle медленнее и немного более неуклюжим, чем с помощью регулярных выражений. В Thomas' answer, вы все еще остались, чтобы извлечь максимальную длину, когда значения равны 1.

# make some data 
set.seed(21) 
N <- 1e5 
s <- sample(c("0","1"), N*30, TRUE) 
s <- split(s, rep(1:N, each=30)) 
s <- sapply(s, paste, collapse="") 
# Thomas' (complete) answer 
r <- function(S) { 
    sapply(S, function(x) { 
    rl <- rle(as.numeric(strsplit(x,"")[[1]])) 
    max(rl$lengths[rl$values==1]) 
    }) 
} 
# using regular expressions 
g <- function(S) sapply(gregexpr("1*",S), 
    function(x) max(attr(x,'match.length'))) 
# timing 
system.time(R <- r(s)) 
# user system elapsed 
# 6.41 0.00 6.41 
system.time(G <- g(s)) 
# user system elapsed 
# 1.47 0.00 1.46 
all.equal(R,G) 
# [1] "names for target but not for current" 

Answer 3

Альтернативы гораздо быстрее путем без использования rle бы разделить с последовательным 0 'следующим образом:

# following thelatemail's comment, changed '0+' to '[^1]+' 
strsplit(x, "[^1]+", perl=TRUE) 

Затем вы можете запрограммировать и получить максимальные символы для каждого элемента вашего списка. Это будет быстрее, чем rle решение. и также быстрее, чем решение gregexpr от @Joshua. Некоторые бенчмаркинг ...

zz <- function(x) { 
    vapply(strsplit(x, "[^1]+", perl=TRUE), function(x) max(nchar(x)), 0L) 
} 

Я просто понял, что @ функции Джошуа также может быть изменен путем добавления perl=TRUE и использования vapply. Итак, я сравню это.

g2 <- function(S) vapply(gregexpr("1*",S, perl=TRUE), 
    function(x) max(attr(x,'match.length')), 0L) 

require(microbenchmark) 
microbenchmark(t1 <- zz(unname(s)), t2 <- g(unname(s)), t3 <- g2(unname(s)), times=50) 
Unit: seconds 
       expr  min  lq median  uq  max neval 
t1 <- zz(unname(s)) 1.187197 1.285065 1.344371 1.497564 1.565481 50 
    t2 <- g(unname(s)) 2.154038 2.307953 2.357789 2.417259 2.596787 50 
t3 <- g2(unname(s)) 1.562661 1.854143 1.914597 1.954795 2.203543 50 

identical(t1, t2) # [1] TRUE 
identical(t1, t3) # [1] TRUE