Excel R 中带有 1 个参数的求解器

Question

我想在数据集中找到用于 ELO 计算的最佳 K 参数。我的例子：

#load SciViews for ln function
library("SciViews")

ELO1 <- c(1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 
                              1500.000, 1500.000, 1512.500, 1487.500, 1512.500, 1487.500, 1487.500, 1512.500, 1475.898, 1500.000, 1475.000, 1486.617, 1512.516)
ELO2 <- c(1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1512.500, 1487.500, 1512.500, 1487.500, 1487.500, 1512.500, 1499.550, 1500.450, 1499.550, 1512.950, 1487.050, 1512.950, 1524.102, 1500.000)
dataset <- data.frame("ELO1" = ELO1, "ELO2" = ELO2)
#Lets set if the Player1 was the winner:
dataset$HomeWinner <- c(1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0)

根据 ELO，玩家 1 的获胜概率计算如下：

dataset$P1ExpWin <- 1/(1 + 10^((dataset$ELO2 - dataset$ELO1)/400))
dataset$P2ExpWin <- 1 - dataset$P1ExpWin

日志错误计算方式如下：

dataset$LogError <- dataset$HomeWinner * ln(dataset$P1ExpWin) + (1-dataset$HomeWinner) * ln(1-dataset$P1ExpWin)

K 参数设置 ELO 变化率，可以在 4 到 32 之间变化。让我们将其设置为 20：

Kparameter = 20

并且 ELO 变化是根据结果以这种方式计算的：

for (row in 1:nrow(dataset)) {
    if (dataset[row,"HomeWinner"] == 1) {
      dataset$NewELO1[row] <- dataset$ELO1 + Kparameter * (1 - dataset$P1ExpWin)
      dataset$NewELO2[row] <- dataset$ELO2 - Kparameter * dataset$P2ExpWin
    }
    else{
      dataset$NewELO1[row] <- dataset$ELO1[row] - Kparameter * dataset$P1ExpWin
      dataset$NewELO2[row] <- dataset$ELO2[row] + Kparameter * (1 - dataset$P2ExpWin)
    }
}

最后，log loss 计算为每个 LogError 的总和除以计数：

LogLossELO = sum(dataset$LogError) * -1/nrow(dataset)

我的问题是如何使用 Kparameter 的 optim 或优化函数来找到最小的 LogLossELO（类似于 Excel 中的 Solver）？

Answer 1

我已经更改了一些没有意义的公式，但这可能是也可能不是您想要的。请查看此内容并在必要时进行更正。请注意，SciViews 中的 ln 与基础 R 中的 log 相同，因此我们也替换了它。 for 循环可以矢量化，但我们将其保留为循环以便于与问题中的代码进行比较。

ELO1 <- c(1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 
                              1500.000, 1500.000, 1512.500, 1487.500, 1512.500, 1487.500, 1487.500, 1512.500, 1475.898, 1500.000, 1475.000, 1486.617, 1512.516)
ELO2 <- c(1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1500.000, 1512.500, 1487.500, 1512.500, 1487.500, 1487.500, 1512.500, 1499.550, 1500.450, 1499.550, 1512.950, 1487.050, 1512.950, 1524.102, 1500.000)
HomeWinner <- c(1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0)
n <- length(HomeWinner)   

lloss <- function(K) {
  P1ExpWin <- 1/(1 + 10^((ELO2 - ELO1)/400))
  P2ExpWin <- 1 - P1ExpWin
  for (r in 1:n) {
    if (HomeWinner[r] == 1) {
      ELO1[r] <- ELO1[r] + K * (1 - P1ExpWin[r])
      ELO2[r] <- ELO2[r] - K * P2ExpWin[r]
    }
    else{
      ELO1[r] <- ELO1[r] - K * P1ExpWin[r]
      ELO2[r] <- ELO2[r] + K * (1 - P2ExpWin[r])
    }
  }

  P1ExpWin <- 1/(1 + 10^((ELO2 - ELO1)/400))
  P2ExpWin <- 1 - P1ExpWin
  LogError <- HomeWinner * log(P1ExpWin) + (1-HomeWinner) * log(P1ExpWin)
  -mean(LogError) # LogLossELO
}

rng <- c(0, 100)
opt <- optimize(lloss, rng); opt
## $minimum
## [1] 76.05614
##
## $objective
## [1] 0.6833352

下面我们绘制结果。

curve(Vectorize(lloss)(K), rng[1], rng[2], xname = "K", ylab = "LogLossELO")
with(opt, abline(h = objective, v = minimum))

Excel R 中带有 1 个参数的求解器

Excel Solver in R with 1 parameter

optimization

r

solver