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)
}

然后使用accumulate包中的purrr来应用具有起始限制和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循环计算最终值

2 个答案: