代码之家 › 专栏 › 技术社区 › chinsoon12

滚动最小值,无需更换

chinsoon12 · 技术社区 · 7 年前

给定一个向量( vec )还有一扇5号的窗户,

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

有没有更快的方法来计算滚动最小值而不需要替换?

滚动最小w/o更换:使用 向量

在第一个过程中,从前5个元素(9、3、10、5、6)中提取最小值。在第一次传球中,分钟是3分。

在第二个过程中,从第一个过程(9、10、5、6)和新的窗口元素(2)剩下的4个元素中提取min。第二次传球的分是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。

2 回复 | 直到 7 年前

Maurits Evers 7 年前

不知道这是如何打卡,但这里有另一个选择

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;有趣的是 数字(长度=长度(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

aciobanu 7 年前

目前的时间安排:

#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