control=list(maxit=2) 在优化函数中不起作用

Question

optimum_theta <- optim(par = theta_initial,
      fn = cost,method = "BFGS",control=list(maxit=2))

我使用上面的代码并添加了

control

参数，但是这段代码会运行很长时间并且迭代两次以上。我不知道为什么或如何解决这个问题。

以下是与此优化相关的所有代码。

cost <- function(theta) {
  record <- NULL
  record_2 <- NULL
  num <<- num + 1
  for(i in 1:124) {
    
    loss <- log(1 + exp(-data_train$CellType[i] * 
       (t(theta) %*% as.numeric(data_train[i,-1228]))))
    record <- c(record,loss)
    
    loss_2 <- log(1 + exp(-data_test$CellType[i] * 
       (t(theta) %*% as.numeric(data_test[i,-1228]))))
    record_2 <- c(record_2,loss_2)
  }
  
  training_cost[num] <<- mean(record)
  test_cost[num] <<- mean(record_2)
  
  result <- mean(record)
  return(result)
}


num <- 0
training_cost <- NULL
test_cost <- NULL


theta_initial <- rep(0,1227)
optimum_theta <- optim(par = theta_initial,
      fn = cost, method = "BFGS", control=list(maxit=2))

Answer 1

optim

专为中低维优化而设计（即，没有大量参数）。您遇到的特定问题是，当

optim

使用基于导数的优化器（例如

BFGS

）并且未通过传递

grad

参数明确指定梯度函数时，它会自动计算梯度通过有限差分：通过有限差分计算长度梯度

p

需要对目标函数进行

p

评估（加上基线参数值的初始评估）。这意味着对于算法的each迭代，您的函数将被调用1228次。

您可以尝试使用无导数的优化器，例如

method = "Nelder-Mead"

，但这将在每次迭代中进行大约相同数量的评估。但是，它可能更稳定。

但是，从根本上讲，您似乎在尝试进行高维优化，即将具有 1227 个参数的模型拟合到 124 个数据点。这不太可能给你合理的答案，除非你使用某种惩罚算法（例如，岭或套索）来规范你的解决方案。

您的代码存在各种其他性能问题，如果这些问题得到解决，可能会充分加速您的目标函数，从而使这种方法可行（至少在时间上；除非您认真考虑您的高维问题，否则您可能不会到任何地方......）

• “增长”向量（

  x <- c(x, added_value)

  ）在 R 中非常慢
• 你的循环可以通过一个矩阵乘法然后一些向量化操作来完成，这应该比循环快得多
• 将一个数值乘以一个名为

  CellType

  的变量的值似乎很可疑......

我还没有实际测试过这段代码，因为你没有给我们一个可重现的例子......

## preallocate vectors; you can use `na.omit()` later
training_cost <- rep(NA_real_, 1e5)
test_cost <- rep(NA_real_, 1e5)
## convert to matrix once, up front
X_train <- as.matrix(data_train[, -1228])
X_test  <- as.matrix(data_train[, -1228])

lossfun <- function(theta, X, ct) {
    mean(log(1 + exp(-ct * (X %*% theta))))
}
   
cost <- function(theta) {
  
  loss_train <- lossfun(theta, X_train, data_train$CellType)
  
  ## computing test loss will slow everything down by a factor of 2,
  ##  but if you really want it ...
  loss_test <- lossfun(theta, X_test, data_test$CellType)
  
  num <<- num + 1
  training_cost[num] <<- loss_train
  test_cost[num] <<- loss_test

  return(loss_train)
}