R: Добавяне на нули след стари нули във вектор?

Какво ще кажете просто да преминете през (приемайки няколко) N екземпляра:

addZeros <- function(x, N = 3) {
    xx <- x
    z <- x - 1
    for (i in 1:N) {
        xx <- xx + c(rep(0, i), z[-c((NROW(x) - i + 1):NROW(x))])
    }
    xx[xx<0] <- 0
    xx
}

Просто превръща всички нулеви екземпляри в -1, за да извади N следващи стойности.

> x <- c(1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,1,0,1)
> x
 [1] 1 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1
[39] 1 1 1 1 1 1 0 0 1 0 1
> addZeros(x)
 [1] 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1
[39] 1 1 1 1 1 1 0 0 0 0 0

РЕДАКТИРАНЕ:

След като прочетох вашето описание на данните в пощенския списък на R-help, това очевидно не е случай на малко N. Следователно, може да помислите за C функция за това.

Във файла "addZeros.c":

void addZeros(int *x, int *N, int *n)
{
    int i, j;

    for (i = *n - 1; i > 0; i--)
    {
        if ((x[i - 1] == 0) && (x[i] == 1))
        {
            j = 0;
            while ((j < *N) && (i + j < *n) && (x[i + j] == 1))
            {
                x[i + j] = 0;
                j++;
            }
        }
    }
}

В командния ред (MS DOS в Windows, натиснете Win+r и напишете cmd), напишете „R CMD SHLIB addZeros.c“. Ако пътят до R не е постижим (т.е. „неизвестна команда R“), трябва да посочите пълен адрес (в моята система:

"c:\Program Files\R\R-2.10.1\bin\R.exe" CMD SHLIB addZeros.c

В Windows това трябва да създаде DLL (.so в Linux), но ако все още нямате R-toolbox, трябва да го изтеглите и инсталирате (това е колекция от инструменти, като Perl и Mingw). Изтеглете най-новата версия от http://www.murdoch-sutherland.com/Rtools/

Функцията R обвивка за това ще бъде:

addZeros2 <- function(x, N) {
    if (!is.loaded("addZeros"))
        dyn.load(file.path(paste("addZeros", .Platform$dynlib.ext, sep = "")))
    .C("addZeros",
        x = as.integer(x),
        as.integer(N),
        as.integer(NROW(x)))$x
}

Имайте предвид, че работната директория в R трябва да бъде същата като DLL (в моята система setwd("C:/Users/eyjo/Documents/Forrit/R/addZeros")), преди функцията addZeros R да бъде извикана за първи път (алтернативно, в dyn.load просто включете пълния път до dll файла). Добра практика е да ги запазите в поддиректория под проекта (т.е. "c"), след което просто добавете "c/" пред "addZeros" в пътя на файла.

За да илюстрирам:

> x <- rbinom(1000000, 1, 0.9)
>
> system.time(addZeros(x, 10))
   user  system elapsed 
   0.45    0.14    0.59 
> system.time(addZeros(x, 400))
   user  system elapsed 
  15.87    3.70   19.64 
> 
> system.time(addZeros2(x, 10))
   user  system elapsed 
   0.01    0.02    0.03 
> system.time(addZeros2(x, 400))
   user  system elapsed 
   0.03    0.00    0.03 
> 

Където "addZeros" е моето първоначално предложение само с вътрешен R, а addZeros2 използва функцията C.

Можете също да направите това с rle. Всичко, което трябва да направите, е да добавите n към всички дължини, където стойността е 0, и да извадите n, когато стойността е 1 (внимавайте малко, когато има по-малко от n единици в редица). (Използване на метода на Грег за конструиране на извадката)

rr <- rle(tmp)
## Pad so that it always begins with 1 and ends with 1
if (rr$values[1] == 0) {
   rr$values <- c(1, rr$values)
   rr$lengths <- c(0, rr$lengths)  
}
if (rr$values[length(rr$values)] == 0) {
  rr$values <- c(rr$values, 1)
  rr$lengths <- c(rr$lengths, 0)  
}
zero.indices <- seq(from=2, to=length(rr$values), by=2)
one.indices <- seq(from=3, to=length(rr$values), by=2)
rr$lengths[zero.indices] <- rr$lengths[zero.indices] + pmin(rr$lengths[one.indices], n)
rr$lengths[one.indices] <- pmax(0, rr$lengths[one.indices] - n)
inverse.rle(rr)

Ето един начин:

> tmp <- strsplit('1111111100001111111111110000000001111111111100101','')
> tmp <- as.numeric(unlist(tmp))
> 
> n <- 3
> 
> tmp2 <- embed(tmp, n+1)
> 
> tmp3 <- tmp
> tmp3[ which( apply( tmp2, 1, function(x) any(x==0) ) ) + n ] <- 0
> 
> paste(tmp3, collapse='')
[1] "1111111100000001111111110000000000001111111100000"

дали това е по-добро от цикъл или не зависи от вас.

Това също няма да промени първите n елемента, ако там има 0.

ето друг начин:

> library(gtools)
> 
> tmpfun <- function(x) {
+ if(any(x==0)) {
+ 0
+ } else {
+ x[length(x)]
+ }
+ }
> 
> tmp4 <- running( tmp, width=4, fun=tmpfun, 
+ allow.fewer=TRUE )
> 
> tmp4 <- unlist(tmp4)
> paste(tmp4, collapse='')
[1] "1111111100000001111111110000000000001111111100000"
> 

За да продължа предишния си коментар, ако скоростта всъщност е проблем - преобразуването на вектора в низ и използването на регулярен израз може да бъде по-бързо от други решения. Първо функция:

replaceZero <- function(x,n){
    x <- gsub(paste("01.{",n-1,"}", sep = "") , paste(rep(0,n+1),collapse = ""), x)
}

Генериране на данни

z <- sample(0:1, 1000000, replace = TRUE)

z <- paste(z, collapse="")
repz <- replaceZero(z,3)
repz <- as.numeric(unlist(strsplit(repz, "")))

Системно време за свиване, изпълнение на регулярен израз и обратно разделяне във вектор:

Regex method
   user  system elapsed 
   2.39    0.04    2.39 
Greg's method
   user  system elapsed 
   17.m39    0.17   18.30
Jonathon's method
   user  system elapsed 
   2.47    0.02    2.31 

Наистина ми харесва идеята за използване на "регулярен израз" за това, така че гласувах за това. (Иска ми се да бях получил и rle отговор и да бях научил нещо от отговорите за вграждане и изпълнение. Страхотно!) Ето вариант на отговора на Chase, който според мен може да се справи с повдигнатите проблеми:

replaceZero2 <- function(x, n) {
  if (n == 0) {
    return(x)
  }
  xString <- paste(x, collapse="")
  result <- gsub(paste("(?<=",
             paste("01{", 0:(n - 1), "}", sep="", collapse="|"),
             ")1", sep=""),
       "0", xString, perl=TRUE)
  return(as.numeric(unlist(strsplit(result, ""))))
}

Изглежда, че това дава идентични резултати с rle метода на Chang за n = 1,2,3,4,5 на примерния вход на gd047.

Може би бихте могли да напишете това по-чисто, като използвате \K?

Самият аз намерих решение. Мисля, че е много лесно и не много бавно. Предполагам, че ако някой можеше да го компилира в C++, щеше да е много бързо, защото има само един цикъл.

f5 <- function(z, N) {
   x <- z
   count <- 0
   for (i in 1:length(z)) {
     if (z[i]==0) { count <- N }
     else {
       if (count >0) { 
          x[i] <- 0  
          count <- count-1 }
   }
}
x
}

Използването на подвижна минимална функция е много бързо, лесно и не зависи от разпределението на обхватите:

x <- rbinom(1000000, 1, 0.9)
system.time(movmin(x, 3, na.rm=T))
# user  system elapsed 
# 0.11    0.02    0.13 

Следната проста дефиниция на movmin е достатъчна (пълната функция има някои функционалности, излишни в този случай, като например използването на алгоритъма van Herk/Gil-Werman за големи N)

movmin = function(x, n, na.rm=F) {
  x = c(rep.int(NA, n - 1), x) # left pad
  do.call(pmin, c(lapply(1:n, function(i) x[i:(length(x) - n + i)]), na.rm=na.rm))
}

Всъщност имате нужда от размер на прозореца 4, защото засягате 3-те стойности след нула. Това съвпада с вашия f5:

x <- rbinom(1000000, 1, 0.9)
all.equal(f5(x, 3), movmin(x, 4, na.rm=T))
# [1] TRUE