Question

给出一个向量（vec），并且窗口大小为5，

winsz <- 5L
vec <- c(9, 3, 10, 5, 6, 2, 4, 8, 7, 1)

有没有一种更快的方法来计算滚动最小值而无需更换？

不进行最小滚动替换：以vec为例，窗口大小为5。

在第一遍中，从前5个元素（9、3、10、5、6）中提取最小值。第一遍最小为3。

在第二遍中，从第一遍（9、10、5、6）和新的窗口元素（2）中剩下的4个元素中提取最小值。第二遍最小为2。

在第三遍中，最小值是从上一遍（9、10、5、6）和新的加窗元素（4）中剩余的元素中提取的。在第三遍中，最小为4。依此类推。

该示例的结果为

 [1]  3  2  4  5  6  1  7  8  9 10

请暂时排除Rcpp实施。

当前的实现和时序代码：

#rolling min without replacement
set.seed(0L)
N <- 10e5
winsz <- 5L
vec <- sample(N)

mtd0 <- compiler::cmpfun(function(x) {
    subx <- x[seq_len(winsz)]
    n <- 1L
    drawn <- rep(NA_integer_, length(x))
    while (n <= length(x)-winsz) {
        idx <- which.min(subx)
        drawn[n] <- subx[idx]            
        subx[idx] <- x[n+winsz]
        n <- n + 1
    }
    drawn[tail(seq_along(drawn), winsz)] <- sort(subx)
    drawn
})

library(microbenchmark)
microbenchmark(mtd0(vec), times=3L)

窗口大小为5，向量的长度为1e6时，约为8s。

Answer 1

不确定这将如何计时，但这是另一种选择

f <- function(x, window = 5) {
    ret <- numeric(length = length(x))
    i <- 1L
    while (length(x) > 0) {
        idx.min <- which.min(x[1:window])
        ret[i] <- x[idx.min]
        x <- x[-idx.min]
        i <- i + 1
    }
    return(ret)
}
f(vec)
# [1]  3  2  4  5  6  1  7  8  9 10

或

f2 <- function(x, window = 5) {
    ret <- numeric(length = length(x))
    i <- 1L
    while (i <= length(x)) {
        idx.min <- which.min(x[1:(window + i - 1)])
        ret[i] <- x[idx.min]
        x[idx.min] <- NA
        i <- i + 1
    }
    return(ret)
}

旁注...

numeric(length = length(x))部分的荣誉发给@RonakShah；有趣的是numeric(length = length(x))比rep(0, length(x))快得多（这是我最初写的；-）

res <- microbenchmark(
    rep = rep(0, 10^6),
    numeric = numeric(length = 10^6)
)
#Unit: microseconds
#    expr      min       lq     mean   median       uq      max neval cld
#     rep 1392.582 2549.219 3682.897 2694.137 3098.073 14726.81   100   a
# numeric  424.257 1592.110 2902.232 1727.431 2174.159 11747.87   100   a

Answer 2

到目前为止的时间：

#rolling min without replacement
set.seed(0L)
N <- 10e4
winsz <- 5L
vec <- sample(N)

f <- compiler::cmpfun(function(x, window = 5) {
    ret <- numeric(length = length(x))
    i <- 1L
    while (length(x) > 0) {
        idx.min <- which.min(x[1:window])
        ret[i] <- x[idx.min]
        x <- x[-idx.min]
        i <- i + 1
    }
    return(ret)
})

mtd0 <- compiler::cmpfun(function(x) {
    subx <- x[seq_len(winsz)]
    n <- 1L
    drawn <- rep(NA_integer_, length(x))
    while (n <= length(x)-winsz) {
        idx <- which.min(subx)
        drawn[n] <- subx[idx]    
        subx[idx] <- x[n+winsz]
        n <- n + 1
    }
    drawn[tail(seq_along(drawn), winsz)] <- sort(subx)
    drawn
})

mtd1 <- compiler::cmpfun(function(x) {
    res <- Reduce(function(ans, s) {
            v <- ans$students
            idx <- which.min(v)
            list(students=c(v[-idx], s), drawn=v[idx])
        },
        x=as.list(x[seq_along(x)[-seq_len(winsz)]]),
        init=list(students=x[seq_len(winsz)], drawn=NULL),
        accumulate=TRUE)
    c(unlist(lapply(res, `[[`, "drawn")), sort(res[[length(res)]]$students))
})

#all.equal(f(vec), mtd0(vec))
# [1] TRUE

#all.equal(mtd0(vec), mtd1(vec))
# [1] TRUE

library(microbenchmark)
microbenchmark(f(vec), mtd0(vec), mtd1(vec), times=3L)

时间：

Unit: milliseconds
      expr         min          lq        mean      median        uq        max neval cld
    f(vec) 16234.97047 16272.00705 16457.05138 16309.04363 16568.092 16827.1400     3   b
 mtd0(vec)    75.18676    83.34443    96.03222    91.50209   106.455   121.4078     3  a 
 mtd1(vec)   301.56747   342.36437   427.33052   383.16127   490.212   597.2628     3  a

分钟滚动，无需更换

2 个答案: