更高效的 function 和 for 循環

Question

我正在嘗試做一個更有效的 for 循環。 我知道 sapply、laaply 等的存在，但我不知道如何在我的代碼中實現它。

我有我的 function 我不知道它是否非常有效。 我認為我應該改進這一點，但我不知道如何。

myfun <- function(a, b, c) {
  sum <- 0
  iter <- 0
  while (sum < c) {
    nr <- runif(1, a, b)
    sum <- sum + nr
    iter <- iter + 1
  }
  return(iter)
}

這是我想使用 sapply 或類似東西的部分。

a <- 0
b <- 1
c <- 2
x <- 0
for (i in 1:10^9) {
  x <- x + myfun(a, b, c)
}

另外，我需要做一個與此類似的 sapply

sapply(1:10^9, functie(a ,b ,c)) 

但是 sapply 使用 1:10^9 作為參數，而不是 a、b、c。

Answer 1

以我的誠實觀點，你做得對。 由於您不需要返回矢量化或多維結果，而是在每次迭代時更新現有的 object，因此您建議的 for 循環綽綽有余。

如果你想看一些關於這個主題的精彩討論，我建議你看看這個鏈接： https://r4ds.had.co.nz/iteration.html

編輯：只是為了解決速度參數

start <- Sys.time()
purrr::map_dbl(1:1000, function(x) y + myfun(a, b, c)) %>% sum
end <- Sys.time()
end - start

# Time difference of 0.02593184 secs

start <- Sys.time()
y <- replicate(1000, myfun(a,b,c))
cumsum(y)[1000]
end <- Sys.time()
end - start

# Time difference of 0.01755929 secs

y <- 0
start <- Sys.time()
for(i in 1:1000){
  y<- y + myfun(a,b,c)
}
end <- Sys.time()
end - start

# Time difference of 0.01459098 secs

Answer 2

我認為replicate()是您可能正在尋找的（我將您的n更改為更小的東西）。

set.seed(1234)

n <- 10^2

y <- replicate(n, myfun(a,b,c))
sum(y)
# [1] 462

這與您之前的結果相符。

set.seed(1234)

a <-0
b <-1
c <-2
x <-0
for (i in 1:n){
  x <- x + myfun(a,b,c)
}

x
# [1] 462

Answer 3

我可能會使用purrr::map()來解決這個問題。 比如像這樣：

c(1:1e9) %>% 
  purrr::map_dbl(
    ~ myfun(a, b, c)
  ) %>% 
  sum()

這首先調用myfun()的次數與c(1:1e9)的長度相同，並將結果存儲在數字向量中，然后使用sum()將結果相加。

我的測試表明它比使用replicate()快一點。

Answer 4

這里有一些選項

• 一個基礎的R遞歸方法

f_TIC <- function(x, y, z) ifelse(z <= 0, 0, f_TIC(x, y, z - runif(1, x, y)) + 1)

• Rcpp的f_TIC實現

library(Rcpp)
cppFunction("
int f_TIC_cpp(double x, double y, double z) {
  if (z <= 0) {
    return 0;
  } else {
    return f_TIC_cpp(x, y, z- R::runif(0,1))+1;
  }
}
")

基准測試

library(Rcpp)

f <- function(s = 0) {
  if (s[length(s)] >= 2) {
    return(length(s) - 1L)
  } else {
    f(c(s, s[length(s)] + runif(1, 0L, 1L)))
  }
}

f_TIC <- function(x, y, z) ifelse(z <= 0, 0, f_TIC(x, y, z - runif(1, x, y)) + 1)


cppFunction("
double myfun_cpp() {
  double s = 0;
  int i = 0;
  while (s < 2) {
    s = s + R::runif(0, 1);
    i++;
  }
  return i;
}
")

cppFunction("
int f_TIC_cpp(double x, double y, double z) {
  if (z <= 0) {
    return 0;
  } else {
    return f_TIC_cpp(x, y, z- R::runif(0,1))+1;
  }
}
")

myfun <- function(a, b, c) {
  sum <- 0
  iter <- 0
  while (sum < c) {
    nr <- runif(1, a, b)
    sum <- sum + nr
    iter <- iter + 1
  }
  return(iter)
}

set.seed(42)
R <- 1e3
microbenchmark::microbenchmark(
  f = replicate(R, f()),
  f_TIC = replicate(R, f_TIC(0, 1, 2)),
  f_TIC_cpp = replicate(R, f_TIC_cpp(0,1,2)),
  myfun_cpp = replicate(R, myfun_cpp()),
  myfun = replicate(R, myfun(0, 1, 2)), 
  times = 1e2L,
  control = list(warmup = 1e1L)
)

我們會看到

Unit: milliseconds
      expr     min       lq      mean   median       uq     max neval
         f 11.9342 12.50330 14.161982 13.02100 14.96575 22.7116   100
     f_TIC 20.1925 21.69420 23.678240 22.28255 24.86350 34.1577   100
 f_TIC_cpp  2.0293  2.10080  2.639625  2.17505  2.36190  7.9715   100
 myfun_cpp  1.7351  1.79415  2.094577  1.83810  2.00495  6.7481   100
     myfun  9.1408  9.45240 11.783504 10.32355 14.68815 19.5400   100

Answer 5

這是一個遞歸 function f() ，它與myfun()完成相同的工作。

f <- function(s=0) {
  if (s[length(s)] >= 2) {
    return(length(s) - 1L)
  } else {
    f(c(s, s[length(s)] + runif(1, 0L, 1L)))
  }
}

set.seed(42)

f()
# [1] 3

replicate(8, f())
# [1] 4 5 4 4 3 5 3 5

stopifnot(all.equal({set.seed(42);f()}, {set.seed(42);myfun(0, 1, 2)}))

但是（很可能是因為這個原因），它只是更酷，而不是更快：

# Unit: milliseconds
#  expr      min       lq     mean   median       uq      max neval cld
#     f 21.57227 22.01614 23.61562 22.30010 26.18903 28.19850   100   b
# myfun 16.20270 16.52542 17.76446 16.70385 19.44336 22.15172   100  a 

set.seed(42); R <- 1e3
microbenchmark::microbenchmark(
  f=replicate(R, f()), myfun=replicate(R, myfun(0, 1, 2)), times=1e2L,
  control=list(warmup=1e1L))