R: Добавление нулей после старых нулей в векторе? - PullRequest
Новая
       15

R: Добавление нулей после старых нулей в векторе?

0 голосов
/ 10 сентября 2010

Представьте, что у меня есть вектор с единицами и нулями

Я пишу это компактно:

1111111100001111111111110000000001111111111100101

Мне нужно получить новый вектор, заменив "N" после нулей на новые.

Например, для N = 3.

1111111100001111111111110000000001111111111100101 становится 1111111100000001111111110000000000001111111100000

Я могу сделать это с помощью цикла for, но я прочитал, что это не очень хорошая практика. Как я могу это сделать тогда?

ура

Мой вектор - зоопарк, но, думаю, это не имеет значения. Если бы я хотел нули до конца, я бы использовал cumprod.

Ответы [ 8 ]

5 голосов
/ 10 сентября 2010

Вы также можете сделать это с 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)
3 голосов
/ 11 сентября 2010

Как насчет просто циклического обхода (при условии нескольких) 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.

2 голосов
/ 11 сентября 2010 
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,1,0,1)

n <- 3
z<-rle(x)
tmp <- cumsum(z$lengths)

for (i in seq(which.min(z$values),max(which(z$values==1)),2)) {
         if  (z$lengths[i+1] < n)   x[tmp[i]:(tmp[i] + z$lengths[i+1])] <- 0
         else                       x[tmp[i]:(tmp[i]+n)] <- 0
}
1 голос
/ 12 сентября 2010

Мне очень нравится идея использовать «регулярное выражение» для этого, поэтому я проголосовал за это.(Хотелось бы, чтобы я тоже получил правильный ответ и узнал что-то из встроенных и запущенных ответов. Аккуратно!) Вот вариант ответа Чейза, который, я думаю, может решить поднятые вопросы:вывести результаты, идентичные методу Чана для n = 1,2,3,4,5 на примере ввода gd047.

Может быть, вы могли бы написать это более чисто, используя \ K?

1 голос
/ 11 сентября 2010

В продолжение моего предыдущего комментария, если скорость на самом деле вызывает беспокойство - преобразование вектора в строку и использование регулярных выражений может оказаться быстрее, чем другие решения.Сначала функция: 

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
1 голос
/ 10 сентября 2010

Вот один из способов: 

> 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"

независимо от того, лучше ли это, чем цикл, или нет, решать только вам.

Это также не изменит 1-е 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"
>
0 голосов
/ 14 сентября 2010

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

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

Достаточно следующего простого определения movmin (полная функция имеет некоторую функциональность, избыточную в этом случаенапример, использование алгоритма Ван Херка / Гиль-Вермана для больших 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
0 голосов
/ 12 сентября 2010

Я сам нашел решение.Я думаю, что это очень легко и не очень медленно.Я думаю, если бы кто-то мог скомпилировать его в C ++, это было бы очень быстро, потому что он имеет только один цикл.

...