嵌套最大化与在 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 的系统)。
我有一个带有两个嵌套优化的 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 的系统)。