R: La adición de ceros ceros viejos en un vector?
https://stackoverflow.com/questions/3686982
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPregunta
Imagínese que tengo un vector con unos y ceros
Lo escribo de forma compacta:
1111111100001111111111110000000001111111111100101
Tengo que conseguir un nuevo vector de sustitución de los "N" a raíz de los ceros a nuevos ceros.
Por ejemplo, para N = 3.
1111111100001111111111110000000001111111111100101 convierte 1111111100000001111111110000000000001111111100000
Me puede hacerlo con un bucle pero yo he leído no es una práctica bien, ¿Cómo puedo hacer entonces?
aplausos
Mi vector es una serie zoológico, de hecho, pero supongo que no hace ninguna diferencia. Si quería ceros hasta terminar me gustaría utilizar cumprod.
Solución
Cómo sobre apenas bucle a través de la (suponiendo pocos) N instancias:
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
}
Simplemente convierte todas las instancias cero en -1 con el fin de restar el N valores de éxito.
> 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
EDIT:
Después de leer su descripción de los datos de la lista de correo R-ayuda, esto claramente no es un caso de pequeña N. Por lo tanto, es posible que desee considerar una función C para esto.
En el archivo "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++;
}
}
}
}
En el símbolo del sistema (MS DOS en Windows, presione Win + R y cmd escritura), de escritura "R CMD shlib addZeros.c". Si la ruta a R no es posible (es decir, "Kommand desconocida R") que necesita para indicar la dirección completa (en mi sistema:
"c:\Program Files\R\R-2.10.1\bin\R.exe" CMD SHLIB addZeros.c
En Windows esto debería producir una DLL (.so en Linux), pero si usted no tiene ya el R-caja de herramientas que debe descargarlo e instalarlo (que es una colección de herramientas, tales como Perl y Mingw). Descargue la versión más reciente de http://www.murdoch-sutherland.com/Rtools/
La función R envoltura para esto sería:
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
}
Tenga en cuenta que el directorio de trabajo en I debe ser la misma que la DLL (en mi setwd("C:/Users/eyjo/Documents/Forrit/R/addZeros") sistema) antes de la función addZeros R se llama la primera vez (como alternativa, en dyn.load basta con incluir la ruta completa al archivo DLL). Es una buena práctica para mantener estos en un subdirectorio bajo el proyecto (es decir, "c"), a continuación, sólo tiene que añadir "c /" delante de "addZeros" en la ruta del archivo.
Para ilustrar:
> 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
>
Cuando los "addZeros" es mi sugerencia original con R simplemente interna y addZeros2 está utilizando la función C.
Otros consejos
También puede hacer esto con rle. Todo lo que necesita hacer es añadir n a todas las longitudes donde el valor es 0 y restar n cuando el valor es 1 (por ser un poco cuidadoso cuando hay menos de n queridos en una fila). (Usando el método de Greg para la construcción de la muestra)
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)
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
}
Esta es una manera:
> 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"
si esto es mejor que un bucle o no depende de usted.
Esto también no cambia la primera n elementos si hay un 0.
aquí es otra manera:
> 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"
>
Para dar seguimiento a mi comentario anterior, si la velocidad es de hecho una preocupación - convertir el vector en una cadena y el uso de expresiones regulares bien puede ser más rápido que otras soluciones. Primera función:
replaceZero <- function(x,n){
x <- gsub(paste("01.{",n-1,"}", sep = "") , paste(rep(0,n+1),collapse = ""), x)
}
Generar datos
z <- sample(0:1, 1000000, replace = TRUE)
z <- paste(z, collapse="")
repz <- replaceZero(z,3)
repz <- as.numeric(unlist(strsplit(repz, "")))
La hora del sistema a un colapso, ejecución de expresiones regulares, y de vuelta en el vector de división:
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
A mi me gusta la idea de usar una "expresión regular" para esto, así que di un voto para eso. (Hubiera gustado haber conseguido una respuesta en RLE también y aprendido algo de la inserción y respuestas ejecutan aseado.!) Aquí hay una variación en la respuesta de Chase que creo que puede abordar las cuestiones planteadas:
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, ""))))
}
Esto parece producir resultados idénticos a método rle de Chang para n = 1,2,3,4,5 en ejemplo de entrada de gd047.
Tal vez usted podría escribir esta utilizando de forma más limpia \ K?
he encontrado una solución a mí mismo. Creo que es muy fácil y no muy lento. Creo que si alguien puede compilar en C ++ sería muy rápido, ya que tiene un solo bucle.
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
}
El uso de una función mínima en movimiento es muy rápido y sencillo, y no depende de la distribución de los vanos:
x <- rbinom(1000000, 1, 0.9)
system.time(movmin(x, 3, na.rm=T))
# user system elapsed
# 0.11 0.02 0.13
La siguiente definición simple de basta movmin (la función completa tiene algunos superfluo funcionalidad para este caso, tal como utilizando el algoritmo van Herk / Gil-Werman para gran 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))
}
En realidad se necesita un tamaño de ventana de 4, ya que afecta los 3 valores siguientes un cero. Esto coincide con su f5:
x <- rbinom(1000000, 1, 0.9)
all.equal(f5(x, 3), movmin(x, 4, na.rm=T))
# [1] TRUE
