R - 我怎樣才能讓這個循環運行得更快？

Question

下面的 for 循環遍歷 igraph 圖中的節點。 其中有 2048 個，所以速度很慢。 我試圖盡可能高效地編碼（例如，通過不增長向量）。 如何使循環運行得更快？

編輯：我也考慮過通過 Rcpp 用 C++ 編寫這個。 我只是不知道在這種情況下我將如何使用 igraph 。

編輯 2： compatible_models 實際上取決於 child_node。 我在這里給出的是一個示例，說明它對於 child_node 的特定值可能是什么。

library(igraph)
library(Metrics)

set.seed(1234)
N <- 10000
A <- rnorm(N, 10, 2)
B <- rnorm(N, 9, 2)
C <- rnorm(N, 12, 1)
D <- rnorm(N, 7, 3)
Y <- A + B + A*B + D + A^2 + rnorm(N)
data <- data.frame(Y = Y, A = A, B = B, C = C, D = D)
partition <- sort(sample(N, 0.7*N))
data_train <- data[partition, ]
data_test <- data[-partition, ]

g <- make_empty_graph()
g <- g + vertices(1:2049)

generate_edges <- function(start_vertex, end_vertices) {
  edges <- c()
  for (i in 1:length(end_vertices)) {
    edges <- c(edges, start_vertex, end_vertices[i])
  }
  return(edges)
}

outward_edges <- generate_edges(V(g)[1], V(g)[2:vcount(g)])
g <- g + edges(outward_edges, attr1 = rep(0, length(outward_edges) / 2), attr2 = rep(0, length(outward_edges) / 2))


successors <- matrix(nrow = length(g[[1, ]][[1]]), ncol = 9) # nrow = number of successors of node 1
i <- 1

for (child_node in 2:2049) {
   # compatible_models <- lapply(...) # suppose this is a list of "formula" objects
   # like: 
   compatible_models <- list(Y ~ A + B + C, Y ~ I(A^2) + B + C + D, Y ~ B + D)
   compatible_models <- lapply(compatible_models, lm, data = data_train)
   predictions <- sapply(compatible_models, predict, newdata = data_test)
   successors[i, 1:3] <- c(edge_attr(g, name = "attr1", g[[1, V(g)[child_node], edges = TRUE]]), edge_attr(g, name = "attr2", g[[1, V(g)[child_node], edges = TRUE]]), 
                                     sum(apply(predictions, 2, rmse, actual = data_test$Y))/length(compatible_models))

   i <- i + 1

  }

Answer 1

如果我錯了，請糾正我，但我認為您可以在循環之外評估前三行（或任何構建模型對象但不評估任何內容的行），這〜將我機器上代碼的性能提高了三倍：

successors <- matrix(nrow = length(g[[1, ]][[1]]), ncol = 9) # nrow = number of successors of node 1

i <- 1

start_time <- Sys.time()
for (child_node in 2:2049) {
# build models inside loop:
  compatible_models <- list(Y ~ A + B + C, Y ~ I(A^2) + B + C + D, Y ~ B + D)
  compatible_models <- lapply(compatible_models, lm, data = data_train)
  predictions <- sapply(compatible_models, predict, newdata = data_test)
  successors[i, 1:3] <- c(edge_attr(g, name = "attr1", g[[1, V(g)[child_node], edges = TRUE]]), edge_attr(g, name = "attr2", g[[1, V(g)[child_node], edges = TRUE]]), 
                          sum(apply(predictions, 2, rmse, actual = data_test$Y))/length(compatible_models))
  
  i <- i + 1
  
}
Sys.time()-start_time
#Time difference of 26.69914 secs

在循環外創建模型的優化代碼：

## model building:
compatible_models <- list(Y ~ A + B + C, Y ~ I(A^2) + B + C + D, Y ~ B + D)
compatible_models <- lapply(compatible_models, lm, data = data_train)
predictions <- sapply(compatible_models, predict, newdata = data_test)
## initialisation:
successors2 <- matrix(nrow = length(g[[1, ]][[1]]), ncol = 9) 
i <- 1

start_time <- Sys.time()
for (child_node in 2:2049) {

  successors2[i, 1:3] <- c(edge_attr(g, name = "attr1", g[[1, V(g)[child_node], edges = TRUE]]), edge_attr(g, name = "attr2", g[[1, V(g)[child_node], edges = TRUE]]), 
                          sum(apply(predictions, 2, rmse, actual = data_test$Y))/length(compatible_models))
  
  i <- i + 1
  
}
Sys.time()-start_time
#Time difference of 8.885826 secs

all.equal(successors,successors2)
# [1] TRUE