R/get_Reward.R
In rte-antares-rpackage/antaresWaterValues: Generating water values for Antares
Defines functions
reward_offset
get_local_reward_turb
get_local_reward
get_Reward
Documented in
get_local_reward
get_local_reward_turb
get_Reward
reward_offset
#' Get the reward matrix from simulations, mainly used in \code{Grid_Matrix}
#'
#' @param simulation_names
#' generated by \code{runWaterValuesSimulation}
#' @param pattern A pattern to identify simulations.
#' @param district_name Name of the district used to store output.
#' @param opts
#' List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param correct_monotony Binary argument (default to false). True to correct monotony of rewards.
#' @param method_old If T, linear interpolation used between simulations reward, else smarter interpolation based on marginal prices
#' @param hours If method_old=F, vector of hours used to evaluate costs/rewards of pumping/generating
#' @param possible_controls If method_old=F, data.frame {week,u} of controls evaluated per week
#' @param mcyears Vector of years used to evaluate rewards
#' @param area Area used to calculate watervalues
#' @param pump_eff Pumping efficiency
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param simulation_values Values generated by \code{runWaterValuesSimulation}
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#' @param expansion Binary. True if mode expansion was used to run simulations
#' @param fictive_areas Vector of chr. Fictive areas used in simulation
#'
#' @return list containing a data.table {timeid,MCyear,simulation overall cost}, list of simulations names and list of simulations values
#' @export
#'
get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern = NULL,
district_name = "water values district",
opts = antaresRead::simOptions(), correct_monotony = FALSE,
method_old = TRUE, hours=0:168, possible_controls = NULL,
max_hydro, mcyears = "all",area=NULL,pump_eff=NULL,
district_balance="water values district",
expansion=F,fictive_areas=NULL) {
assertthat::assert_that(class(opts) == "simOptions")
assertthat::assert_that(district_name %in% antaresRead::getDistricts(opts=opts))
studyPath <- opts$studyPath
# just a test if there is a simulation done or not
{if (is.null(simulation_names)) {
if (is.null(pattern))
stop("If 'simulation_names' is not provided, 'pattern' cannot be NULL.")
simulation_names <- getSimulationNames(pattern = pattern, studyPath = studyPath)
}}
# this part prepare the environment of each simulation
{
opts_o <- lapply(
X = simulation_names,
FUN = function(i) {
suppressWarnings({
antaresRead::setSimulationPath(path = studyPath, simulation = i)
})
}
)
}
# check that the MC years are in simulations
for (o in 1:length(opts_o)){
assertthat::assert_that(all(mcyears %in% opts_o[[o]]$mcYears),
msg="Those MC years didn't have been all simulated, check your simulation.")
}
if(method_old){
#generate a table containing the year, the time id (IE week) and overall cost
{reward <- lapply(
X = opts_o,
FUN = function(o) {
res <- get_weekly_cost(district = district_name, mcyears = mcyears, opts = o,
fictive_areas = fictive_areas, expansion = expansion)
res$simulation <- o$name
res
}
)}
reward <- rbindlist(reward) #merge the all simulations tables together
# Getting the controls applied in each simulation
decisions <- simulation_values %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$sim, "\\d+$")))
# Joining controls to rewards
reward <- reward %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$simulation, "\\d+$")))
if ("mcYear" %in% names(decisions)){
reward <- reward %>%
dplyr::left_join(decisions,by=c("sim","timeId"="week","mcYear"))
} else {
reward <- reward %>%
dplyr::left_join(decisions,by=c("sim","timeId"="week"))
}
reward <- reward %>%
dplyr::rename(reward="ov_cost",control="u")
if (correct_monotony){
cost <- reward
# Getting possible controls
U <- cost %>%
dplyr::select("control") %>%
dplyr::distinct() %>%
dplyr::arrange()
# Initialize reward
cost <- cost %>% dplyr::mutate(min_previous_reward=.data$reward) %>%
dplyr::arrange(.data$mcYear, .data$timeId, .data$control)
for (u in U$control){# for each control, and each MC year,
# get the minimum reward for all possible controls smaller than u
cost[cost$control==u,'min_previous_reward'] <- cost %>% dplyr::filter(.data$control<=u) %>%
dplyr::group_by(.data$mcYear, .data$timeId) %>%
dplyr::mutate(min_previous_reward = min(.data$reward)) %>%
dplyr::ungroup() %>%
dplyr::filter(.data$control==u) %>%
dplyr::select("min_previous_reward")
}
cost <- cost %>% dplyr::select(-c("reward")) %>%
dplyr::rename("reward" = "min_previous_reward")
# replace values
reward <- cost[,c("timeId","mcYear","reward","simulation","sim","control")]
}
# Retrieving reward for control 0 for each MC year and each week
# and subtracting this value to all rewards with same year and same week
reward <- dplyr::filter(reward,.data$control==0) %>%
dplyr::select("mcYear","timeId","reward") %>%
dplyr::right_join(reward,by=c("mcYear","timeId"),suffix=c("_0","")) %>%
dplyr::mutate(reward=.data$reward_0-.data$reward) %>%
dplyr::select(-c("reward_0","simulation","sim"))
reward <- as.data.table(reward)
options("antares" = opts)
# Prepare output
output <- list()
output$reward <- reward
output$simulation_names <- simulation_names
output$simulation_values <- simulation_values
} else {
if(is.null(pump_eff)){
pump_eff <- getPumpEfficiency(area=area, opts = opts)
}
max_hydro <- dplyr::rename(max_hydro,"P_max"="pump","T_max"="turb")
assertthat::assert_that(min(max_hydro$T_max)>0)
# Creating possible controls if none
if(is.null(possible_controls)){
nb_hours <- length(hours)
possible_controls <- data.frame(expand.grid(h=1:(2*nb_hours-1),week=1:52)) %>%
dplyr::left_join(get_max_hydro(area,opts,"weekly"),by=c("week"="timeId")) %>%
dplyr::mutate(i=dplyr::if_else(.data$h>nb_hours,2*nb_hours-.data$h,.data$h)) %>%
dplyr::mutate(u=dplyr::if_else(.data$h>nb_hours,.data$turb/168*(168-hours[.data$i]),.data$pump/168*(hours[.data$i]-168)*pump_eff)) %>%
dplyr::select("week","u")
}
# Transforming simulation values such that for each week there is a line
# and for each simulation there is a column
u <- simulation_values %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$sim,"\\d+$"))) %>%
dplyr::group_by(.data$sim) %>%
tidyr::nest() %>%
tidyr::pivot_wider(names_from=.data$sim,values_from=.data$data)
# Interpolate reward for each simulation
{reward <- mapply(
FUN = function(o,u) {
if (min(max_hydro$P_max)>0){
res <- get_local_reward(o,hours,possible_controls,max_hydro,area,mcyears,
district_balance,pump_eff)
} else {
res <- get_local_reward_turb(o,possible_controls,max_hydro,area,mcyears,
district_balance)
}
res <- reward_offset(o,res, u,mcyears,district_name,fictive_areas=fictive_areas, expansion=expansion)
res
},
o = opts_o,
u = u,
SIMPLIFY = F
)}
reward <- rbindlist(reward) #merge the all simulations tables together
# Getting the minimum reward for each year, each week and each control (u)
reward <- reward %>%
dplyr::group_by(.data$mcYear,.data$week,.data$u) %>% dplyr::summarise(reward=min(.data$reward),.groups="drop")
#Subtracting the reward corresponding to control 0 for each year and each week
reward <- dplyr::filter(reward,.data$u==0) %>% dplyr::select("mcYear","week","reward") %>%
dplyr::right_join(reward,by=c("mcYear","week"),suffix=c("_0","")) %>%
dplyr::mutate(reward=.data$reward-.data$reward_0) %>%
dplyr::rename("timeId"="week","control"="u") %>%
dplyr::select(-c("reward_0"))
reward <- as.data.table(reward)
options("antares" = opts)
# Prepare output
output <- list()
output$reward <- reward
output$simulation_names <- simulation_names
output$simulation_values <- possible_controls
}
class(output) <- "Reward matrix , simulation names and values"
return(output)
}
#' Calculate rewards for a simulation based on marginal prices, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param hours vector of hours used to evaluate costs/rewards of pumping/generating
#' @param possible_controls data.frame {week,u} of controls evaluated per week
#' @param area_price Area used to evaluate marginal prices
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param pump_eff Pumping efficiency
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
get_local_reward <- function(opts,hours,possible_controls,max_hydro,area_price,mcyears,
district_balance="water values district",pump_eff=1){
# Transform hours in negative hours
hours <- unique(c(-hours, hours))
# Get hourly marginal prices and energy pumped and generated for each hour
price <- antaresRead::readAntares(areas=area_price,select=c("MRG. PRICE"),
opts=opts,mcYears = mcyears, timeStep = "hourly") %>%
dplyr::select(-c("day","month","hour","area","time")) %>%
dplyr::left_join(antaresRead::readAntares(districts=district_balance,select=c("BALANCE"),
opts=opts,mcYears = mcyears, timeStep = "hourly"),by=c("timeId","mcYear")) %>%
dplyr::select(-c("day","month","hour","district","time")) %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::rename(price="MRG. PRICE",balance="BALANCE")
# Evaluate how much reward one can make by generating at the maximum power for each hour of the week
price_turb_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>% dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
# Evaluate how much reward one can loose by not generating for each hour of the week
price_turb_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,.data$balance,0L)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,.data$balance,0L)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb <- rbind(price_turb_less,price_turb_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$reward_turb)
# Transforming price into intervals of hours and associated reward
price_turb_int <- price_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# Evaluate how much has been generated in the simulation
hour_turb_0 <- price_turb %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_turb_0=-round(min(.data$hour_turb),5),.groups="drop")
# Evaluate for each hour h of hours the variation of gain if the number of generating hours
# varies by h
hour_turb <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_turb=hours)) %>%
rbind(dplyr::select(dplyr::mutate(hour_turb_0,hour_turb=round(-.data$hour_turb_0,5)),-c("hour_turb_0"))) %>%
rbind(dplyr::select(dplyr::mutate(hour_turb_0,hour_turb=round(168-.data$hour_turb_0,5)),-c("hour_turb_0"))) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week")) %>%
dplyr::filter(.data$hour_turb+.data$hour_turb_0>=0,.data$hour_turb+.data$hour_turb_0<=168) %>%
dplyr::select(-c("hour_turb_0")) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb>=y$hour_turb_inf,
x$hour_turb<=y$hour_turb_sup)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.keep_all=T) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb-.data$hour_turb_inf),
.data$reward_turb_inf)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup"))
# Transforming into interval of hours and associated reward
price_turb_int <- hour_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# We next do exactly the same for pumping
price_pump_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(cost_pump=cumsum(price*dplyr::if_else(.data$balance>0,(.data$P_max-.data$balance),.data$P_max)),
vol_pump=cumsum(dplyr::if_else(.data$balance>0,(.data$P_max-.data$balance),.data$P_max)),
hour_pump=.data$vol_pump/.data$P_max) %>%
dplyr::select("mcYear","week","hour_pump","cost_pump") %>% dplyr::ungroup()
price_pump_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::mutate(cost_pump=cumsum(price*dplyr::if_else(.data$balance>0,-.data$balance,0L)),
vol_pump=cumsum(dplyr::if_else(.data$balance>0,-.data$balance,0L)),
hour_pump=.data$vol_pump/.data$P_max) %>%
dplyr::select("mcYear","week","hour_pump","cost_pump") %>% dplyr::ungroup()
price_pump <- rbind(price_pump_less,price_pump_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.data$cost_pump)
price_pump_int <- price_pump %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_pump) %>%
dplyr::mutate(hour_pump_inf=round(.data$hour_pump,5),cost_pump_inf=.data$cost_pump,
hour_pump_sup=round(dplyr::lead(.data$hour_pump),5),cost_pump_sup=dplyr::lead(.data$cost_pump)) %>%
dplyr::select(-c("hour_pump","cost_pump")) %>%
tidyr::drop_na()
hour_pump_0 <- price_pump_int %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_pump_0=-round(min(.data$hour_pump_inf),5),.groups="drop")
hour_pump <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_pump=hours)) %>%
rbind(dplyr::select(dplyr::mutate(hour_pump_0,hour_pump=round(-.data$hour_pump_0,5)),-c("hour_pump_0"))) %>%
rbind(dplyr::select(dplyr::mutate(hour_pump_0,hour_pump=round(168-.data$hour_pump_0,5)),-c("hour_pump_0"))) %>%
dplyr::left_join(hour_pump_0,by=c("mcYear","week")) %>%
dplyr::filter(.data$hour_pump+.data$hour_pump_0>=0,.data$hour_pump+.data$hour_pump_0<=168) %>%
dplyr::select(-c("hour_pump_0")) %>%
dplyr::left_join(price_pump_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_pump>=y$hour_pump_inf,
x$hour_pump<=y$hour_pump_sup)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.keep_all=T) %>%
dplyr::mutate(cost_pump=dplyr::if_else(.data$hour_pump_inf!=.data$hour_pump_sup,
.data$cost_pump_inf+(.data$cost_pump_sup-.data$cost_pump_inf)/(.data$hour_pump_sup-.data$hour_pump_inf)*(.data$hour_pump-.data$hour_pump_inf),
.data$cost_pump_inf)) %>%
dplyr::select(-c("hour_pump_inf","hour_pump_sup","cost_pump_inf","cost_pump_sup"))
price_pump_int <- hour_pump %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_pump) %>%
dplyr::mutate(hour_pump_inf=round(.data$hour_pump,5),cost_pump_inf=.data$cost_pump,
hour_pump_sup=round(dplyr::lead(.data$hour_pump),5),cost_pump_sup=dplyr::lead(.data$cost_pump)) %>%
dplyr::select(-c("hour_pump","cost_pump")) %>%
tidyr::drop_na()
# Maximum generating and pumping powers per hour
max_hydro <- max_hydro %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::group_by(week) %>%
dplyr::summarise(P_max=mean(.data$P_max),T_max=mean(.data$T_max),.groups = "drop")
# Initialize a data.frame with one line per MC year per control
if ("mcYear" %in% names(possible_controls)){
df_reward <- possible_controls
assertthat::assert_that(identical(unique(possible_controls$mcYear),mcyears))
} else {
df_reward <- data.frame(tidyr::expand_grid(mcYear=mcyears,possible_controls))
}
df_reward <- df_reward %>%
dplyr::left_join(max_hydro,by=c("week")) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week")) %>%
dplyr::left_join(hour_pump_0,by=c("mcYear","week"))
# Evaluate extreme generating and pumping, ie for each control, the adequate amount of hours
# pumping and generating such that the control corresponded and the total number of hours is 168
df_reward_extreme <- df_reward %>%
dplyr::mutate(hour_turb_exact=round((.data$u+168*.data$P_max*pump_eff)/(.data$T_max+.data$P_max*pump_eff)-.data$hour_turb_0,5),
hour_pump_exact=168-.data$hour_turb_exact-.data$hour_pump_0-.data$hour_turb_0) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward_turb=round(.data$reward_turb,5)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup")) %>%
dplyr::rename(hour_turb="hour_turb_exact") %>%
dplyr::distinct(.data$mcYear,.data$week,.data$u,.keep_all = T)
# Calculate from hour_turb how much pumping is necessary to correspond to control and calculate the reward
df_reward_turb <- dplyr::full_join(hour_turb, df_reward, by=c("mcYear","week"),relationship = "many-to-many") %>%
dplyr::mutate(hour_pump_exact=round((-.data$u+.data$T_max*(.data$hour_turb_0+.data$hour_turb))/pump_eff/.data$P_max-.data$hour_pump_0,5)) %>%
dplyr::filter((.data$hour_pump_exact+.data$hour_pump_0>=0)&(.data$hour_turb+.data$hour_turb_0+.data$hour_pump_exact+.data$hour_pump_0<=168)) %>%
rbind(df_reward_extreme) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$u,.keep_all = T) %>%
dplyr::left_join(price_pump_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_pump_exact>=y$hour_pump_inf,
x$hour_pump_exact<=y$hour_pump_sup)) %>%
dplyr::mutate(cost_pump=dplyr::if_else(.data$hour_pump_inf!=.data$hour_pump_sup,
.data$cost_pump_inf+(.data$cost_pump_sup-.data$cost_pump_inf)/(.data$hour_pump_sup-.data$hour_pump_inf)*(.data$hour_pump_exact-.data$hour_pump_inf),
.data$cost_pump_inf),
reward = .data$reward_turb-.data$cost_pump) %>%
dplyr::select("mcYear","week","u","reward")
# Same from hour_pump
df_reward_pump <- dplyr::full_join(hour_pump, df_reward, by=c("mcYear","week"),relationship = "many-to-many") %>%
dplyr::mutate(hour_turb_exact=round((.data$u+.data$P_max*pump_eff*(.data$hour_pump_0+.data$hour_pump))/.data$T_max-.data$hour_turb_0,5)) %>%
dplyr::filter((.data$hour_turb_exact+.data$hour_turb_0>=0)&(.data$hour_turb_exact+.data$hour_turb_0+.data$hour_pump+.data$hour_pump_0<=168)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.data$u,.keep_all = T) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward_turb=round(.data$reward_turb,5),
reward = .data$reward_turb-.data$cost_pump) %>%
dplyr::select("mcYear","week","u","reward")
# Bind the data.frame and calculate the best combination of generating and pumping hours for each control
df_reward <- rbind(df_reward_pump,df_reward_turb) %>%
dplyr::group_by(.data$mcYear,.data$week,.data$u) %>%
dplyr::slice_max(.data$reward,with_ties = F) %>% dplyr::ungroup()
return(df_reward)
}
#' Calculate rewards for a simulation based on marginal prices for a stock
#' with only generating power, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param possible_controls data.frame {week,u} of controls evaluated per week
#' @param area_price Area used to evaluate marginal prices
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
get_local_reward_turb <- function(opts,possible_controls,max_hydro,area_price,mcyears,
district_balance="water values district"){
price <- antaresRead::readAntares(areas=area_price,select=c("MRG. PRICE"),
opts=opts,mcYears = mcyears, timeStep = "hourly") %>%
dplyr::select(-c("day","month","hour","area","time")) %>%
dplyr::left_join(antaresRead::readAntares(districts=district_balance,select=c("BALANCE"),
opts=opts,mcYears = mcyears, timeStep = "hourly"),by=c("timeId","mcYear")) %>%
dplyr::select(-c("day","month","hour","district","time")) %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::rename(price="MRG. PRICE",balance="BALANCE")
price_turb_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::mutate(reward_turb=cumsum(.data$price*dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,.data$balance,0L)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,.data$balance,0L)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb <- rbind(price_turb_less,price_turb_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$reward_turb)
hour_turb_0 <- price_turb %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_turb_0=-min(.data$hour_turb),.groups="drop")
price_turb_int <- price_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# hour_turb <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_turb=hours)) %>%
# dplyr::left_join(price_turb_int, by=dplyr::join_by(mcYear,week,hour_turb>=hour_turb_inf,
# hour_turb<=hour_turb_sup)) %>%
# dplyr::mutate(reward_turb=dplyr::if_else(hour_turb_inf!=hour_turb_sup,
# reward_turb_inf+(reward_turb_sup-reward_turb_inf)/(hour_turb_sup-hour_turb_inf)*(hour_turb-hour_turb_inf),
# reward_turb_inf)) %>%
# dplyr::select(-c(hour_turb_inf,hour_turb_sup,reward_turb_inf,reward_turb_sup))
# Maximum generating and pumping powers per hour
max_hydro <- max_hydro %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::group_by(week) %>%
dplyr::summarise(P_max=mean(.data$P_max),T_max=mean(.data$T_max),.groups = "drop")
if ("mcYear" %in% names(possible_controls)){
df_reward <- possible_controls
assertthat::assert_that(identical(unique(possible_controls$mcYear),mcyears))
} else {
df_reward <- data.frame(tidyr::expand_grid(mcYear=mcyears,possible_controls))
}
df_reward <- df_reward %>%
dplyr::left_join(max_hydro,by=c("week")) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week"))
df_reward <- df_reward %>%
dplyr::mutate(hour_turb_exact=round(.data$u/.data$T_max-.data$hour_turb_0,5)) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward=round(.data$reward,5)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup")) %>%
dplyr::rename(hour_turb="hour_turb_exact") %>%
dplyr::select("mcYear","week","u","reward") %>%
dplyr::distinct(.data$mcYear,.data$week,.data$u,.keep_all = T)
return(df_reward)
}
#' Modify local reward to take into account overall cost of the simulation, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param df_reward data.table computed by the function \code{get_local_reward}
#' @param u0 data.table {week,u} Constraint values per week used in the simulation, empty list if none
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_cost Name of district used to evaluate overall cost
#' @param expansion Binary. True if mode expansion was used to run simulations
#' @param fictive_areas Vector of chr. Fictive areas used in simulation
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
reward_offset <- function(opts, df_reward, u0=c(),mcyears,district_cost= "water values district",
fictive_areas=NULL, expansion = F){
cost <- get_weekly_cost(district = district_cost, mcyears = mcyears, opts = opts,
fictive_areas = fictive_areas, expansion=expansion) %>%
dplyr::rename(week="timeId") %>%
dplyr::select("mcYear","week","ov_cost") %>%
as.data.frame()
if (sum(is.na(u0))>=1){
u0 <- c()
}
if (length(u0)>0){
u0 <- u0[[1]] %>%
dplyr::rename("u0"="u")
if ("mcYear" %in% names(u0)){
df_reward <- df_reward %>%
dplyr::left_join(u0,by=c("week","mcYear"))
} else {
df_reward <- df_reward %>%
dplyr::left_join(u0,by=c("week"))
}
df_reward <- df_reward %>%
dplyr::left_join(dplyr::select(dplyr::filter(df_reward,.data$u==u0),
"mcYear","week","reward"),
by=c("mcYear","week"),suffix=c("","_0")) %>%
dplyr::mutate(reward = .data$reward-.data$reward_0) %>%
dplyr::select(-c("reward_0","u0"))
}
df_reward <- df_reward %>%
dplyr::left_join(cost,by=c("mcYear","week")) %>%
dplyr::mutate(reward = .data$reward-.data$ov_cost) %>%
dplyr::select(-c("ov_cost"))
return(df_reward)
}
rte-antares-rpackage/antaresWaterValues documentation built on Nov. 6, 2024, 11:17 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions reward_offset get_local_reward_turb get_local_reward get_Reward
Documented in get_local_reward get_local_reward_turb get_Reward reward_offset
#' Get the reward matrix from simulations, mainly used in \code{Grid_Matrix}
#'
#' @param simulation_names
#' generated by \code{runWaterValuesSimulation}
#' @param pattern A pattern to identify simulations.
#' @param district_name Name of the district used to store output.
#' @param opts
#' List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param correct_monotony Binary argument (default to false). True to correct monotony of rewards.
#' @param method_old If T, linear interpolation used between simulations reward, else smarter interpolation based on marginal prices
#' @param hours If method_old=F, vector of hours used to evaluate costs/rewards of pumping/generating
#' @param possible_controls If method_old=F, data.frame {week,u} of controls evaluated per week
#' @param mcyears Vector of years used to evaluate rewards
#' @param area Area used to calculate watervalues
#' @param pump_eff Pumping efficiency
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param simulation_values Values generated by \code{runWaterValuesSimulation}
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#' @param expansion Binary. True if mode expansion was used to run simulations
#' @param fictive_areas Vector of chr. Fictive areas used in simulation
#'
#' @return list containing a data.table {timeid,MCyear,simulation overall cost}, list of simulations names and list of simulations values
#' @export
#'
get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern = NULL,
district_name = "water values district",
opts = antaresRead::simOptions(), correct_monotony = FALSE,
method_old = TRUE, hours=0:168, possible_controls = NULL,
max_hydro, mcyears = "all",area=NULL,pump_eff=NULL,
district_balance="water values district",
expansion=F,fictive_areas=NULL) {
assertthat::assert_that(class(opts) == "simOptions")
assertthat::assert_that(district_name %in% antaresRead::getDistricts(opts=opts))
studyPath <- opts$studyPath
# just a test if there is a simulation done or not
{if (is.null(simulation_names)) {
if (is.null(pattern))
stop("If 'simulation_names' is not provided, 'pattern' cannot be NULL.")
simulation_names <- getSimulationNames(pattern = pattern, studyPath = studyPath)
}}
# this part prepare the environment of each simulation
{
opts_o <- lapply(
X = simulation_names,
FUN = function(i) {
suppressWarnings({
antaresRead::setSimulationPath(path = studyPath, simulation = i)
})
}
)
}
# check that the MC years are in simulations
for (o in 1:length(opts_o)){
assertthat::assert_that(all(mcyears %in% opts_o[[o]]$mcYears),
msg="Those MC years didn't have been all simulated, check your simulation.")
}
if(method_old){
#generate a table containing the year, the time id (IE week) and overall cost
{reward <- lapply(
X = opts_o,
FUN = function(o) {
res <- get_weekly_cost(district = district_name, mcyears = mcyears, opts = o,
fictive_areas = fictive_areas, expansion = expansion)
res$simulation <- o$name
res
}
)}
reward <- rbindlist(reward) #merge the all simulations tables together
# Getting the controls applied in each simulation
decisions <- simulation_values %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$sim, "\\d+$")))
# Joining controls to rewards
reward <- reward %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$simulation, "\\d+$")))
if ("mcYear" %in% names(decisions)){
reward <- reward %>%
dplyr::left_join(decisions,by=c("sim","timeId"="week","mcYear"))
} else {
reward <- reward %>%
dplyr::left_join(decisions,by=c("sim","timeId"="week"))
}
reward <- reward %>%
dplyr::rename(reward="ov_cost",control="u")
if (correct_monotony){
cost <- reward
# Getting possible controls
U <- cost %>%
dplyr::select("control") %>%
dplyr::distinct() %>%
dplyr::arrange()
# Initialize reward
cost <- cost %>% dplyr::mutate(min_previous_reward=.data$reward) %>%
dplyr::arrange(.data$mcYear, .data$timeId, .data$control)
for (u in U$control){# for each control, and each MC year,
# get the minimum reward for all possible controls smaller than u
cost[cost$control==u,'min_previous_reward'] <- cost %>% dplyr::filter(.data$control<=u) %>%
dplyr::group_by(.data$mcYear, .data$timeId) %>%
dplyr::mutate(min_previous_reward = min(.data$reward)) %>%
dplyr::ungroup() %>%
dplyr::filter(.data$control==u) %>%
dplyr::select("min_previous_reward")
}
cost <- cost %>% dplyr::select(-c("reward")) %>%
dplyr::rename("reward" = "min_previous_reward")
# replace values
reward <- cost[,c("timeId","mcYear","reward","simulation","sim","control")]
}
# Retrieving reward for control 0 for each MC year and each week
# and subtracting this value to all rewards with same year and same week
reward <- dplyr::filter(reward,.data$control==0) %>%
dplyr::select("mcYear","timeId","reward") %>%
dplyr::right_join(reward,by=c("mcYear","timeId"),suffix=c("_0","")) %>%
dplyr::mutate(reward=.data$reward_0-.data$reward) %>%
dplyr::select(-c("reward_0","simulation","sim"))
reward <- as.data.table(reward)
options("antares" = opts)
# Prepare output
output <- list()
output$reward <- reward
output$simulation_names <- simulation_names
output$simulation_values <- simulation_values
} else {
if(is.null(pump_eff)){
pump_eff <- getPumpEfficiency(area=area, opts = opts)
}
max_hydro <- dplyr::rename(max_hydro,"P_max"="pump","T_max"="turb")
assertthat::assert_that(min(max_hydro$T_max)>0)
# Creating possible controls if none
if(is.null(possible_controls)){
nb_hours <- length(hours)
possible_controls <- data.frame(expand.grid(h=1:(2*nb_hours-1),week=1:52)) %>%
dplyr::left_join(get_max_hydro(area,opts,"weekly"),by=c("week"="timeId")) %>%
dplyr::mutate(i=dplyr::if_else(.data$h>nb_hours,2*nb_hours-.data$h,.data$h)) %>%
dplyr::mutate(u=dplyr::if_else(.data$h>nb_hours,.data$turb/168*(168-hours[.data$i]),.data$pump/168*(hours[.data$i]-168)*pump_eff)) %>%
dplyr::select("week","u")
}
# Transforming simulation values such that for each week there is a line
# and for each simulation there is a column
u <- simulation_values %>%
dplyr::mutate(sim=as.double(stringr::str_extract(.data$sim,"\\d+$"))) %>%
dplyr::group_by(.data$sim) %>%
tidyr::nest() %>%
tidyr::pivot_wider(names_from=.data$sim,values_from=.data$data)
# Interpolate reward for each simulation
{reward <- mapply(
FUN = function(o,u) {
if (min(max_hydro$P_max)>0){
res <- get_local_reward(o,hours,possible_controls,max_hydro,area,mcyears,
district_balance,pump_eff)
} else {
res <- get_local_reward_turb(o,possible_controls,max_hydro,area,mcyears,
district_balance)
}
res <- reward_offset(o,res, u,mcyears,district_name,fictive_areas=fictive_areas, expansion=expansion)
res
},
o = opts_o,
u = u,
SIMPLIFY = F
)}
reward <- rbindlist(reward) #merge the all simulations tables together
# Getting the minimum reward for each year, each week and each control (u)
reward <- reward %>%
dplyr::group_by(.data$mcYear,.data$week,.data$u) %>% dplyr::summarise(reward=min(.data$reward),.groups="drop")
#Subtracting the reward corresponding to control 0 for each year and each week
reward <- dplyr::filter(reward,.data$u==0) %>% dplyr::select("mcYear","week","reward") %>%
dplyr::right_join(reward,by=c("mcYear","week"),suffix=c("_0","")) %>%
dplyr::mutate(reward=.data$reward-.data$reward_0) %>%
dplyr::rename("timeId"="week","control"="u") %>%
dplyr::select(-c("reward_0"))
reward <- as.data.table(reward)
options("antares" = opts)
# Prepare output
output <- list()
output$reward <- reward
output$simulation_names <- simulation_names
output$simulation_values <- possible_controls
}
class(output) <- "Reward matrix , simulation names and values"
return(output)
}
#' Calculate rewards for a simulation based on marginal prices, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param hours vector of hours used to evaluate costs/rewards of pumping/generating
#' @param possible_controls data.frame {week,u} of controls evaluated per week
#' @param area_price Area used to evaluate marginal prices
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param pump_eff Pumping efficiency
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
get_local_reward <- function(opts,hours,possible_controls,max_hydro,area_price,mcyears,
district_balance="water values district",pump_eff=1){
# Transform hours in negative hours
hours <- unique(c(-hours, hours))
# Get hourly marginal prices and energy pumped and generated for each hour
price <- antaresRead::readAntares(areas=area_price,select=c("MRG. PRICE"),
opts=opts,mcYears = mcyears, timeStep = "hourly") %>%
dplyr::select(-c("day","month","hour","area","time")) %>%
dplyr::left_join(antaresRead::readAntares(districts=district_balance,select=c("BALANCE"),
opts=opts,mcYears = mcyears, timeStep = "hourly"),by=c("timeId","mcYear")) %>%
dplyr::select(-c("day","month","hour","district","time")) %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::rename(price="MRG. PRICE",balance="BALANCE")
# Evaluate how much reward one can make by generating at the maximum power for each hour of the week
price_turb_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>% dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
# Evaluate how much reward one can loose by not generating for each hour of the week
price_turb_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,.data$balance,0L)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,.data$balance,0L)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb <- rbind(price_turb_less,price_turb_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$reward_turb)
# Transforming price into intervals of hours and associated reward
price_turb_int <- price_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# Evaluate how much has been generated in the simulation
hour_turb_0 <- price_turb %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_turb_0=-round(min(.data$hour_turb),5),.groups="drop")
# Evaluate for each hour h of hours the variation of gain if the number of generating hours
# varies by h
hour_turb <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_turb=hours)) %>%
rbind(dplyr::select(dplyr::mutate(hour_turb_0,hour_turb=round(-.data$hour_turb_0,5)),-c("hour_turb_0"))) %>%
rbind(dplyr::select(dplyr::mutate(hour_turb_0,hour_turb=round(168-.data$hour_turb_0,5)),-c("hour_turb_0"))) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week")) %>%
dplyr::filter(.data$hour_turb+.data$hour_turb_0>=0,.data$hour_turb+.data$hour_turb_0<=168) %>%
dplyr::select(-c("hour_turb_0")) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb>=y$hour_turb_inf,
x$hour_turb<=y$hour_turb_sup)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.keep_all=T) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb-.data$hour_turb_inf),
.data$reward_turb_inf)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup"))
# Transforming into interval of hours and associated reward
price_turb_int <- hour_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# We next do exactly the same for pumping
price_pump_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(cost_pump=cumsum(price*dplyr::if_else(.data$balance>0,(.data$P_max-.data$balance),.data$P_max)),
vol_pump=cumsum(dplyr::if_else(.data$balance>0,(.data$P_max-.data$balance),.data$P_max)),
hour_pump=.data$vol_pump/.data$P_max) %>%
dplyr::select("mcYear","week","hour_pump","cost_pump") %>% dplyr::ungroup()
price_pump_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::mutate(cost_pump=cumsum(price*dplyr::if_else(.data$balance>0,-.data$balance,0L)),
vol_pump=cumsum(dplyr::if_else(.data$balance>0,-.data$balance,0L)),
hour_pump=.data$vol_pump/.data$P_max) %>%
dplyr::select("mcYear","week","hour_pump","cost_pump") %>% dplyr::ungroup()
price_pump <- rbind(price_pump_less,price_pump_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.data$cost_pump)
price_pump_int <- price_pump %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_pump) %>%
dplyr::mutate(hour_pump_inf=round(.data$hour_pump,5),cost_pump_inf=.data$cost_pump,
hour_pump_sup=round(dplyr::lead(.data$hour_pump),5),cost_pump_sup=dplyr::lead(.data$cost_pump)) %>%
dplyr::select(-c("hour_pump","cost_pump")) %>%
tidyr::drop_na()
hour_pump_0 <- price_pump_int %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_pump_0=-round(min(.data$hour_pump_inf),5),.groups="drop")
hour_pump <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_pump=hours)) %>%
rbind(dplyr::select(dplyr::mutate(hour_pump_0,hour_pump=round(-.data$hour_pump_0,5)),-c("hour_pump_0"))) %>%
rbind(dplyr::select(dplyr::mutate(hour_pump_0,hour_pump=round(168-.data$hour_pump_0,5)),-c("hour_pump_0"))) %>%
dplyr::left_join(hour_pump_0,by=c("mcYear","week")) %>%
dplyr::filter(.data$hour_pump+.data$hour_pump_0>=0,.data$hour_pump+.data$hour_pump_0<=168) %>%
dplyr::select(-c("hour_pump_0")) %>%
dplyr::left_join(price_pump_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_pump>=y$hour_pump_inf,
x$hour_pump<=y$hour_pump_sup)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.keep_all=T) %>%
dplyr::mutate(cost_pump=dplyr::if_else(.data$hour_pump_inf!=.data$hour_pump_sup,
.data$cost_pump_inf+(.data$cost_pump_sup-.data$cost_pump_inf)/(.data$hour_pump_sup-.data$hour_pump_inf)*(.data$hour_pump-.data$hour_pump_inf),
.data$cost_pump_inf)) %>%
dplyr::select(-c("hour_pump_inf","hour_pump_sup","cost_pump_inf","cost_pump_sup"))
price_pump_int <- hour_pump %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_pump) %>%
dplyr::mutate(hour_pump_inf=round(.data$hour_pump,5),cost_pump_inf=.data$cost_pump,
hour_pump_sup=round(dplyr::lead(.data$hour_pump),5),cost_pump_sup=dplyr::lead(.data$cost_pump)) %>%
dplyr::select(-c("hour_pump","cost_pump")) %>%
tidyr::drop_na()
# Maximum generating and pumping powers per hour
max_hydro <- max_hydro %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::group_by(week) %>%
dplyr::summarise(P_max=mean(.data$P_max),T_max=mean(.data$T_max),.groups = "drop")
# Initialize a data.frame with one line per MC year per control
if ("mcYear" %in% names(possible_controls)){
df_reward <- possible_controls
assertthat::assert_that(identical(unique(possible_controls$mcYear),mcyears))
} else {
df_reward <- data.frame(tidyr::expand_grid(mcYear=mcyears,possible_controls))
}
df_reward <- df_reward %>%
dplyr::left_join(max_hydro,by=c("week")) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week")) %>%
dplyr::left_join(hour_pump_0,by=c("mcYear","week"))
# Evaluate extreme generating and pumping, ie for each control, the adequate amount of hours
# pumping and generating such that the control corresponded and the total number of hours is 168
df_reward_extreme <- df_reward %>%
dplyr::mutate(hour_turb_exact=round((.data$u+168*.data$P_max*pump_eff)/(.data$T_max+.data$P_max*pump_eff)-.data$hour_turb_0,5),
hour_pump_exact=168-.data$hour_turb_exact-.data$hour_pump_0-.data$hour_turb_0) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward_turb=round(.data$reward_turb,5)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup")) %>%
dplyr::rename(hour_turb="hour_turb_exact") %>%
dplyr::distinct(.data$mcYear,.data$week,.data$u,.keep_all = T)
# Calculate from hour_turb how much pumping is necessary to correspond to control and calculate the reward
df_reward_turb <- dplyr::full_join(hour_turb, df_reward, by=c("mcYear","week"),relationship = "many-to-many") %>%
dplyr::mutate(hour_pump_exact=round((-.data$u+.data$T_max*(.data$hour_turb_0+.data$hour_turb))/pump_eff/.data$P_max-.data$hour_pump_0,5)) %>%
dplyr::filter((.data$hour_pump_exact+.data$hour_pump_0>=0)&(.data$hour_turb+.data$hour_turb_0+.data$hour_pump_exact+.data$hour_pump_0<=168)) %>%
rbind(df_reward_extreme) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$u,.keep_all = T) %>%
dplyr::left_join(price_pump_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_pump_exact>=y$hour_pump_inf,
x$hour_pump_exact<=y$hour_pump_sup)) %>%
dplyr::mutate(cost_pump=dplyr::if_else(.data$hour_pump_inf!=.data$hour_pump_sup,
.data$cost_pump_inf+(.data$cost_pump_sup-.data$cost_pump_inf)/(.data$hour_pump_sup-.data$hour_pump_inf)*(.data$hour_pump_exact-.data$hour_pump_inf),
.data$cost_pump_inf),
reward = .data$reward_turb-.data$cost_pump) %>%
dplyr::select("mcYear","week","u","reward")
# Same from hour_pump
df_reward_pump <- dplyr::full_join(hour_pump, df_reward, by=c("mcYear","week"),relationship = "many-to-many") %>%
dplyr::mutate(hour_turb_exact=round((.data$u+.data$P_max*pump_eff*(.data$hour_pump_0+.data$hour_pump))/.data$T_max-.data$hour_turb_0,5)) %>%
dplyr::filter((.data$hour_turb_exact+.data$hour_turb_0>=0)&(.data$hour_turb_exact+.data$hour_turb_0+.data$hour_pump+.data$hour_pump_0<=168)) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_pump,.data$u,.keep_all = T) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward_turb=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward_turb=round(.data$reward_turb,5),
reward = .data$reward_turb-.data$cost_pump) %>%
dplyr::select("mcYear","week","u","reward")
# Bind the data.frame and calculate the best combination of generating and pumping hours for each control
df_reward <- rbind(df_reward_pump,df_reward_turb) %>%
dplyr::group_by(.data$mcYear,.data$week,.data$u) %>%
dplyr::slice_max(.data$reward,with_ties = F) %>% dplyr::ungroup()
return(df_reward)
}
#' Calculate rewards for a simulation based on marginal prices for a stock
#' with only generating power, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param possible_controls data.frame {week,u} of controls evaluated per week
#' @param area_price Area used to evaluate marginal prices
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_balance Name of district used to evaluate controls on the stock
#' @param max_hydro data.frame {timeId,pump,turb} returned by the function \code{get_max_hydro}, should be hourly values
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
get_local_reward_turb <- function(opts,possible_controls,max_hydro,area_price,mcyears,
district_balance="water values district"){
price <- antaresRead::readAntares(areas=area_price,select=c("MRG. PRICE"),
opts=opts,mcYears = mcyears, timeStep = "hourly") %>%
dplyr::select(-c("day","month","hour","area","time")) %>%
dplyr::left_join(antaresRead::readAntares(districts=district_balance,select=c("BALANCE"),
opts=opts,mcYears = mcyears, timeStep = "hourly"),by=c("timeId","mcYear")) %>%
dplyr::select(-c("day","month","hour","district","time")) %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::rename(price="MRG. PRICE",balance="BALANCE")
price_turb_more <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(dplyr::desc(.data$price),.data$balance) %>%
dplyr::mutate(reward_turb=cumsum(.data$price*dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,(.data$T_max+.data$balance),.data$T_max)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb_less <- price %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::left_join(max_hydro,by=c("timeId")) %>%
dplyr::arrange(.data$price,dplyr::desc(.data$balance)) %>%
dplyr::mutate(reward_turb=cumsum(price*dplyr::if_else(.data$balance<0,.data$balance,0L)),
vol_turb=cumsum(dplyr::if_else(.data$balance<0,.data$balance,0L)),
hour_turb=.data$vol_turb/.data$T_max) %>%
dplyr::select("mcYear","week","hour_turb","reward_turb") %>% dplyr::ungroup()
price_turb <- rbind(price_turb_less,price_turb_more) %>%
dplyr::distinct(.data$mcYear,.data$week,.data$hour_turb,.data$reward_turb)
hour_turb_0 <- price_turb %>% dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::summarise(hour_turb_0=-min(.data$hour_turb),.groups="drop")
price_turb_int <- price_turb %>%
dplyr::group_by(.data$mcYear,.data$week) %>%
dplyr::arrange(.data$hour_turb) %>%
dplyr::mutate(hour_turb_inf=round(.data$hour_turb,5),reward_turb_inf=.data$reward_turb,
hour_turb_sup=round(dplyr::lead(.data$hour_turb),5),reward_turb_sup=dplyr::lead(.data$reward_turb)) %>%
dplyr::select(-c("hour_turb","reward_turb")) %>%
tidyr::drop_na()
# hour_turb <- data.frame(tidyr::expand_grid(mcYear=mcyears,week=1:52,hour_turb=hours)) %>%
# dplyr::left_join(price_turb_int, by=dplyr::join_by(mcYear,week,hour_turb>=hour_turb_inf,
# hour_turb<=hour_turb_sup)) %>%
# dplyr::mutate(reward_turb=dplyr::if_else(hour_turb_inf!=hour_turb_sup,
# reward_turb_inf+(reward_turb_sup-reward_turb_inf)/(hour_turb_sup-hour_turb_inf)*(hour_turb-hour_turb_inf),
# reward_turb_inf)) %>%
# dplyr::select(-c(hour_turb_inf,hour_turb_sup,reward_turb_inf,reward_turb_sup))
# Maximum generating and pumping powers per hour
max_hydro <- max_hydro %>%
dplyr::mutate(week=(.data$timeId-1)%/%168+1) %>%
dplyr::group_by(week) %>%
dplyr::summarise(P_max=mean(.data$P_max),T_max=mean(.data$T_max),.groups = "drop")
if ("mcYear" %in% names(possible_controls)){
df_reward <- possible_controls
assertthat::assert_that(identical(unique(possible_controls$mcYear),mcyears))
} else {
df_reward <- data.frame(tidyr::expand_grid(mcYear=mcyears,possible_controls))
}
df_reward <- df_reward %>%
dplyr::left_join(max_hydro,by=c("week")) %>%
dplyr::left_join(hour_turb_0,by=c("mcYear","week"))
df_reward <- df_reward %>%
dplyr::mutate(hour_turb_exact=round(.data$u/.data$T_max-.data$hour_turb_0,5)) %>%
dplyr::left_join(price_turb_int, by=dplyr::join_by(x$mcYear==y$mcYear,
x$week==y$week,
x$hour_turb_exact>=y$hour_turb_inf,
x$hour_turb_exact<=y$hour_turb_sup)) %>%
dplyr::mutate(reward=dplyr::if_else(.data$hour_turb_inf!=.data$hour_turb_sup,
.data$reward_turb_inf+(.data$reward_turb_sup-.data$reward_turb_inf)/(.data$hour_turb_sup-.data$hour_turb_inf)*(.data$hour_turb_exact-.data$hour_turb_inf),
.data$reward_turb_inf),
reward=round(.data$reward,5)) %>%
dplyr::select(-c("hour_turb_inf","hour_turb_sup","reward_turb_inf","reward_turb_sup")) %>%
dplyr::rename(hour_turb="hour_turb_exact") %>%
dplyr::select("mcYear","week","u","reward") %>%
dplyr::distinct(.data$mcYear,.data$week,.data$u,.keep_all = T)
return(df_reward)
}
#' Modify local reward to take into account overall cost of the simulation, mainly used in \code{Get_Reward}
#'
#' @param opts List of simulation parameters returned by the function
#' \code{antaresRead::setSimulationPath}
#' @param df_reward data.table computed by the function \code{get_local_reward}
#' @param u0 data.table {week,u} Constraint values per week used in the simulation, empty list if none
#' @param mcyears Vector of years used to evaluate rewards
#' @param district_cost Name of district used to evaluate overall cost
#' @param expansion Binary. True if mode expansion was used to run simulations
#' @param fictive_areas Vector of chr. Fictive areas used in simulation
#'
#' @return a data.table {mcYear,week,u,reward}
#' @export
reward_offset <- function(opts, df_reward, u0=c(),mcyears,district_cost= "water values district",
fictive_areas=NULL, expansion = F){
cost <- get_weekly_cost(district = district_cost, mcyears = mcyears, opts = opts,
fictive_areas = fictive_areas, expansion=expansion) %>%
dplyr::rename(week="timeId") %>%
dplyr::select("mcYear","week","ov_cost") %>%
as.data.frame()
if (sum(is.na(u0))>=1){
u0 <- c()
}
if (length(u0)>0){
u0 <- u0[[1]] %>%
dplyr::rename("u0"="u")
if ("mcYear" %in% names(u0)){
df_reward <- df_reward %>%
dplyr::left_join(u0,by=c("week","mcYear"))
} else {
df_reward <- df_reward %>%
dplyr::left_join(u0,by=c("week"))
}
df_reward <- df_reward %>%
dplyr::left_join(dplyr::select(dplyr::filter(df_reward,.data$u==u0),
"mcYear","week","reward"),
by=c("mcYear","week"),suffix=c("","_0")) %>%
dplyr::mutate(reward = .data$reward-.data$reward_0) %>%
dplyr::select(-c("reward_0","u0"))
}
df_reward <- df_reward %>%
dplyr::left_join(cost,by=c("mcYear","week")) %>%
dplyr::mutate(reward = .data$reward-.data$ov_cost) %>%
dplyr::select(-c("ov_cost"))
return(df_reward)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.