Question

我有实际值和四个具有其预测值和拟合值的不同模型。使用这些拟合值，我想找到最佳权重，以便使（summary（wifi）-actuals）^ 2最小。 wi是我想找到的最优权重，fi是每个模型的拟合值。

我对无线网络的限制是；

权重必须大于0，
重量必须小于1，
权重之和必须为1

我在这里[https://stats.stackexchange.com/questions/385372/weight-optimization-in-order-to-maximize-correlation-r]看到了一个类似的示例，但是由于我的特殊问题，我无法复制它。

让我们生成示例数据以更好地理解问题

actuals <- floor(runif(10, 500,1700)) 
model1_fitted <- floor(runif(10, 600,1800)) 
model2_fitted <- floor(runif(10, 400,1600)) 
model3_fitted <- floor(runif(10, 300,1500)) 
model4_fitted <- floor(runif(10, 300,1200)) 
sample_model <- data.frame(actuals, model1_fitted, model2_fitted,model3_fitted,model4_fitted)

现在，我需要最佳地找到（w1，w2，w3，w4），以便使（summary（wifi）-actuals）^ 2最小。我想节省权重，正如我提到的那样，我对这四个模型也有预测。如果获得最佳权重，则集成模型的预测值将是这些权重和预测值的线性函数。合奏的第一个预测值将如下所示，

ensemble_pred_1 = w1 * model1_pred1 + w2 * model2_pred1 + w3 * model3_pred1 + w4 * model4_pred1

请帮助我找到最佳wi，以便我可以根据需要生成集成模型。

Answer 1

根据优化问题确定问题的框架并计算所需的约束条件：

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
set.seed(123)
model1_fitted <- floor(runif(10, 600,1800)) 
model2_fitted <- floor(runif(10, 400,1600)) 
model3_fitted <- floor(runif(10, 300,1500)) 
model4_fitted <- floor(runif(10, 300,1200)) 
w <- c(0.2,0.3,0.1,0.4) # sample coefficients
sample_model <- tibble(model1_fitted, model2_fitted,model3_fitted,model4_fitted) %>%
  mutate(actuals= as.vector(as.matrix(.) %*% w)  + rnorm(10,sd=10))


X <- as.matrix(sample_model[,1:4])
y <- as.matrix(sample_model[,5])

# From solve.QP description
# solving quadratic programming problems of the form min(-d^T b + 1/2 b^T D b) with the constraints A^T b >= b_0.

# Your problem
# Minimize       || Xw - y ||^2     => Minimize 1/2 w'X'Xw - (y'X)w  => D=X'X , d= X'y
# Constraint w>0,w<1, sum(w)=1      => A'w >= b0

d <- t(X) %*% y
D <- t(X) %*% X
A <- cbind(rep(1,4),diag(4)) #constraint LHS
b0 <- c(1,numeric(4)) # constraint RHS

library(quadprog)
soln <- solve.QP(D,d,A,b0,meq = 1)
w1 <- soln$solution  # Your model wieghts
w1
#> [1] 0.20996764 0.29773563 0.07146838 0.42082836

^{由reprex package（v0.2.1）于2019-05-09创建}

权重优化以找出R中的最小平方误差

1 个答案: