r语言 - 使用优化估计全局负载减少

Question

我试图为每月负载的时间序列找到一个全局减少(global_reduct)。目标是确保所有负载中只有50%(或任何其他目标)超过特定的参考负载。

global_reduct <- c(50)  ## initial value
load_ref <- 450.5  ## reference load
tobject <- 50  ## 50% above reference 

数据示例，这是20多年数据的子集。

df <- data.frame(
Date=seq(as.Date('2010-01-01'), as.Date('2012-04-01'), by='months'), 
load= c(1.496169954, 1.29147009, 1.964195241, 1.14352707, 1.319144304, 
0.773288093, 0.65175612, 0.685340958, 0.416934849, 
0.769853258, 1.104639594, 0.92213209, 1.685588986, 
1.972510175, 2.6882446, 2.153314503, 1.324735759, 
1.027755411, 0.610207197, 0.674642831, 0.721971375, 
1.13233884, 0.739325423, 0.90031817, 1.366597449, 
1.928098735, 1.216538229, 1.514353244)
)

在这种情况下，在参考负载的50%的目标下，减少将在62%左右。

我试着设置一个函数，可以被optim调用来估计新的还原值。

optfuc <- function(reduct, ttarget=50){
reduct_eq <- df$load *(1 - (reduct/100))
tt_exceed <- ifelse((reduct_eq *1000) > load_ref, 1, 0)  
ave_ref <- sum(tt_exceed)/length(tt_exceed)*100 - ttarget
# ave_ref in this case should be = ttarget
# ave_ref
reduct 
}
optim(c(30), optfuc, method ="L-BFGS-B", lower=0, upper=100)

如何得到正确的新约简值?我可以使用其他的套餐吗?

Answer 1

最好使用比例，即[0,1]内的值，而不是百分比。

则在区间[0,1]内，将减载load - load*reduct与容差tobject的abs差值最小化，应得到所需的minimum，即减载系数

我在这里直接使用optimize。

load_ref <- mean(df$load)  ## for example
tobject <- .25  ## 25%
optfuc <- (reduct, ref=load_ref, tol=tobject, data=df) {
load1 <- with(data, load - load*reduct)
abs(tol - mean(load1 > ref))
}
(o <- optimize(optfuc, c(0, 1)))
# $minimum
# [1] 0.1935267
# 
# $objective
# [1] 0
reduct <- o$minimum
cat(sprintf('reduction:%s%% at target of%s%%', 
formatC(reduct*100, digits=2), 
formatC(tobject*100, digits=2)))
# reduction: 19% at target of 25%

检查:

(with(df, load - load*reduct) > load_ref) |> table() |> proportions()
# FALSE  TRUE 
#  0.75  0.25