不使用 for 循环计算最终值

Question

  upper.limit <- 15
  starting.limit <- 5
  lower.limit <- 0

  set.seed(123)

  x <- sample(-20:20)

  for(i in 1:length(x)){
        k <- starting.limit + x[i]

        k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
        starting.limit <- k
}

我的目标是在循环结束时计算starting limit 的最终值。条件是对于给定的迭代，k 不能超过 upper.limit 并且低于 lower.limit。

我已经编写了上面的循环来实现这一点。但是，我必须对近 10000 个数据集执行此操作。我想知道是否有更快的方法可以避免 for 循环

谢谢

Answer 1

我们可以设计一个函数。

# s: starting.limit, x: the x vector, u:upper.limit, l:lower.limit
k_fun <- function(s, x, u = 15, l = 0){
  k <- s + x
  if (k > u){
    k <- u
  } else if (k < l){
    k <- l
  }
  s <- k
  return(s)
}

然后使用purrr 包中的accumulate 应用具有起始限制和x 向量的函数。你可以看到数字是如何变化的。最后一个数字是最终的输出。

library(purrr)
accumulate(c(5, x), k_fun)
# [1]  5  0 11  6 15 15  0  0 10 15  9 15  8  7  3  0  3  0 15  2  2 14 15  7  4 15 15  3 15  0
# [31]  5  0  0  4 12  0  6  7  9  0  0 15

基准测试

我使用以下代码来评估性能。 accumulate 比带有 400001 元素的向量上的 for 循环快一点。

library(microbenchmark)

perf <- microbenchmark(
  m1 = {upper.limit <- 15
  starting.limit <- 5
  lower.limit <- 0
  set.seed(123)
  x <- sample(-200000:200000)
  for(i in 1:length(x)){
    k <- starting.limit + x[i]

    k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
    starting.limit <- k
  }},
  m2 = {
    set.seed(123)
    x <- sample(-200000:200000)
    vec <- purrr::accumulate(c(5, x), k_fun)
    k <- tail(vec, 1)
  })

# Unit: milliseconds
# expr      min       lq     mean   median        uq      max neval
#   m1 821.1735 879.3551 956.7404 941.1145 1019.8603 1290.800   100
#   m2 649.3444 717.5986 773.3652 768.0313  823.5749 1006.148   100

Answer 2

您可以使用tidyverse 尝试以下类似操作

首先，将x 制作成数据框

x <- as.data.frame(sample(-20:20))
colnames(x) <- c("dat")

然后像管道一样：

x %>%
  mutate(sm = starting.limit) %>% 
  mutate(sm = if_else(sm+lead(dat,1) > upper.limit, upper.limit
                      , if_else(sm+lead(dat,1) < lower.limit, lower.limit, sm) )) %>%
  select(sm) %>%
  filter(sm != is.na(sm)) %>%
  tail(n=1)

有效地，根据需要修改最后的select、filter和tail函数。

基准测试

我很好奇这对其他解决方案的表现如何，并尝试将我的代码添加到已经提供的微基准测试中。来了

perf <- microbenchmark(
  m1 = {upper.limit <- 15
  starting.limit <- 5
  lower.limit <- 0
  set.seed(123)
  x <- sample(-200000:200000)
  for(i in 1:length(x)){
    k <- starting.limit + x[i]

    k <- ifelse(k > upper.limit, upper.limit, ifelse(k < lower.limit, lower.limit,k))
    starting.limit <- k
  }},
  m2 = {
    set.seed(123)
    x <- sample(-200000:200000)
    vec <- purrr::accumulate(c(5, x), k_fun)
    k <- tail(vec, 1)
  }, 
  m3 = {
    x <- sample(-200000:200000)
    xd <- as.data.frame(x)
    colnames(xd) <- c("dat")

    xd %>%
      mutate(sm = starting.limit) %>% 
      mutate(sm = if_else(sm+lead(dat,1) > upper.limit, upper.limit
                          , if_else(sm+lead(dat,1) < lower.limit, lower.limit, sm) )) %>%
      select(sm) %>%
      filter(sm != is.na(sm)) %>%
      tail(n=1)

  }

  )

输出：

Unit: milliseconds
 expr        min         lq      mean    median        uq       max neval
   m1 1223.49718 1255.69514 1272.2679 1260.9643 1272.3401 1392.0402   100
   m2  964.76948  982.96555 1007.5521  989.5366 1007.9106 1173.2754   100
   m3   68.80358   76.77386  133.0509  170.5572  177.0051  274.9299   100