Мин прокат без замены

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).В первом проходе Min равен 3.

Во втором проходе min извлекается из 4 элементов, оставшихся от первого прохода (9, 10, 5, 6), и нового оконного элемента (2).Во втором проходе Min = 2.

В третьем проходе min извлекается из элементов, оставшихся от предыдущего прохода (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)

около 8 секунд для размера окна 5 и вектора длины 1e6.

Answer 1

Время пока:

#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 

Answer 2

Не уверен, как это будет происходить, но здесь есть еще один вариант

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