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

Nested maximisation in parallel with the need of using global variables in R

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

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

我想 运行 此过程并行处理不同的数据集。 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

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

并行处理的问题在于,正如在 parallel 包中实现的那样,每个 thread/offspring/child 在其自己的会话中是 运行,这意味着它们不会相互交互.在那种情况下,您几乎可以在每个后代进程中做您想做的事情。这是您正在尝试执行的操作的示例:


# 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

reprex package (v0.3.0)

于 2019-11-20 创建

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

最后一点要指出的是,如果您的数据集很大,最好将它们实际加载到后代会话中以避免重复内存(通常,如果您使用 makeForkCluster,但这仅适用于基于 unix 的系统)。