Question

我有一个随机向量vec，并且想在不使用循环的情况下制作一个新向量L。 L的新元素取决于L和vec的旧元素。

set.seed(0)

vec <- rnorm(20,0)
i = 2; 
N <- length(vec) -1
L <- numeric(N-1)
constant <- 0.6

while (i < N){  

  L[i] = vec[i + 1] - vec[i] - constant * L[i - 1]

  i <- i + 1          
}

L
#  [1]  0.0000000  1.6560326 -1.0509895 -0.2271942 -1.8182750  1.7023480 -0.3875622  0.5214906  2.0975262 -2.8995756  0.1771427
# [12] -0.4549334  1.1311555 -0.6884468  0.3007724  0.4832709 -1.4341071  2.1880687

Answer 1

你想要

L[1] = 0
L[i] = -constant * L[i - 1] + (vec[i + 1] - vec[i]),  i = 2, 3, ...,

让dv <- diff(vec)，第二行变成

L[i] = -constant * L[i - 1] + dv[i],  i = 2, 3, ...

具有滞后1自相关-constant和创新dv[-1]的AR1流程。 filter使用“递归”方法可以有效地生成AR1过程。

dv <- diff(vec)
L <- c(0, filter(dv[-1], -constant, "recursive"))

# [1]  0.0000000  1.6560326 -1.0509895 -0.2271942 -1.8182750  1.7023480
# [7] -0.3875622  0.5214906  2.0975262 -2.8995756  0.1771427 -0.4549334
#[13]  1.1311555 -0.6884468  0.3007724  0.4832709 -1.4341071  2.1880687
#[19] -2.9860629

我想您的意思是while (i <= N)。如果您确实想要i < N，则必须摆脱上面的最后一个元素。可以通过

完成

dv <- diff(vec)
L <- c(0, filter(dv[2:(length(dv) - 1)], -constant, "recursive"))

小时后...

Rui Barradas的基准引起了我的注意。简而言之vec，任何方法都足够快。对于vec而言，filter肯定会更快，但实际上会受到filter的期望并返回“ ts”（时间序列）对象的强迫。最好直接调用其主力C例程：

AR1_FILTER <- function (x, filter, full = TRUE) {
  n <- length(x)
  AR1 <- .Call(stats:::C_rfilter, as.double(x), as.double(filter), double(n + 1L))
  if (!full) AR1 <- AR1[-1L]
  AR1
  }

dv <- diff(vec)
L <- AR1_FILTER(dv[-1], -constant)
#L <- AR1_FILTER(dv[2:(length(dv) - 1)], -constant)

我对将AR1_FILTER与R级循环进行比较不感兴趣。我将其与filter进行比较。

library(microbenchmark)
v <- runif(100000)
microbenchmark("R" = c(0, filter(v, -0.6, "recursive")),
               "C" = AR1_FILTER(v, -0.6))

Unit: milliseconds
 expr      min       lq     mean   median       uq       max neval
    R 6.803945 7.987209 11.08361 8.074241 9.131967 54.672610   100
    C 2.586143 2.606998  2.76218 2.644068 2.660831  3.845041   100

Answer 2

当您必须基于先前的值来计算值时，通用答案是否，没有办法解决循环。

在您的情况下，我将使用for循环。更简单。

M <- numeric(N - 1)
for(i in seq_len(N)[-N])
  M[i] = vec[i + 1] - vec[i] - constant*M[i - 1]

identical(L, M)
#[1] TRUE

请注意使用seq_len，而不是2:(N - 1)。

编辑。

我已经自己和用户李哲源对解决方案进行了计时。结果显然有利于我的解决方案。

f1 <- function(vec, constant = 0.6){
  N <- length(vec) - 1
  M <- numeric(N - 1)
  for(i in seq_len(N)[-c(1, N)]){
    M[i] = vec[i + 1] - vec[i] - constant*M[i - 1]
  }
  M
}

f2 <- function(vec, constant = 0.6){
  dv <- diff(vec)
  c(0, c(stats::filter(dv[2:(length(dv) - 1)], -constant, "recursive")) )
}

L1 <- f1(vec)
L2 <- f2(vec)

identical(L, L1)
identical(L, L2)

microbenchmark::microbenchmark(
  loop = f1(vec),
  filter = f2(vec)
)

在我的PC上，中位数的比率使我的代码快11倍。

Answer 3

我当时正在考虑使用Rcpp，但是答案之一提到rfilter内置在R中，所以我进行了检查：

/* recursive filtering */
SEXP rfilter(SEXP x, SEXP filter, SEXP out)
{
   if (TYPEOF(x) != REALSXP || TYPEOF(filter) != REALSXP
       || TYPEOF(out) != REALSXP) error("invalid input");
    R_xlen_t nx = XLENGTH(x), nf = XLENGTH(filter);
    double sum, tmp, *r = REAL(out), *rx = REAL(x), *rf = REAL(filter);

    for(R_xlen_t i = 0; i < nx; i++) {
    sum = rx[i];
    for (R_xlen_t j = 0; j < nf; j++) {
        tmp = r[nf + i - j - 1];
        if(my_isok(tmp)) sum += tmp * rf[j];
        else { r[nf + i] = NA_REAL; goto bad3; }
    }
    r[nf + i] = sum;
    bad3:
    continue;
    }
    return out;
}

该功能已经很漂亮了，我认为我不能编写一个Rcpp来大大改进它。我在接受的答案中对此rfilter和f1函数进行了基准测试：

f1 <- function(vec, constant = 0.6){
  N <- length(vec) - 1
  M <- numeric(N - 1)
  for(i in seq_len(N)[-c(1, N)]){
    M[i] = vec[i + 1] - vec[i] - constant*M[i - 1]
  }
  M
}

AR1_FILTER <- function (x, filter, full = TRUE) {
  n <- length(x)
  AR1 <- .Call(stats:::C_rfilter, as.double(x), as.double(filter), double(n + 1L))
  if (!full) AR1 <- AR1[-1L]
  AR1
  }

f2 <- function (vec, constant) {
  dv <- diff(vec)
  AR1_FILTER(dv[2:(length(dv) - 1)], -constant)
  }

library(microbenchmark)

Bench <- function (n) {
  vec <- runif(n)
  microbenchmark("R" = f1(vec, 0.6), "C" = f2(vec, 0.6))
  }

对于长度为100的短向量，我得到了

Bench(100)

Unit: microseconds
 expr    min      lq     mean median      uq     max neval
    R 68.098 69.8585 79.05593 72.456 74.6210 244.148   100
    C 66.423 68.5925 73.18702 69.793 71.1745 150.029   100

对于长度为10000的大向量，我得到了

Bench(10000)

Unit: microseconds
 expr      min        lq     mean    median       uq      max neval
    R 6168.742 6699.9170 6870.277 6786.0415 6997.992 8921.279   100
    C  876.934  904.6175 1192.000  931.9345 1034.273 2962.006   100

是的，R不可能击败编译语言。

Answer 4

library(dplyr)


L2 <- c(0,lead(vec) - vec - constant * lag(L))
L2 <- L2[!is.na(L2)]
L2

 [1]  0.00000000  1.09605531 -0.62765133  1.81529867 -2.10535596  3.10864280 -4.36975556  1.41375965
 [9] -1.08809820  2.16767510 -1.82140234  1.14748512 -0.89245650  0.03962074 -0.10930073  1.48162072
[17] -1.63074832  2.21593009


all.equal(L,L2)
[1] TRUE

向后向量化R循环

4 个答案: