优化问题 - 最小化 R 中的函数

Question

我想最小化一个函数，但是无法前进。

问题设置：

mtcars$gender <- c(rep(1, 10), rep(0, 4), rep(1, 6), rep(0 , 12))

predictions <- data.frame(
  c(0.05,   0.03,   0.99,   0.07,   0.00,   0.10,   0.00,   0.84,   0.92,   0.01,   0.03,   0.00,   0.00,   0.00,   0.00,   0.00,   0.00,   1.00,   1.00,   1.00,   0.97,   0.00,   0.00,   0.00,   0.00,   1.00,   0.86,   0.84,   0.01,   0.08,   0.00,   0.86),
  c(0.95,   0.97,   0.01,   0.80,   0.07,   0.82,   0.00,   0.14,   0.08,   0.95,   0.94,   0.03,   0.03,   0.03,   0.00,   0.00,   0.00,   0.00,   0.00,   0.00,   0.03,   0.02,   0.07,   0.02,   0.01,   0.00,   0.12,   0.16,   0.10,   0.79,   0.05,   0.13),
  c(0.00,   0.00,   0.00,   0.13,   0.93,   0.08,   1.00,   0.02,   0.00,   0.04,   0.03,   0.97,   0.97,   0.97,   1.00,   1.00,   1.00,   0.00,   0.00,   0.00,   0.00,   0.98,   0.93,   0.98,   0.99,   0.00,   0.02,   0.00,   0.89,   0.13,   0.95,   0.01))
colnames(predictions) <- c(4, 6, 8)


actual.probs <- apply(predictions, 1, which.max) 
actual.probs <- as.data.frame.matrix(prop.table(table(mtcars$gender, actual.probs)))
real.probs <- data.frame(matrix(c(0.1, 0.1, 0.2, 0.2, 0.2, 0.2), nrow = 2, ncol = 3))

我使用了一种预测算法，该算法为我提供了汽车具有 4,6 或 8 缸的概率。结果存储在 "predictions" 中。然而，分布 (actual.probs) 与现实中看到的分布 (real.probs) 不同。为了调整它，我想将概率乘以一个权重，得到概率最高的那个并重新计算 table。我想要的结果是我需要的权重与真实分布的偏差最小。

optimresult <- predictions 

fn <- function(v) {
  weight1 <- v[1]
  weight2 <- v[2]
  weight3 <- v[3]

  optimresult[,1] <- optimresult[,1] * weight1
  optimresult[,2] <- optimresult[,2] * weight2
  optimresult[,3] <- optimresult[,3] * weight3

  result <- apply(optimresult, 1, which.max) # get highest probablity

  actualprobs <- prop.table(table(mtcars[["gender"]], result))
  return <- sum(abs(real.probs - actualprobs))
}

optim(c(1, 1, 1), fn)

Startvalues都是一个，但是这个功能好像不起作用。我做错了什么？

Answer 1

问题在于，对 optim() 中的参数值进行微小更改不会改变结果，这意味着算法认为它在实际收敛之前就已经收敛了。

使用 SANN 方法可以得到更好的结果。我不确定这是否是您使用该示例数据集可以获得的最佳结果。

我也对你的功能做了一些简化。

fn <- function(v) {

  weighted_preds = predictions * v

  result = apply(weighted_preds, 1, which.max) # get highest probablity

  actualprobs = prop.table(table(mtcars[["gender"]], result))

  sum(abs(real.probs - actualprobs))
}

optim(c(100, 1, 1), fn, method="SANN")

尝试不同的起始值，看看是否能有所改善。增加预测数量也会有所帮助。

优化问题 - 最小化 R 中的函数

Optimization problem - minimizing a function in R

r

optimization

minimization