[Rd] feature request: optim() iteration of functions that return multiple values

Sami Tuomivaara @@m|tuom|v@@r@ @end|ng |rom hotm@||@com
Tue Aug 8 11:14:28 CEST 2023


Thank you all very much for the suggestions, after testing, each of them would be a viable solution in certain contexts.  Code for benchmarking:

# preliminaries
install.packages("microbenchmark")
library(microbenchmark)


data <- new.env()
data$ans2 <- 0
data$ans3 <- 0
data$i <- 0
data$fun.value <- numeric(1000)

# define functions

rosenbrock_env <- function(x, data)
{
  x1 <- x[1]
  x2 <- x[2]
  ans <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  ans2 <- ans^2
  ans3 <- sqrt(abs(ans))
  data$i <- data$i + 1
  data$fun.value[data$i] <- ans
  ans
}


rosenbrock_env2 <- function(x, data)
{
  x1 <- x[1]
  x2 <- x[2]
  ans <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  ans2 <- ans^2
  ans3 <- sqrt(abs(ans))
  data$ans2 <- ans2
  data$ans3 <- ans3
  ans
}

rosenbrock_attr <- function(x)
{
  x1 <- x[1]
  x2 <- x[2]
  ans <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  ans2 <- ans^2
  ans3 <- sqrt(abs(ans))
  attr(ans, "ans2") <- ans2
  attr(ans, "ans3") <- ans3
  ans
}


rosenbrock_extra <- function(x, extraInfo = FALSE)
{
  x1 <- x[1]
  x2 <- x[2]
  ans <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  ans2 <- ans^2
  ans3 <- sqrt(abs(ans))
  if (extraInfo) list(ans = ans, ans2 = ans2, ans3 = ans3)
  else ans
}


rosenbrock_all <- function(x)
{
  x1 <- x[1]
  x2 <- x[2]
  ans <- 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
  ans2 <- ans^2
  ans3 <- sqrt(abs(ans))
  list(ans = ans, ans2 = ans2, ans3 = ans3)
}

returnFirst <- function(fun) function(...) do.call(fun,list(...))[[1]]
rosenbrock_all2 <- returnFirst(rosenbrock_all)


# benchmark all functions
set.seed <- 100

microbenchmark(env = optim(c(-1,2), rosenbrock_env, data = data),
               env2 = optim(c(-1,2), rosenbrock_env2, data = data),
               attr = optim(c(-1,2), rosenbrock_attr),
               extra = optim(c(-1,2), rosenbrock_extra, extraInfo = FALSE),
               all2 = optim(c(-1,2), rosenbrock_all2),
               times = 100)


# correct parameters and return values?
env <- optim(c(-1,2), rosenbrock_env, data = data)
env2 <- optim(c(-1,2), rosenbrock_env2, data = data)
attr <- optim(c(-1,2), rosenbrock_attr)
extra <- optim(c(-1,2), rosenbrock_extra, extraInfo = FALSE)
all2 <- optim(c(-1,2), rosenbrock_all2)

# correct return values with optimized parameters?
env. <- rosenbrock_env(env$par, data)
env2. <- rosenbrock_env(env2$par, data)
attr. <- rosenbrock_attr(attr$par)
extra. <- rosenbrock_extra(extra$par, extraInfo = FALSE)
all2. <- rosenbrock_all2(all2$par)

# functions that return more than one value
all. <- rosenbrock_all(all2$par)
extra2. <- rosenbrock_extra(extra$par, extraInfo = TRUE)

# environment values correct?
data$ans2
data$ans3
data$i
data$fun.value


microbenchmarking results:

Unit: microseconds
  expr     min        lq      mean    median         uq       max neval
   env 644.102 3919.6010 9598.3971 7950.0005 15582.8515 42210.900   100
  env2 337.001  351.5510  479.2900  391.7505   460.3520  6900.800   100
  attr 350.201  367.3010  502.0319  409.7510   483.6505  6772.800   100
 extra 276.800  287.2010  402.4231  302.6510   371.5015  6457.201   100
  all2 630.801  646.9015  785.9880  678.0010   808.9510  6411.102   100

rosenbrock_env and _env2 functions differ in that _env accesses vectors in the defined environment by indexing, whereas _env2 doesn't (hope I interpreted this right?).  This appears to be expensive operation, but allows saving values during the steps of the optim iteration, rather than just at convergence.  Overall, _extra has consistently lowest median execution time!

My earlier workaround was to write two separate functions, one of which returns extra values; all suggested approaches simplify that approach considerably.  I am also now more educated about attributes and environments that I did not know how to utilize before and that proved to be very useful concepts.  Again, thank you everyone for your input!


	[[alternative HTML version deleted]]



More information about the R-devel mailing list