优化问题 - 减少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))

我用它给我probabilites到汽车有4,6或8缸的预测算法。结果存储在“预测”。然而，分布（actual.probs）不同于现实（real.probs）所见的分布。要调整，我想通过一个重量乘以probalities，得到一个概率最高，并重新计算表。我要的结果是，我需要从现实分布的偏差最小的权重。

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")

尝试不同的初始值，看看是否能得到改善。提高预测的数量也将有所帮助。