Merge pull request #2 from rte-antares-rpackage/main

Main

Author: Juliette-Gerbaux

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(Grid_Matrix)
+export(changeHydroManagement)
 export(constraint_generator)
 export(getPumpEfficiency)
 export(getSimulationNames)
@@ -25,6 +26,7 @@ export(runWaterValuesSimulation)
 export(runWaterValuesSimulationMultiStock)
 export(shiny_water_values)
 export(to_Antares_Format)
+export(to_Antares_Format_bis)
 export(waterValuesViz)
 import(data.table)
 import(shiny)

R/constraints_functions.R

@@ -150,8 +150,8 @@ generate_rhs_bc <- function(constraint_value,coeff,opts){
 
   sb_file <- antaresRead::readIniFile(file.path(opts$studyPath, "settings", "scenariobuilder.dat"))
 
-  assertthat::assert_that(names(sb_file)==c("Default Ruleset"),
-                          msg="There should be only Default Ruleset in scenario builder.")
+  assertthat::assert_that(length(names(sb_file))==1,
+                          msg="There should be only ruleset in scenario builder.")
 
   sbuilder <- antaresEditObject::scenarioBuilder(
     areas = area_thermal_cluster,
@@ -176,7 +176,8 @@ generate_rhs_bc <- function(constraint_value,coeff,opts){
 
   new_sb <- unlist(list(values_sb))
   names(new_sb) <- names_sb
-  sb_file$`Default Ruleset` <- append(sb_file$`Default Ruleset`,new_sb)
+  name_ruleset <- names(sb_file)[[1]]
+  sb_file[[name_ruleset]] <- append(sb_file[[name_ruleset]],new_sb)
 
   antaresEditObject::writeIni(listData = sb_file,
                               pathIni = file.path(opts$studyPath, "settings", "scenariobuilder.dat"),

R/functions.R

@@ -237,14 +237,18 @@ get_weekly_cost <- function(district, opts=antaresRead::simOptions(),mcyears,exp
                              ov_cost=sum(.data$`OV. COST`)) %>%
       dplyr::rename("timeId"="week")
   } else {
-    assertthat::assert_that(!is.null(fictive_areas))
-    cost <- antaresRead::readAntares(areas = fictive_areas, mcYears = mcyears,
-                                     timeStep = "hourly", opts = opts, select=c("OV. COST"))
-    cost$week <- (cost$timeId-1)%/%168+1
-    cost <- dplyr::summarise(dplyr::group_by(cost,.data$week,.data$mcYear),
-                             ov_cost=sum(.data$`OV. COST`)) %>%
-      dplyr::rename("timeId"="week") %>%
-      dplyr::mutate(cost_xpansion=0)
+    if (is.null(fictive_areas)){
+      cost <- data.frame(tidyr::expand_grid(mcYear=mcyears,timeId=1:52))%>%
+        dplyr::mutate(ov_cost=0,cost_xpansion=0)
+    } else {
+      cost <- antaresRead::readAntares(areas = fictive_areas, mcYears = mcyears,
+                                       timeStep = "hourly", opts = opts, select=c("OV. COST"))
+      cost$week <- (cost$timeId-1)%/%168+1
+      cost <- dplyr::summarise(dplyr::group_by(cost,.data$week,.data$mcYear),
+                               ov_cost=sum(.data$`OV. COST`)) %>%
+        dplyr::rename("timeId"="week") %>%
+        dplyr::mutate(cost_xpansion=0)
+    }
 
     for (week in 1:52){
       for (scenario in mcyears){
@@ -389,6 +393,101 @@ to_Antares_Format <- function(data,constant=T){
 return(reshaped_matrix)
 }
 
+#' Convert water values to Antares format
+#'
+#' This function converts water values generated by \code{Grid_Matrix}
+#' to the format expected by Antares: a 365*101 matrix, where
+#' the rows are the 365 days of the year and the columns are round percentage values
+#' ranging from 0 to 100 assessing the reservoir level.
+#' Since \code{Grid_Matrix} output weekly values for an
+#' arbitrary number of reservoir levels, interpolation is performed on both scales
+#' in order to fit the desired format.
+#'
+#' @param data A data.table generated by \code{Grid_Matrix}
+#'
+#' @return A 365*101 numeric matrix
+#' @export
+to_Antares_Format_bis <- function(data){
+
+  vb <- convert_to_percent(data)
+
+  for (i in 1:nrow(vb)){
+    vb[i,4] <- ifelse(vb[i,2]!=0,2*vb[i,3]-vb[i-1,4],0)
+  }
+
+  res <- vb %>%
+    dplyr::ungroup() %>%
+    as.data.table()
+
+
+  # reshape
+  value_nodes_matrix <- dcast(
+    data = res,
+    formula = weeks ~ states_round_percent,
+    value.var = "vu"
+  )
+
+  value_nodes_matrix$weeks <- NULL
+
+  value_nodes_matrix_0 <- value_nodes_matrix[52,]
+
+  reshaped_matrix <- value_nodes_matrix[rep(seq_len(nrow(value_nodes_matrix)), each = 7), ]
+
+  reshaped_matrix <- rbind(value_nodes_matrix_0,reshaped_matrix)
+
+  return(reshaped_matrix)
+}
+
+convert_to_percent <- function(data){
+  capa <- max(data$states)
+  res <- tidyr::expand_grid(
+    states_round_percent = 0:100, weeks = unique(data$weeks)
+  )
+
+  res <- res %>%
+    dplyr::mutate(state_ref = .data$states_round_percent * capa/100) %>%
+    dplyr::left_join(data,by=c("weeks")) %>%
+    dplyr::select(c("weeks","states","value_node","state_ref",
+                    "states_round_percent","level_low","level_high",
+                    "penalty_low","penalty_high"))
+
+  top <- res %>%
+    dplyr::filter(.data$states >= .data$state_ref) %>%
+    dplyr::group_by(.data$weeks,.data$state_ref) %>%
+    dplyr::filter(.data$states==min(.data$states)) %>%
+    dplyr::select(c("weeks","state_ref","states","value_node",
+                    "states_round_percent","level_low","level_high",
+                    "penalty_low","penalty_high"))
+
+  bottom <- res %>%
+    dplyr::filter(.data$states <= .data$state_ref) %>%
+    dplyr::group_by(.data$weeks,.data$state_ref) %>%
+    dplyr::filter(.data$states==max(.data$states)) %>%
+    dplyr::select(c("weeks","state_ref","states","value_node","states_round_percent"))
+
+  vb <- dplyr::left_join(bottom,top,by=c("weeks","state_ref","states_round_percent"),
+                         suffix=c("_min","_max")) %>%
+    dplyr::mutate(vb = (.data$value_node_max-.data$value_node_min)/(
+      .data$states_max-.data$states_min)*(.data$state_ref-.data$states_min)+.data$value_node_min,
+      vb = dplyr::if_else(.data$states_min==.data$states_max,.data$value_node_min,.data$vb)) %>%
+    dplyr::arrange(.data$weeks, .data$state_ref) %>%
+    dplyr::group_by(.data$weeks) %>%
+    dplyr::mutate(value_node_dif=.data$vb-dplyr::lag(.data$vb),# Delta of Bellman values
+                  states_dif=.data$state_ref-dplyr::lag(.data$state_ref), # Delta of states
+                  mu=.data$value_node_dif /.data$states_dif, # Ratio
+                  mu=round(.data$mu,2),
+                  vu=0) %>%
+    dplyr::mutate(level_low=.data$level_low/capa*100,
+                  level_high=.data$level_high/capa*100) %>%
+    dplyr::mutate(mu=dplyr::case_when(.data$states_round_percent>.data$level_high ~ .data$mu - .data$penalty_high,
+                                      .data$states_round_percent<=.data$level_low ~ .data$mu + .data$penalty_low,
+                                      TRUE ~ .data$mu)) %>%
+    dplyr::select(c("weeks","state_ref","mu","vu","states_round_percent"))
+
+  return(vb)
+}
+
+
 #' Add fictive production and fictive load to avoid infeasabilities with binding constraints
 #'
 #' @param area A valid Antares area.
@@ -579,10 +678,11 @@ restoreScenarioBuilder <- function(opts, fictive_area){
 
   sb_file <- antaresRead::readIniFile(file.path(opts$studyPath, "settings", "scenariobuilder.dat"))
 
-  assertthat::assert_that(names(sb_file)==c("Default Ruleset"),
-                          msg="There should be only Default Ruleset in scenario builder.")
+  assertthat::assert_that(length(names(sb_file))==1,
+                          msg="There should be only one ruleset in scenario builder.")
 
-  sb_file$`Default Ruleset` <- sb_file$`Default Ruleset`[!grepl(fictive_area,names(sb_file$`Default Ruleset`))]
+  name_ruleset <- names(sb_file)[[1]]
+  sb_file[[name_ruleset]] <- sb_file[[name_ruleset]][!grepl(fictive_area,names(sb_file$`Default Ruleset`))]
 
   antaresEditObject::writeIni(listData = sb_file,
                               pathIni = file.path(opts$studyPath, "settings", "scenariobuilder.dat"),

R/get_Reward.R

@@ -126,7 +126,8 @@ get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern =
     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::mutate(reward=.data$reward_0-.data$reward) %>%
+      dplyr::mutate(reward=-.data$reward) %>%
       dplyr::select(-c("reward_0","simulation","sim"))
     reward <- as.data.table(reward)
 
@@ -174,6 +175,7 @@ get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern =
                                        district_balance)
         }
         res <- reward_offset(o,res, u,mcyears,district_name,fictive_areas=fictive_areas, expansion=expansion)
+        res <- dplyr::mutate(res,simulation=o$name)
         res
       },
       o = opts_o,
@@ -183,14 +185,15 @@ get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern =
 
 
     reward <- rbindlist(reward)   #merge the all simulations tables together
+    local_reward <- reward
 
     # 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::mutate(reward=.data$reward-.data$reward_0) %>%
       dplyr::rename("timeId"="week","control"="u") %>%
       dplyr::select(-c("reward_0"))
     reward <- as.data.table(reward)
@@ -199,6 +202,7 @@ get_Reward <- function(simulation_values = NULL,simulation_names=NULL, pattern =
     # Prepare output
     output <- list()
     output$reward <- reward
+    output$local_reward <- local_reward
     output$simulation_names <- simulation_names
     output$simulation_values <- possible_controls
   }

R/hydro_storage_functions.R

@@ -156,6 +156,7 @@ getPumpEfficiency <- function(area, force = FALSE, opts = antaresRead::simOption
 #' @param opts List of simulation parameters returned by the function
 #'   \code{antaresRead::setSimulationPath}
 #' @param area Antares area
+#' @export
 changeHydroManagement <- function(watervalues=F,heuristic=T,opts,area){
   hydro_ini <- antaresRead::readIniFile(file.path(opts$inputPath, "hydro", "hydro.ini"))
   assertthat::assert_that(area %in% names(hydro_ini$reservoir),msg = "No reservoir managment for this area, check Antares study")

R/runWaterValuesSimulation.R

@@ -458,18 +458,16 @@ runWaterValuesSimulationMultiStock <- function(list_areas,
     generate_constraints(coeff=coeff,name_constraint=paste0(binding_constraint,"_",area),
                          efficiency=list_efficiency[area],opts=opts,area = area)
 
-  }
+    opts <- antaresEditObject::createDistrict(
+      name = paste0("district_balance_",area),
+      apply_filter = "add-all",
+      remove_area = fictive_areas,
+      output = TRUE,
+      overwrite = TRUE,
+      opts = opts
+    )
 
-  opts <- antaresEditObject::createDistrict(
-    name = "water values district",
-    caption = "water values district",
-    comments = "Used for calculate water values",
-    apply_filter = "add-all",
-    remove_area = remove_area,
-    output = TRUE,
-    overwrite = TRUE,
-    opts = opts
-  )
+  }
 
   # Start the simulations
 

R/shiny_post_process.R

@@ -167,7 +167,7 @@ postProcessServer <- function(id, opts, watervalues, area) {
 
     shiny::observeEvent(input$to_antares, {
       results <- final_result()
-      reshaped_values <- to_Antares_Format(results)
+      reshaped_values <- to_Antares_Format_bis(results)
       antaresEditObject::writeWaterValues(area = area(),
                                           data = reshaped_values)
       shinyWidgets::show_alert(title = "Implement water values in Antares",