1

I am trying to find a global reduction (global_reduct) for a timeseries of monthly loads. The goal is make sure that only 50% (or any other taget) of all loads exceed a specific reference load.

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

Data example which is a subset of 20+ years of data.

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

In this case the reduction would be around 62% at a target of 50% of the reference load.

I tried to setup a function that can be called by optim to estimate the new reduct value.

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)

How can I get the correct new reduct value? Is there a different package that I can use?

jay.sf
  • 60,139
  • 8
  • 53
  • 110
AMSS
  • 23
  • 4

1 Answers1

1

It might be better to use proportions, i.e. values within [0, 1], instead of percentages.

Then minimizing the abs difference of reduced load load - load*reduct and tolerance tobject within interval [0, 1] should give the desired minimum, i.e. the reduction factor.

I use optimize directly here.

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%

Check:

(with(df, load - load*reduct) > load_ref) |> table() |> proportions()
# FALSE  TRUE 
#  0.75  0.25
jay.sf
  • 60,139
  • 8
  • 53
  • 110