如何在R中遇到0时填写前面的数字?

13

我有一个数字串:

n1 = c(1, 1, 0, 6, 0, 0, 10, 10, 11, 12, 0, 0, 19, 23, 0, 0)

我需要将0替换为紧挨在它前面的数字:

n2 = c(1, 1, 1, 6, 6, 6, 10, 10, 11, 12, 12, 12, 19, 23, 23, 23)

我怎样才能从n1到达n2?

先行感谢!


2
“0, 0, 0, 0” 的预期输出是什么? - Cruncher
5个回答

12
n2 <- n1[cummax(seq_along(n1) * (n1 != 0))]

2
n2 <- n1[cummax(seq_along(n1) * (!n1 %in% 0))] 似乎也适用于 NA - Arun
如何处理“NA”并没有明确定义。您可以轻松地根据OP选择的任何处理方式来调整我的建议,但我猜测他没有“NA”,否则他会提到它。 - flodel
1
flodel,对于这个OP可能是这样的。但对于那些以后会搜索的用户来说,考虑到尽可能多的情况肯定是有用的。 - Arun
+1 记住这个,引用 http://r.789695.n4.nabble.com/Replace-values-in-a-vector-td947747.html ... - Thell
你是在暗示我不是自己想出来的吗? - flodel
哈!绝不!我只是有点记不清它,尽管你一发帖我就记起_在哪儿_了。 - Thell

10

尝试使用来自包 zoona.locf()

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

这个函数将每个 NA 替换为其前面最近的非 NA 值。这就是为什么在应用该函数之前我将所有的 0 替换为了 NA

这里有一个关于类似问题的 讨论,虽然不完全相同。

编辑:如果 n1 最终由 NA 组成,请尝试使用以下方法:

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

编辑2: 对于c(1,NA,0)的这种方法返回c(1,NA,1)。 另外两个函数返回c(1,NA,NA)。 换句话说,这里我们将0替换为最后一个非缺失、非零值。选择您喜欢的选项。

编辑3: 受@Thell的Rcpp解决方案启发,我想再添加一个-这次使用“纯”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++")

在这种情况下,我们将得到c(1,NA,NA),对于c(1,NA,0)。一些基准测试:


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

@thelatemail:谢谢您注意到这个问题。 - gagolews
更新:已经编辑了基准测试,发现这种方法在处理NA时存在一些问题。 - Arun
1
@Arun 检查 dt_fun(c(1, NA, 0)) - GSee
1
@Arun 在我看来,对于 c(1,NA,0),我们应该得到 c(1,NA,1)(我更喜欢这个),还是 c(1,NA,NA),这是一个解释的问题。OP 没有明确表达他/她想要什么,所以我们可以自由发挥。 :) - gagolews
如果数字只有0和NA,你的结果会是什么?例如c(0, NA)?还可以尝试c(NA, 0) - 它会忽略最后一个0。 - Arun
这可能是一个特定于领域的问题。除非@user3193265告诉我们他/她为什么需要这样的函数,否则我们将永远不会知道 :)也许他/她根本不关心NA?顺便说一句,我喜欢在SO上留下一些自由度的问题。我很崇拜那些关于某个主题有激烈讨论的案例,就像这里一样。 :) - gagolews

9
这里是使用"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)

以下是基准测试结果:

# 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

1
是否考虑在bm列表中添加一个Rcpp解决方案? - Thell

6
因为rle是万能的解决方法:
#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

跳过NA的版本如下:
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

我永远不会知道你们最初是如何知道如何做到这一点的。谢谢! - wen

6

不要忘记 Rcpp 的简单性和性能提升...

使用 Arun 的样本大小,我得到...

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
.cpp 文件是源文件,它只是...
#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;
}

以上代码存在一些问题:它会改变输入向量的形式(在调用前后n1不同)。请使用例如NumericVector out = Rcpp :: clone(v); - gagolews

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接