Эффективная реализация двойного цикла for

Question

Я новичок в R, и мне было интересно, есть ли более эффективная реализация следующего параметра?Длина временного ряда (x, y) составляет около 5000, а h! = Nrow (q).

set.seed(1)
h = 21
x <- rnorm(5e3, 1)
y <- rnorm(5e3, 2)

q <- c(0.1, 0.3, 0.5, 0.7, 0.9)
qx <- quantile(x, probs = q)
qx <- expand.grid(qx, qx)
qy <- quantile(y, probs = q)
qy <- expand.grid(qy, qy)
q <- expand.grid(q, q)

f <- function(z, l, qz) {
n <- length(z)
1/(n - l) * sum((z[1:(n-l)] <= qz[[1]]) * (z[(1+l):n] <= qz[[2]])) - prod(q[i,])
}

sum = 0
for (i in 1:h) {
  for (j in 1:nrow(q)) {
    sum = sum + (f(x, l = i, qx[j,]) - f(y, l = i, qy[j,]))^2
  }
}
sum
# 0.0008698279

Большое спасибо!

Answer 1

В некоторых случаях одной из более быстрых альтернатив циклов может быть функция sapply.Эта функция работает следующим образом: для каждого элемента вектора выполняет некоторую функцию.

В качестве альтернативы вы можете взглянуть на пакет foreach, который предлагает несколько быстрых циклов.

ВотПример использования sapply: в зависимости от того, что именно вам нужно, вы можете использовать любую из функций.Кроме того, sapply - это только один из самых быстрых способов сделать это, не обязательно самый быстрый.

# setup from the question
set.seed(1)
h = 1
x <- rnorm(5e3, 1)
y <- rnorm(5e3, 2)

q <- c(0.1, 0.3, 0.5, 0.7, 0.9)
qx <- quantile(x, probs = q)
qx <- expand.grid(qx, qx)
qy <- quantile(y, probs = q)
qy <- expand.grid(qy, qy)
q <- expand.grid(q, q)

f <- function(z, l, qz) {
  n <- length(z)
  1/(n - l) * sum((z[1:(n-l)] <= qz[[1]]) * (z[(1+l):n] <= qz[[2]])) - prod(q[i,])
}

# load microbenchmark library for comparison of execution times
library(microbenchmark)

microbenchmark({
  # the version from question with for loop
  sum = 0
  for (i in 1:h) {
    for (j in 1:nrow(q)) {
      sum = sum + (f(x, l = i, qx[j,]) - f(y, l = i, qy[j,]))^2
    }
  }
},
{
# using sapply and storing to object. this will give you h*j matrix as well as the sum
sum = 0
sapply(1:h, function(i) sapply(1:nrow(q), function(j) {sum <<- sum + (f(x, l = i, qx[j,]) - f(y, l = i, qy[j,]))^2}))
},
{
# use sapply and sum the output
sum(sapply(1:h, function(i) sapply(1:nrow(q), function(j) {(f(x, l = i, qx[j,]) - f(y, l = i, qy[j,]))^2})))},
# run each code 200 times to get the time comparison
times = 200
)