I have a string of numbers:
n1 = c(1, 1, 0, 6, 0, 0, 10, 10, 11, 12, 0, 0, 19, 23, 0, 0)
I need to replace 0 with the corresponding number righ
Here's a solution using data.table
:
require(data.table) ## >= 1.9.2
idx = which(!n1 %in% 0L)
DT <- data.table(val=n1[idx], idx=idx)
setattr(DT, 'sorted', "idx")
n1 = DT[J(seq_along(n1)), roll=Inf]$val
# [1] 1 1 1 6 6 6 10 10 11 12 12 12 19 23 23 23
require(zoo)
require(data.table)
set.seed(1L)
n1 = sample(c(0:10), 1e6, TRUE)
## data.table
dt_fun <- function(n1) {
idx = which(!n1 %in% 0L)
DT <- data.table(val=n1[idx], idx=idx)
setattr(DT, 'sorted', "idx")
DT[J(seq_along(n1)), roll=Inf]$val
}
# na.locf from zoo - gagolews
zoo_fun <- function(n1) {
wh_na <- which(is.na(n1))
n1[n1 == 0] <- NA
n2 <- na.locf(n1)
n2[wh_na] <- NA
n2
}
## rle - thelatemail
rle_fun <- function(n1) {
r <- rle(n1)
r$values[which(r$values==0)] <- r$values[which(r$values==0)-1]
inverse.rle(r)
}
flodel_fun <- function(n1) n1[cummax(seq_along(n1) * (n1 != 0))]
require(microbenchmark)
microbenchmark(a1 <- dt_fun(n1),
a2 <- zoo_fun(n1),
a3 <- rle_fun(n1),
a4 <- flodel_fun(n1), times=10L)
Here's the benchmarking result:
# Unit: milliseconds
# expr min lq median uq max neval
# a1 <- dt_fun(n1) 155.49495 164.04133 199.39133 243.22995 289.80908 10
# a2 <- zoo_fun(n1) 596.33039 632.07841 671.51439 682.85950 697.33500 10
# a3 <- rle_fun(n1) 356.95103 377.61284 383.63109 406.79794 495.09942 10
# a4 <- flodel_fun(n1) 51.52259 55.54499 56.20325 56.39517 60.15248 10
Don't forget the simplicity and performance gain of Rcpp...
Using Arun's sample size I get...
Unit: milliseconds
expr min lq median uq max neval
rollValue(n1) 3.998953 4.105954 5.803294 8.774286 36.52492 100
n1[cummax(seq_along(n1) * (n1 != 0))] 17.634569 18.295344 20.698524 23.104847 74.72795 100
The .cpp
file to source is simply...
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::plugins("cpp11")]]
// [[Rcpp::export]]
NumericVector rollValue(const NumericVector v) {
auto out = clone(v);
auto tmp = v[0];
for( auto & e : out) {
if( e == 0 ) {
e = tmp;
continue;
}
tmp = e;
}
return out;
}
Try na.locf()
from the package zoo
:
library(zoo)
n1 <- c(1, 1, 0, 6, 0, 0, 10, 10, 11, 12, 0, 0, 19, 23, 0, 0)
n1[n1 == 0] <- NA
na.locf(n1)
## [1] 1 1 1 6 6 6 10 10 11 12 12 12 19 23 23 23
This function replaces each NA
with the most recent non-NA
prior to it. This is why I substituted all 0
s with NA
before applying it.
Here's a discussion on a similar (yet not identical) issue.
EDIT: If n1
eventually consists of NA
s, try e.g.
n1 <- c(1, 1, 0, 6, 0, 0, 10, NA, 11, 12, 0, 0, 19, NA, 0, 0)
wh_na <- which(is.na(n1))
n1[n1 == 0] <- NA
n2 <- na.locf(n1)
n2[wh_na] <- NA
n2
## [1] 1 1 1 6 6 6 10 NA 11 12 12 12 19 NA 19 19
EDIT2: This approach for c(1,NA,0)
returns c(1,NA,1)
. The other two funs give c(1,NA,NA)
. In other words, here we're replacing 0 with last non-missing, non-zero value. Choose your favourite option.
EDIT3: Inspired by @Thell's Rcpp solution, I'd like to add another one - this time using "pure" R/C API.
library('inline')
sexp0 <- cfunction(signature(x="numeric"), "
x = Rf_coerceVector(x, INTSXP); // will not work for factors
R_len_t n = LENGTH(x);
SEXP ret;
PROTECT(ret = Rf_allocVector(INTSXP, n));
int lval = NA_INTEGER;
int* xin = INTEGER(x);
int* rin = INTEGER(ret);
for (R_len_t i=0; i<n; ++i, ++xin, ++rin) {
if (*xin == 0)
*rin = lval;
else {
lval = *xin;
*rin = lval;
}
}
UNPROTECT(1);
return ret;
", language="C++")
In this case we will get c(1,NA,NA)
for c(1,NA,0)
. Some benchmarks:
library(microbenchmark)
set.seed(1L)
n1 <- sample(c(0:10), 1e6, TRUE)
microbenchmark(sexp0(n1), rollValue(n1), n1[cummax(seq_along(n1) * (n1 != 0))])
## Unit: milliseconds
## expr min lq median uq max neval
## sexp0(n1) 2.468588 2.494233 3.198711 4.216908 63.21236 100
## rollValue(n1) 8.151000 9.359731 10.603078 12.760594 75.88901 100
## n1[cummax(seq_along(n1) * (n1 != 0))] 32.899420 36.956711 39.673726 45.419449 106.48180 100
Because rle
is the answer to everything:
#make an example including an NA value
n1 <- c(1, 1, 0, 6, NA, 0, 10, 10, 11, 12, 0, 0, 19, 23, 0, 0)
r <- rle(n1)
r$values[which(r$values==0)] <- r$values[which(r$values==0)-1]
inverse.rle(r)
# [1] 1 1 1 6 NA NA 10 10 11 12 12 12 19 23 23 23
A version that skips NA
s would be:
n1 <- c(1, 1, 0, 6, NA, 0, 10, 10, 11, 12, 0, 0, 19, 23, 0, 0)
r <- rle(n1[!is.na(n1)])
r$values[which(r$values==0)] <- r$values[which(r$values==0)-1]
n1[!is.na(n1)] <- inverse.rle(r)
n1
# [1] 1 1 1 6 NA 6 10 10 11 12 12 12 19 23 23 23
n2 <- n1[cummax(seq_along(n1) * (n1 != 0))]