R: Использование Optim() для установки переменных весов

Question

У меня есть следующие данные:

set.seed(1) 
data <- data.frame(matrix(rexp(45), 5)) 
data <- cbind(data, c(1,2,2,3,1)) 
colnames(data) <- c("model1_a","model1_b","model1_c","model2_a","model2_b","model2_c","model3_a","model3_b","model3_c", "true_max") 

То есть:

model1_a model1_b model1_c model2_a model2_b model2_c model3_a model3_b model3_c true_max 
1 0.7551818 2.8949685 1.3907351 1.0352439 2.3645153 0.05943916 1.43528534 1.0227259 1.0798811  1 
2 1.1816428 1.2295621 0.7620299 1.8760352 0.6418926 0.57871246 0.03726853 0.3017409 1.0282469  2 
3 0.1457067 0.5396828 1.2376036 0.6547466 0.2941204 3.95893285 0.32401015 0.7252143 1.2922616  2 
4 0.1397953 0.9565675 4.4239342 0.3369335 0.5658655 1.17331211 1.32046793 0.7515427 1.2531054  3 
5 0.4360686 0.1470460 1.0545432 0.5884797 0.1060726 0.99681296 0.20351035 0.2350275 0.5546414  1 

Используя эти данные, мне нужно найти оптимальные веса для комбинирования результаты каждой модели. Без весов, эти суммы:

cbind(
    "a_total" = data$model1_a+data$model2_a+data$model3_a, 
    "b_total" = data$model1_b+data$model2_b+data$model3_b, 
    "c_total" = data$model1_c+data$model2_c+data$model3_c 
) 

     a_total b_total c_total 
[1,] 3.225711 6.2822097 2.530055 
[2,] 3.094946 2.1731956 2.368989 
[3,] 1.124464 1.5590175 6.488798 
[4,] 1.797197 2.2739757 6.850352 
[5,] 1.228059 0.4881461 2.605998 

Использование which.max() дает оценочную Мах 2 1 3 3 3. Как использовать optim() для установки весов для каждого столбца (или индивидуального значения)? Данные содержат истинный макс.

Answer 1

Вы можете попробовать это:

# weights 
# model1_a model1_b model1_c model2_a model2_b model2_c model3_a model3_b model3_c 
# W1  W2  W3  W4  W5   W6   1-W1-W4 1-W2-W5 1-W3-W6  

# max(data_model_i%*%W_model_i), i=1,2,3 
model.opt <- function (W,data) { 
    max(sum(data[,c(1,4,7)]*c(W[1],W[4],1-W[1]-W[4])), 
     sum(data[,c(2,5,8)]*c(W[2],W[5],1-W[2]-W[5])), 
     sum(data[,c(3,6,9)]*c(W[3],W[6],1-W[3]-W[6]))) 
} 

for (i in 1:nrow(data)) { 
    W <- optim(par=rep(0.5,6), fn = model.opt, 
      method = "L-BFGS-B", 
      lower = rep(0,6), # W_i >= 0 for all i 
      upper = rep(1,6), # W_i <= 1 for all i 
      control = list(fnscale = -1), 
      data=as.matrix(data[i,]))$par # optimum W 
    print(which.max(c(sum(data[i,c(1,4,7)]*c(W[1],W[4],1-W[1]-W[4])), 
     sum(data[i,c(2,5,8)]*c(W[2],W[5],1-W[2]-W[5])), 
     sum(data[i,c(3,6,9)]*c(W[3],W[6],1-W[3]-W[6]))))) 
} 

[1] 2 
[1] 1 
[1] 3 
[1] 3 
[1] 3