optimum_theta <- optim(par = theta_initial, fn = cost ,method = "BFGS",
control=list(maxit=2))我使用了上面的代码并添加了控制参数，但这段代码会运行很长时间，而且会迭代两次以上，我不知道为什么以及如何解决这个问题。
以下是与此优化相关的所有代码。
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))**######以下是对我的问题#######**的更新
使用的代码如下：
colnames(data_plot)[3] <- "CellType"
n <- nrow(data_plot)
set.seed(12345)
id <- sample(1:n,floor(n * 0.5))
data_train <- data_plot[id,]
data_test <- data_plot[-id,]
data_train$CellType <- ifelse(data_train$CellType == "T-cell",1,-1)
data_test$CellType <- ifelse(data_test$CellType == "T-cell",1,-1)
data_train_p <- as.matrix(data_train[,-3])
data_test_p <- as.matrix(data_train[,-3])
lossfun <- function(theta,X, Y){
result <- mean(log(1 + exp(-Y * (X %*%theta))))
return(result)
}
cost <- function(theta){
loss_train <- lossfun(theta,X = data_train_p,Y = data_train$CellType)
loss_test <- lossfun(theta,X= data_test_p,Y = data_test$CellType)
num <<- num + 1
training_cost[num] <<- loss_train
test_cost[num] <<- loss_test
return(loss_train)
}
num <- 0
training_cost <- NULL
test_cost <- NULL
theta_initial <- rep(0,2)
optimum_theta <- optim(par = theta_initial,fn = cost,method = "BFGS",control=list(maxit=20))
iteration <- 1:num
data_plot <- data.frame(iteration,training_cost,test_cost)
data_plot <- reshape2::melt(data_plot,id.var = "iteration")
library(ggplot2)
ggplot(data_plot,aes(x=iteration,y= value,color= variable)) + geom_line()
1条答案
按热度按时间vuktfyat1#
optim是为低维到中维优化设计的（也就是说，参数数量不是很大），我们遇到的特殊问题是，当optim使用基于导数的优化器（比如BFGS），并且梯度函数没有通过传递grad参数显式指定时，它会自动 * 通过有限差分计算梯度 *：通过有限差分计算长度为p的梯度需要对目标函数进行p次评估（加上基线参数值的初始评估）。这意味着算法的 * 每次 * 迭代将调用您的函数1228次。您可以尝试
method = "Nelder-Mead"这样的无导数优化器，但是每次迭代的求值次数大致相同，但是它可能更稳定。然而，更重要的是，你似乎在尝试做高维优化，即用1227个参数拟合124个数据点的模型，除非你使用某种惩罚算法（例如，岭或套索）来正则化你的解，否则这不太可能给予你合理的答案。
您的代码还有许多其他性能问题，如果这些问题得到解决，可能会使目标函数的速度提高到足以使这种方法可行（至少在时间上是可行的;除非你认真思考你的高维问题，否则你可能什么也得不到......）
x <- c(x, added_value)）非常缓慢CellType的变量的值似乎很可疑...我还没有实际测试这段代码，因为你没有给我们一个可复制的例子...
你也可以用解析的方法来计算梯度函数，这会有帮助，或者使用一些实现 * 自动微分 * 的系统--但是同样，你最大的问题是试图在没有任何形式的惩罚/正则化的情况下进行高维优化。