r - 嵌套最大化与在 R 中使用全局变量的需要并行

Question

我有一个 R具有两个嵌套优化的代码。有一个外部和一个内部功能。外部函数将某些参数传递给内部函数，后者对另一组参数执行优化。然后将这些参数发送到外部函数，外部函数根据内部函数中估计的参数优化目标函数。然后将外部函数的估计值传递给内部函数，后者在内部函数中找到新的最优参数集，并将它们传递给外部函数。这些循环不断重复，直到外循环中的目标函数最小化。

代码的工作原理是将内部参数设置为全局变量，以便在外循环中最大化后，代码将这些全局变量传递给内循环。

我想为不同的数据集并行运行此过程。 I understand that I cannot use the global variables in parallel ，我想在每个循环中保存具有不同文件名的文本文件:我会在外循环结束时保存一个带有参数值的文件，并在外循环开始时重新打开它。但是，有没有更有效的方法来做到这一点？我不认为使用 list会工作。谢谢你。

例子:

require(nloptr)
y = rnorm(100)
x = runif(100)*5

inner <- function(beta) mean((y-beta*x)^2)

outer <- function(alpha) {

  if (!exists("storage") | is.null(storage$solution))
    beta <- runif(1)
  else
    beta <- storage$solution

  sol.inner <-nloptr(
    x0     = beta,
    eval_f = inner,
    opts   = list(
      algorithm = "NLOPT_LN_BOBYQA",
      ftol_rel  = 1.e-6,
      ftol_abs  = 1.e-7,
      xtol_rel  = 1.e-6, 
      xtol_abs = 0,
      maxeval = 1000000
    )
  ) 

  storage <-  c()
  storage <<- append(storage,sol.inner)
  beta    <-  sol.inner$solution

  mean(x^2 - alpha* x + beta)^2

}

alpha0    <- runif(1)
storage   <- c()

sol.outer <- nloptr(
  x0     = alpha0,
  eval_f = outer,
  opts   = list(
    algorithm ="NLOPT_LN_BOBYQA",
    ftol_rel  = 1.e-6,
    ftol_abs  = 1.e-7,
    xtol_rel  = 1.e-6,
    xtol_abs  = 0,
    maxeval   = 1000000
  )
) 

sol.outer

Answer 1

虽然非常整洁，但我不建议使用 <<-运营商一般。如果您想修改函数中的元素以便在函数退出后可以使用它们，我建议您改用环境。

并行处理的事情是，正如在 parallel 中实现的那样包，每个线程/后代/子进程都在自己的 session 中运行，这意味着它们不会相互交互。在这种情况下，您几乎可以在每个后代进程中做您想做的事情。这是您尝试执行的操作的示例:

# Simulating 4 random datasets
set.seed(131)
datasets <- replicate(4, {
  list(
    y = rnorm(100),
    x = runif(100)*5
  )
}, simplify = FALSE)


inner <- function(beta, x, y) mean((y-beta*x)^2)

outer <- function(alpha, storage, x, y) {

  if (!length(storage$solution))
    beta <- runif(1)
  else
    # Take the first value, which is the latest to be
    # stored (see below)
    beta <- storage$solution[[1]]

  sol.inner <- nloptr(
    x0     = beta,
    eval_f = inner,
    opts   = list(
      algorithm = "NLOPT_LN_BOBYQA",
      ftol_rel  = 1.e-6,
      ftol_abs  = 1.e-7,
      xtol_rel  = 1.e-6, 
      xtol_abs = 0,
      maxeval = 1000000
    ),
    y = y,
    x = x
  ) 

  # We can append the latest beta as a list
  storage$solution <- c(list(sol.inner$solution), storage$solution)
  beta    <-  sol.inner$solution

  mean(x^2 - alpha* x + beta)^2

}

# Parallel solution with PSOCKcluster --------------------
library(parallel)

# Setting up the cluster object
cl <- makePSOCKcluster(4)

# We need to export the objects we plan to use within
# each session this includes loading the needed packages
clusterExport(cl, c("outer", "inner"))
invisible(clusterEvalQ(cl, library(nloptr)))
invisible({
  clusterEvalQ(cl, {
    # Be careful about random numbers in parallel!
    # This example is not reproducible right now
    alpha0    <- runif(1)

    # This should be an environment, which is easier to handle
    storage   <- new.env() 
  })
})



# You can send data to the offspring sessions and 
# these will be evaluated in separate R sessions 
ans <- parLapply(cl, datasets, function(d) {

  # Making the variables available to the program
  y <- d$y
  x <- d$x

  sol.outer <- nloptr(
    x0     = alpha0,
    eval_f = outer,
    opts   = list(
      algorithm ="NLOPT_LN_BOBYQA",
      ftol_rel  = 1.e-6,
      ftol_abs  = 1.e-7,
      xtol_rel  = 1.e-6,
      xtol_abs  = 0,
      maxeval   = 1000000
    ),
    x = d$x,
    y = d$y,
    # Passing the environment as an extra
    #  argument to the function
    storage = storage
  ) 

  list(
    sol     = sol.outer,
    storage = storage
  )

})

# Stopping the R sessions
stopCluster(cl)

# Checking out the storage vectors
lapply(ans, function(x) unlist(x$storage$solution))
#> [[1]]
#>  [1] -0.04112901 -0.04112901 -0.04112901 -0.04112901 -0.04112901
#>  [6] -0.04112901 -0.04112901 -0.04112901 -0.04112901 -0.04112901
#> [11] -0.04112901 -0.04112901 -0.04112901 -0.04112901 -0.04112901
#> [16] -0.04112901
#> 
#> [[2]]
#>  [1] -0.06877397 -0.06877397 -0.06877397 -0.06877397 -0.06877397
#>  [6] -0.06877397 -0.06877397 -0.06877397 -0.06877397 -0.06877397
#> [11] -0.06877397 -0.06877397 -0.06877397 -0.06877397 -0.06877397
#> [16] -0.06877397 -0.06877397
#> 
#> [[3]]
#>  [1] 0.004505708 0.004505708 0.004505708 0.004505708 0.004505708
#>  [6] 0.004505708 0.004505708 0.004505708 0.004505708 0.004505708
#> [11] 0.004505708 0.004505708 0.004505708 0.004505708 0.004505708
#> [16] 0.004505708 0.004505708
#> 
#> [[4]]
#>  [1] -0.02001445 -0.02001445 -0.02001445 -0.02001445 -0.02001445
#>  [6] -0.02001445 -0.02001445 -0.02001445 -0.02001445 -0.02001445
#> [11] -0.02001445 -0.02001445 -0.02001445 -0.02001445 -0.02001445
#> [16] -0.02001445

创建于 2019-11-20 由 reprex package (v0.3.0)

这里要注意的一件事是我修改了你的函数，以便显式传递参数，因此在这种情况下我们不会处理范围。这通常更安全，并且更新的 R 版本足够智能，可以避免在传递给函数时复制对象。

最后一点要指出的是，如果您的数据集很大，最好在后代 session 中实际加载它们以避免重复内存(通常，如果您使用 makeForkCluster ，最后一点不是问题，但这是仅适用于基于 Unix 的系统)。