R: Aggiunta zeri vecchi zeri in un vettore?
https://stackoverflow.com/questions/3686982
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianDomanda
Immaginate Ho un vettore con zeri e di uno
Io lo scrivo in modo compatto:
1111111100001111111111110000000001111111111100101
ho bisogno di ottenere un nuovo vettore che sostituisce la "n" quelli seguenti gli zeri ai nuovi zeri.
Ad esempio per N = 3.
1111111100001111111111110000000001111111111100101 diventa 1111111100000001111111110000000000001111111100000
posso farlo con un ciclo for, ma ho letto'VE non è una pratica buona, Come posso farlo allora?
applausi
Il mio vettore è una serie zoo, anzi, ma credo che non fa alcuna differenza. Se volevo zeri fino alla fine avrei usato cumprod.
Soluzione
Come circa appena scorrendo il (assumendo pochi) casi 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
}
Semplicemente trasforma tutti a zero i casi in -1 per sottrarre il N valori successivi.
> 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:
Dopo aver letto la tua descrizione dei dati nella mailing list R-aiuto, questo non è chiaramente un caso di piccola N. Quindi, si potrebbe prendere in considerazione una funzione C per questo.
Nel file "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++;
}
}
}
}
Prompt dei comandi (MS DOS a Windows, premere Win + R e cmd scrittura), write "R CMD shlib addZeros.c". Se il percorso R non è raggiungibile (vale a dire "sconosciuto Kommand R") è necessario dichiarare l'indirizzo completo (sul mio sistema:
"c:\Program Files\R\R-2.10.1\bin\R.exe" CMD SHLIB addZeros.c
In Windows questo dovrebbe produrre una DLL (.so in Linux), ma se non si dispone già di R-Toolbox è necessario scaricare e installare (si tratta di una collezione di strumenti, come Perl e Mingw). Scaricare l'ultima versione da http://www.murdoch-sutherland.com/Rtools/
La funzione R wrapper per questo potrebbe essere:
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
}
Si noti che la directory di lavoro in R dovrebbe essere lo stesso del DLL (sul mio sistema setwd("C:/Users/eyjo/Documents/Forrit/R/addZeros")) prima che la funzione addZeros R viene chiamato per la prima volta (in alternativa, in dyn.load sufficiente includere il percorso completo del file dll). E 'buona norma mantenere questi in una sottodirectory nell'ambito del progetto (vale a dire "c"), poi basta aggiungere "c /" davanti "addZeros" nel percorso del file.
Per illustrare:
> 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
>
dove i "addZeros" è il mio suggerimento originale con R solo interno, e addZeros2 sta usando la funzione C.
Altri suggerimenti
Si può anche fare questo con rle. Tutto quello che dovete fare è aggiungere n a tutte le lunghezze in cui il valore è 0 e sottrarre n quando il valore è 1 (essere un po 'attenti quando ci sono meno di n quelli di fila). (Usando il metodo di Greg per la costruzione del campione)
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
}
Ecco un modo:
> 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"
se questo è meglio di un ciclo o meno spetta a voi.
In questo modo, inoltre, non cambia il 1 ° n elementi se c'è un 0 lì.
Ecco un altro modo:
> 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"
>
Per il follow-up sul mio commento precedente, se la velocità è in realtà una preoccupazione - la conversione del vettore in una stringa e l'utilizzo di espressioni regolari potrebbe essere più veloce rispetto ad altre soluzioni. In primo luogo una funzione:
replaceZero <- function(x,n){
x <- gsub(paste("01.{",n-1,"}", sep = "") , paste(rep(0,n+1),collapse = ""), x)
}
Genera dati
z <- sample(0:1, 1000000, replace = TRUE)
z <- paste(z, collapse="")
repz <- replaceZero(z,3)
repz <- as.numeric(unlist(strsplit(repz, "")))
Ora di sistema al collasso, regex corsa, e di nuovo suddivisa in vettore:
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
Mi piace molto l'idea di utilizzare un "espressione regolare" per questo così ho dato un voto per questo. (Vorrei avere ottenuto una risposta RLE troppo e imparato qualcosa dalla sovrastante e risposte in esecuzione Neat.!) Ecco una variazione sul risposta di Chase che penso possa affrontare le questioni sollevate:
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, ""))))
}
Questo sembra produrre risultati identici a metodo RLE di Chang per n = 1,2,3,4,5 sull'ingresso esempio di gd047.
Forse si potrebbe scrivere questo in modo più pulito utilizzando \ K?
ho trovato una soluzione io stesso. Penso che sia molto semplice e non molto lento. Credo che se qualcuno potrebbe compilarlo in C ++ che sarebbe stato molto veloce perché ha un solo ciclo.
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
}
Utilizzando una funzione minimo movimento è molto veloce, semplice, e non dipende dalla distribuzione delle campate:
x <- rbinom(1000000, 1, 0.9)
system.time(movmin(x, 3, na.rm=T))
# user system elapsed
# 0.11 0.02 0.13
Il seguente semplice definizione di suffissi movmin (la funzione completa ha alcune funzionalità superfluo questo caso, ad esempio utilizzando l'algoritmo van Herk / Gil-Werman per N grande)
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))
}
In realtà si ha bisogno di una dimensione della finestra di 4 perché si influenzano i 3 valori seguenti uno zero. Questo corrisponde al tuo f5:
x <- rbinom(1000000, 1, 0.9)
all.equal(f5(x, 3), movmin(x, 4, na.rm=T))
# [1] TRUE
