不使用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
}

我的objective是在循环结束时计算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

不使用for循环计算最终值

Calculate final value without using for-loop

for-loop

r

cumsum

dplyr