diff --git a/NAMESPACE b/NAMESPACE index 9b774894..1268b83f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -50,6 +50,7 @@ export(getPlaylist) export(getVariantCommands) export(is_antares_v7) export(is_antares_v820) +export(list_polluants_values) export(mockSimulationAPI) export(nodalOptimizationOptions) export(propertiesLinkOptions) @@ -70,6 +71,7 @@ export(searchStudy) export(setAPImode) export(setPlaylist) export(setSolverPath) +export(storage_values_default) export(updateAdequacySettings) export(updateGeneralSettings) export(updateInputSettings) diff --git a/R/API-utils.R b/R/API-utils.R index 57cd1b3e..b90e0dad 100644 --- a/R/API-utils.R +++ b/R/API-utils.R @@ -248,5 +248,15 @@ api_get_variants <- function(id, opts) { ) } - +# standardization of character strings for the API +# (e.g. cluster names, links, etc.) +transform_name_to_id <- function(name, lower = TRUE, id_dash = FALSE) { + valid_id <- gsub("[^a-zA-Z0-9_(),& -]+", " ", name) + valid_id <- trimws(valid_id) + if(lower) + valid_id <- tolower(valid_id) + if(id_dash) + valid_id <- gsub("-", "_", valid_id) + return(valid_id) +} diff --git a/R/createCluster.R b/R/createCluster.R index e217f3c5..13dbd219 100644 --- a/R/createCluster.R +++ b/R/createCluster.R @@ -156,7 +156,7 @@ createCluster <- function(area, cluster_name, group = "Other", ..., - list_polluants = NULL, + list_polluants = list_polluants_values(), time_series = NULL, prepro_data = NULL, prepro_modulation = NULL, @@ -167,8 +167,7 @@ createCluster <- function(area, assertthat::assert_that(inherits(opts, "simOptions")) # static name of list parameters of pulluants - name_list_param_poll <- c("nh3", "nox", "pm2_5", "pm5", "pm10", - "nmvoc", "so2", "op1", "op2", "op3", "op4", "op5", "co2") + name_list_param_poll <- names(list_polluants_values()) # check v860 # check list pulluants parameters @@ -179,6 +178,14 @@ createCluster <- function(area, if(!all(names(list_polluants) %in% name_list_param_poll)) stop(append("Parameter 'list_polluants' must be named with the following elements: ", paste0(name_list_param_poll, collapse= ", "))) + + # check if all elements are NULL => replace by NULL + # API (only) can't create with NULL values + all_null <- lapply(list_polluants, is.null) + all_null <- all(unlist(all_null)) + + if(all_null) + list_polluants <- NULL } @@ -456,3 +463,27 @@ createClusterRES <- function(area, # ) +#' Output polluants list for thermal clusters +#' +#' @param multi_values put values to init list values, default as `NULL` +#' +#' @return a named list +#' @export +#' +#' @examples +#' list_polluants_values() +list_polluants_values <- function(multi_values = NULL) { + list("nh3"= multi_values, + "nox"= multi_values, + "pm2_5"= multi_values, + "pm5"= multi_values, + "pm10"= multi_values, + "nmvoc"= multi_values, + "so2"= multi_values, + "op1"= multi_values, + "op2"= multi_values, + "op3"= multi_values, + "op4"= multi_values, + "op5"= multi_values, + "co2"= multi_values) +} diff --git a/R/createClusterST.R b/R/createClusterST.R index 5ba36faa..2a8dfdfb 100644 --- a/R/createClusterST.R +++ b/R/createClusterST.R @@ -1,16 +1,14 @@ #' @title Create a short-term storage cluster #' #' @description -#' `r antaresEditObject:::badge_api_no()` +#' `r antaresEditObject:::badge_api_ok()` #' #' Create a new ST-storage cluster for >= v8.6.0 Antares studies. #' #' @param area The area where to create the cluster. #' @param cluster_name Name for the cluster, it will prefixed by area name, unless you set `add_prefix = FALSE`. #' @param group Group of the cluster, one of : "PSP_open", "PSP_closed", "Pondage", "Battery", "Other". It corresponds to the type of stockage. -#' @param ... Parameters to write in the Ini file. Careful! -#' Some parameters must be set as `integers` to avoid warnings in Antares, for example, -#' to set `unitcount`, you'll have to use `unitcount = 1L`. +#' @param storage_parameters `list ` Parameters to write in the Ini file (see `Note`). #' @param PMAX_injection modulation of charging capacity on an 8760-hour basis. The values are float between 0 and 1. #' @param PMAX_withdrawal modulation of discharging capacity on an 8760-hour basis. The values are float between 0 and 1. #' @param inflows imposed withdrawals from the stock for other uses, The values are integer. @@ -20,14 +18,20 @@ #' @param overwrite Logical, overwrite the cluster or not. #' #' @template opts -#' @note five files are written in output according to the input parameters +#' @note +#' To write parameters to the `list.ini` file. You have function `storage_values_default()` who is called by default. +#' This function return `list` containing six parameters for cluster `st-storage`. +#' See example section. +#' +#' To write data (.txt file), you have parameter for each output file : #' - PMAX-injection.txt #' - PMAX-withdrawal.txt #' - inflows.txt #' - lower-rule-curve.txt #' - upper-rule-curve.txt #' -#' @seealso [editClusterST()] to edit existing clusters, [removeClusterST()] to remove clusters. +#' @seealso [editClusterST()] to edit existing clusters, [readClusterSTDesc()] to read cluster, +#' [removeClusterST()] to remove clusters. #' #' @export #' @@ -39,26 +43,41 @@ #' @examples #' \dontrun{ #' -#' library(antaresRead) -#' library(antaresEditObject) +#' # list for cluster parameters : +#' storage_values_default() #' -#' # Create a cluster : -#' createClusterST( -#' area = "fr", -#' cluster_name = "my_cluster", -#' group = "other", -#' unitcount = 1L, # or as.integer(1) -#' ) -#' # by default, cluster name is prefixed -#' # by the area name +#' # create a cluster by default (with default parameters values + default data values): +#' createClusterST(area = "my_area", +#' "my_cluster") +#' +#' # Read cluster in study +#' # by default, cluster name is prefixed +#' # by the area name #' levels(readClusterSTDesc()$cluster) -#' # > "fr_my_cluster" +#' # > "my_area_my_cluster" +#' +#' # create cluster with custom parameter and data +#' my_parameters <- storage_values_default() +#' my_parameters$efficiency <- 0.5 +#' my_parameters$reservoircapacity <- 10000 +#' +#' +#' inflow_data <- matrix(3, 8760) +#' ratio_data <- matrix(0.7, 8760) +#' createClusterST(area = "my_area", +#' "my_cluster", +#' storage_parameters = my_parameters, +#' PMAX_withdrawal = ratio_data, +#' inflows = inflow_data, +#' PMAX_injection = ratio_data, +#' lower_rule_curve = ratio_data, +#' upper_rule_curve = ratio_data) #' } #' createClusterST <- function(area, cluster_name, - group = "Other", - ..., + group = "Other1", + storage_parameters = storage_values_default(), PMAX_injection = NULL, PMAX_withdrawal = NULL, inflows = NULL, @@ -67,93 +86,123 @@ createClusterST <- function(area, add_prefix = TRUE, overwrite = FALSE, opts = antaresRead::simOptions()) { - - # Check that the study has a valid type + + # check study parameters assertthat::assert_that(inherits(opts, "simOptions")) - # Check if the study has a valid version, >= v860 - # TODO use check_active_ST from script ST.R - if (!opts$antaresVersion >= 860) - stop("Antares study must be >= v8.6.0") + # check study version + check_active_ST(opts = opts) - # We define there, the different groups + # statics groups st_storage_group <- c("PSP_open", "PSP_closed", "Pondage", "Battery", - "Other") + paste0("Other", + seq(1,5))) - # Check that the group name is valid + # check group if (!is.null(group) && !tolower(group) %in% tolower(st_storage_group)) warning( "Group: '", group, "' is not a valid name recognized by Antares,", " you should be using one of: ", paste(st_storage_group, collapse = ", ") ) - # Input path - inputPath <- opts$inputPath + # check area exsiting in current study check_area_name(area, opts) area <- tolower(area) - #Assign to the differents variables, the name of the file and the default value + ## + # check parameters (ini file) + ## + assertthat::assert_that(inherits(storage_parameters, "list")) + + # static name of list parameters + names_parameters <- names(storage_values_default()) + + if(!all(names(storage_parameters) %in% names_parameters)) + stop(append("Parameter 'st-storage' must be named with the following elements: ", + paste0(names_parameters, collapse= ", "))) + + # check values parameters + .st_mandatory_params(list_values = storage_parameters) + + + # DATA parameters : default value + name txt file storage_value <- list(PMAX_injection = list(N=1, string = "PMAX-injection"), PMAX_withdrawal = list(N=1, string = "PMAX-withdrawal"), inflows = list(N=0, string = "inflows"), lower_rule_curve = list(N=0, string = "lower-rule-curve"), upper_rule_curve = list(N=1, string = "upper-rule-curve")) + # check data for (name in names(storage_value)){ if (!(is.null(dim(get(name))) || (identical(dim(get(name)), c(8760L, 1L))))){ stop(paste0("Input data for ", name, " must be 8760*1")) } } - # Cluster's parameters - params_cluster <- hyphenize_names(list(...)) + # check syntax ini parameters + params_cluster <- hyphenize_names(storage_parameters) if (add_prefix) cluster_name <- paste(area, cluster_name, sep = "_") params_cluster <- c(list(name = cluster_name, group = group),params_cluster) - # ################# - - # # API block - # #TODO - # if (antaresEditObject:::is_api_study(opts)) { - # - # cmd <- api_command_generate( - # action = "create_cluster", - # area_id = area, - # cluster_name = cluster_name, - # parameters = params_cluster - # ) - # - # api_command_register(cmd, opts = opts) - # `if`( - # should_command_be_executed(opts), - # api_command_execute(cmd, opts = opts, text_alert = "{.emph create_cluster}: {msg_api}"), - # cli_command_registered("create_cluster") - # ) - # - # for (i in names(storage_value)){ - # if (!is.null(get(i))) { - # currPath <- paste0("input/st-storage/series/%s/%s/",storage_value[[i]]$string) - # cmd <- api_command_generate( - # action = "replace_matrix", - # target = sprintf(currPath, area, tolower(cluster_name)), - # matrix = time_series - # ) - # api_command_register(cmd, opts = opts) - # `if`( - # should_command_be_executed(opts), - # api_command_execute(cmd, opts = opts, text_alert = "Writing cluster's series: {msg_api}"), - # cli_command_registered("replace_matrix") - # ) - # } - # } - # - # return(invisible(opts)) - # } - # ########################## - + ################# - + # API block + if (is_api_study(opts)) { + # format name for API + cluster_name <- transform_name_to_id(cluster_name) + params_cluster$name <- cluster_name + + cmd <- api_command_generate( + action = "create_st_storage", + area_id = area, + parameters = params_cluster + ) + api_command_register(cmd, opts = opts) + `if`( + should_command_be_executed(opts), + api_command_execute(cmd, opts = opts, text_alert = "{.emph create_st_storage}: {msg_api}"), + cli_command_registered("create_st_storage") + ) + + for (i in names(storage_value)){ + if (!is.null(get(i))) { + # format name for API + data_param_name <- transform_name_to_id(storage_value[[i]]$string, + id_dash = TRUE) + + currPath <- paste0("input/st-storage/series/%s/%s/",data_param_name) + cmd <- api_command_generate( + action = "replace_matrix", + target = sprintf(currPath, area, cluster_name), + matrix = get(i) + ) + api_command_register(cmd, opts = opts) + `if`( + should_command_be_executed(opts), + api_command_execute(cmd, + opts = opts, + text_alert = paste0("Writing ", + i, + " cluster's series: {msg_api}")), + cli_command_registered("replace_matrix") + ) + } + } + + return(invisible(opts)) + } + ########################## - + + + ## + # parameters traitements + ## + + inputPath <- opts$inputPath assertthat::assert_that(!is.null(inputPath) && file.exists(inputPath)) # named list for writing ini file @@ -197,7 +246,15 @@ createClusterST <- function(area, x = k, row.names = FALSE, col.names = FALSE, sep = "\t", file = file.path(inputPath, "st-storage", "series", tolower(area), tolower(cluster_name), paste0(storage_value[[name]]$string, ".txt")) ) - } + } else { + # write data + fwrite( + x = get(name), row.names = FALSE, col.names = FALSE, sep = "\t", + file = file.path(inputPath, "st-storage", "series", tolower(area), + tolower(cluster_name), + paste0(storage_value[[name]]$string, ".txt")) + ) + } } # Update simulation options object @@ -208,3 +265,72 @@ createClusterST <- function(area, invisible(res) } + + +# check parameters (`list`) +#' @return `list` +.st_mandatory_params <- function(list_values){ + .is_ratio(list_values$efficiency, + "efficiency") + + .check_capacity(list_values$reservoircapacity, + "reservoircapacity") + # if(!list_values$reservoircapacity >= 0) + # stop("reservoircapacity must be >= 0", + # call. = FALSE) + + .is_ratio(list_values$initiallevel, + "initiallevel") + + .check_capacity(list_values$withdrawalnominalcapacity, + "withdrawalnominalcapacity") + # if(!list_values$withdrawalnominalcapacity >= 0) + # stop("withdrawalnominalcapacity must be >= 0", + # call. = FALSE) + + .check_capacity(list_values$injectionnominalcapacity, + "injectionnominalcapacity") + # if(!list_values$injectionnominalcapacity >= 0) + # stop("injectionnominalcapacity must be >= 0", + # call. = FALSE) + + if(!is.null(list_values$initialleveloptim)) + assertthat::assert_that(inherits(list_values$initialleveloptim, + "logical")) +} + +.is_ratio <- function(x, mess){ + if(!is.null(x)){ + assertthat::assert_that(inherits(x, "numeric")) + if(!(x>=0 && x<=1)) + stop(paste0(mess, " must be in range 0-1"), + call. = FALSE) + } +} + +.check_capacity <- function(x, mess){ + if(!is.null(x)){ + assertthat::assert_that(inherits(x, "numeric")) + if(!(x>=0)) + stop(paste0(mess, " must be >= 0"), + call. = FALSE) + } +} + +#' Output polluants list for thermal clusters +#' +#' +#' @return a named list +#' @export +#' +#' @examples +#' storage_values_default() +storage_values_default <- function() { + list(efficiency = 1, + reservoircapacity = 0, + initiallevel = 0, + withdrawalnominalcapacity = 0, + injectionnominalcapacity = 0, + initialleveloptim = FALSE) +} + diff --git a/R/editClusterST.R b/R/editClusterST.R index e79be43d..445c52dc 100644 --- a/R/editClusterST.R +++ b/R/editClusterST.R @@ -1,16 +1,14 @@ #' @title Edit a short-term storage cluster #' #' @description -#' `r antaresEditObject:::badge_api_no()` +#' `r antaresEditObject:::badge_api_ok()` #' #' Edit parameters and time series of an existing `st-storage` cluster (Antares studies >= v8.6.0). #' #' @param area The area where to create the cluster. #' @param cluster_name Name for the cluster, it will prefixed by area name, unless you set `add_prefix = FALSE`. #' @param group Group of the cluster, one of : "PSP_open", "PSP_closed", "Pondage", "Battery", "Other". It corresponds to the type of stockage. -#' @param ... Parameters to write in the Ini file. Careful! -#' Some parameters must be set as `integers` to avoid warnings in Antares, for example, -#' to set `unitcount`, you'll have to use `unitcount = 1L`. +#' @param storage_parameters Parameters to write in the Ini file. #' @param PMAX_injection modulation of charging capacity on an 8760-hour basis. The values are float between 0 and 1. #' @param PMAX_withdrawal modulation of discharging capacity on an 8760-hour basis. The values are float between 0 and 1. #' @param inflows imposed withdrawals from the stock for other uses, The values are integer. @@ -25,8 +23,8 @@ #' @export editClusterST <- function(area, cluster_name, - group = "Other", - ..., + group = NULL, + storage_parameters = NULL, PMAX_injection = NULL, PMAX_withdrawal = NULL, inflows = NULL, @@ -45,65 +43,145 @@ editClusterST <- function(area, "PSP_closed", "Pondage", "Battery", - "Other") + paste0("Other", + seq(1,5))) - # Check valid group + # check valid group if (!is.null(group) && !tolower(group) %in% tolower(st_storage_group)) - warning( - "Group: '", group, "' is not a valid name recognized by Antares,", + stop( + "Group: '", group, "' is not a valid group recognized by Antares,", " you should be using one of: ", - paste(st_storage_group, collapse = ", ") + paste(st_storage_group, collapse = ", "), call. = FALSE ) - # API block - if (is_api_study(opts)) { + ## + # check parameters (ini file) + ## + params_cluster <- NULL + + if(!is.null(storage_parameters)){ + assertthat::assert_that(inherits(storage_parameters, "list")) - return(invisible(opts)) + # static name of list parameters + names_parameters <- names(storage_values_default()) + + if(!all(names(storage_parameters) %in% names_parameters)) + stop(append("Parameter 'st-storage' must be named with the following elements: ", + paste0(names_parameters, collapse= ", "))) + + # check values parameters + .st_mandatory_params(list_values = storage_parameters) + + # check list of parameters + params_cluster <- hyphenize_names(storage_parameters) } - - # Cluster's parameters + # make list of parameters area <- tolower(area) - params_cluster <- hyphenize_names(list(...)) + if(!(is.null(params_cluster)&&is.null(group))){ + if (add_prefix) + cluster_name <- paste(area, cluster_name, sep = "_") + params_cluster <- c(list(name = cluster_name, group = group), + params_cluster) + } + if(is.null(group)) + params_cluster$group <- NULL - if (add_prefix) - cluster_name <- paste(area, cluster_name, sep = "_") + ##### API block ---- + if (is_api_study(opts)) { + # format name for API + cluster_name <- transform_name_to_id(cluster_name) + + # update parameters if something else than name + if (length(params_cluster) > 1) { + currPath <- "input/st-storage/clusters/%s/list/%s" + writeIni( + listData = params_cluster, + pathIni = sprintf(currPath, area, cluster_name), + opts = opts + ) + } + + # update data + names_data_params <- c("PMAX_injection", + "PMAX_withdrawal", + "inflows", + "lower_rule_curve", + "upper_rule_curve") + + for (i in names_data_params){ + if (!is.null(get(i))) { + # format name for API + data_param_name <- transform_name_to_id(i, id_dash = TRUE) + + currPath <- paste0("input/st-storage/series/%s/%s/",data_param_name) + cmd <- api_command_generate( + action = "replace_matrix", + target = sprintf(currPath, area, cluster_name), + matrix = get(i) + ) + api_command_register(cmd, opts = opts) + `if`( + should_command_be_executed(opts), + api_command_execute(cmd, + opts = opts, + text_alert = paste0("Update ", + i, + " cluster's series: {msg_api}")), + cli_command_registered("replace_matrix") + ) + } + } + + return(invisible(opts)) + } + #####- # path to ini file - path_clusters_ini <- file.path(opts$inputPath, "st-storage", "clusters", tolower(area), "list.ini") + path_clusters_ini <- file.path(opts$inputPath, + "st-storage", + "clusters", + tolower(area), + "list.ini") if (!file.exists(path_clusters_ini)) stop("'", cluster_name, "' in area '", area, "' doesn't seems to exist.") - # read previous content of ini - previous_params <- readIniFile(file = path_clusters_ini) - - if (!tolower(cluster_name) %in% tolower(names(previous_params))){ - stop( - "'", cluster_name, "' doesn't exist, it can't be edited. You can create cluster with createCluster().", - call. = FALSE + # only edition if parameters are no NULL + if(is.null(params_cluster)) + warning("No edition for 'list.ini' file", call. = FALSE) + else{ + # read previous content of ini + previous_params <- readIniFile(file = path_clusters_ini) + + if (!tolower(cluster_name) %in% tolower(names(previous_params))){ + stop( + "'", cluster_name, "' doesn't exist, it can't be edited. You can create cluster with createCluster().", + call. = FALSE + ) + } + + # select existing cluster + ind_cluster <- which(tolower(names(previous_params)) %in% + tolower(cluster_name))[1] + previous_params[[ind_cluster]] <- utils::modifyList(x = previous_params[[ind_cluster]], + val = params_cluster) + names(previous_params)[[ind_cluster]] <- cluster_name + + # write modified ini file + writeIni( + listData = previous_params, + pathIni = path_clusters_ini, + overwrite = TRUE ) } - # select existing cluster - ind_cluster <- which(tolower(names(previous_params)) %in% - tolower(cluster_name))[1] - previous_params[[ind_cluster]] <- utils::modifyList(x = previous_params[[ind_cluster]], - val = params_cluster) - names(previous_params)[[ind_cluster]] <- cluster_name - - # write modified ini file - writeIni( - listData = previous_params, - pathIni = path_clusters_ini, - overwrite = TRUE - ) - - # PMAX_injection = NULL, - # PMAX_withdrawal = NULL, - # inflows = NULL, - # lower_rule_curve = NULL, - # upper_rule_curve - + + + + ## + # check DATA (series/) + ## + # datas associated with cluster path_txt_file <- file.path(opts$inputPath, diff --git a/R/removeCluster.R b/R/removeCluster.R index 60ef367a..926104cb 100644 --- a/R/removeCluster.R +++ b/R/removeCluster.R @@ -93,23 +93,30 @@ removeClusterST <- function(area, cluster_name <- paste(area, cluster_name, sep = "_") if (is_api_study(opts)) { + # format name for API + cluster_name <- transform_name_to_id(cluster_name) if (identical(cluster_type, "renewables")) stop("RES clusters not implemented with the API yet.") - if (identical(cluster_type, "st-storage")) - stop("st-storage clusters not implemented with the API yet.") - - cmd <- api_command_generate( - action = "remove_cluster", - area_id = area, - cluster_id = cluster_name - ) + if (identical(cluster_type, "st-storage")){ + cmd <- api_command_generate( + action = "remove_st_storage", + area_id = area, + storage_id = cluster_name + ) + }else{ + cmd <- api_command_generate( + action = "remove_cluster", + area_id = area, + cluster_id = cluster_name + ) + } api_command_register(cmd, opts = opts) `if`( should_command_be_executed(opts), - api_command_execute(cmd, opts = opts, text_alert = "{.emph remove_cluster}: {msg_api}"), - cli_command_registered("remove_cluster") + api_command_execute(cmd, opts = opts, text_alert = paste0("{.emph ", cmd$action, "}: {msg_api}")), + cli_command_registered(cmd$action) ) return(invisible(opts)) diff --git a/man/createCluster.Rd b/man/createCluster.Rd index 5c65a45b..d24d884b 100644 --- a/man/createCluster.Rd +++ b/man/createCluster.Rd @@ -10,7 +10,7 @@ createCluster( cluster_name, group = "Other", ..., - list_polluants = NULL, + list_polluants = list_polluants_values(), time_series = NULL, prepro_data = NULL, prepro_modulation = NULL, diff --git a/man/createClusterST.Rd b/man/createClusterST.Rd index 810abf2e..b50ea632 100644 --- a/man/createClusterST.Rd +++ b/man/createClusterST.Rd @@ -7,8 +7,8 @@ createClusterST( area, cluster_name, - group = "Other", - ..., + group = "Other1", + storage_parameters = storage_values_default(), PMAX_injection = NULL, PMAX_withdrawal = NULL, inflows = NULL, @@ -26,9 +26,7 @@ createClusterST( \item{group}{Group of the cluster, one of : "PSP_open", "PSP_closed", "Pondage", "Battery", "Other". It corresponds to the type of stockage.} -\item{...}{Parameters to write in the Ini file. Careful! -Some parameters must be set as \code{integers} to avoid warnings in Antares, for example, -to set \code{unitcount}, you'll have to use \code{unitcount = 1L}.} +\item{storage_parameters}{\code{list } Parameters to write in the Ini file (see \code{Note}).} \item{PMAX_injection}{modulation of charging capacity on an 8760-hour basis. The values are float between 0 and 1.} @@ -51,12 +49,16 @@ to set \code{unitcount}, you'll have to use \code{unitcount = 1L}.} An updated list containing various information about the simulation. } \description{ -\ifelse{html}{\figure{badge_api_no.svg}{options: alt='Antares API NO'}}{Antares API: \strong{NO}} +\ifelse{html}{\figure{badge_api_ok.svg}{options: alt='Antares API OK'}}{Antares API: \strong{OK}} Create a new ST-storage cluster for >= v8.6.0 Antares studies. } \note{ -five files are written in output according to the input parameters +To write parameters to the \code{list.ini} file. You have function \code{storage_values_default()} who is called by default. +This function return \code{list} containing six parameters for cluster \code{st-storage}. +See example section. + +To write data (.txt file), you have parameter for each output file : \itemize{ \item PMAX-injection.txt \item PMAX-withdrawal.txt @@ -68,23 +70,39 @@ five files are written in output according to the input parameters \examples{ \dontrun{ -library(antaresRead) -library(antaresEditObject) +# list for cluster parameters : +storage_values_default() -# Create a cluster : -createClusterST( - area = "fr", - cluster_name = "my_cluster", - group = "other", - unitcount = 1L, # or as.integer(1) -) -# by default, cluster name is prefixed -# by the area name +# create a cluster by default (with default parameters values + default data values): +createClusterST(area = "my_area", + "my_cluster") + +# Read cluster in study + # by default, cluster name is prefixed + # by the area name levels(readClusterSTDesc()$cluster) -# > "fr_my_cluster" +# > "my_area_my_cluster" + +# create cluster with custom parameter and data +my_parameters <- storage_values_default() +my_parameters$efficiency <- 0.5 +my_parameters$reservoircapacity <- 10000 + + +inflow_data <- matrix(3, 8760) +ratio_data <- matrix(0.7, 8760) +createClusterST(area = "my_area", + "my_cluster", + storage_parameters = my_parameters, + PMAX_withdrawal = ratio_data, + inflows = inflow_data, + PMAX_injection = ratio_data, + lower_rule_curve = ratio_data, + upper_rule_curve = ratio_data) } } \seealso{ -\code{\link[=editClusterST]{editClusterST()}} to edit existing clusters, \code{\link[=removeClusterST]{removeClusterST()}} to remove clusters. +\code{\link[=editClusterST]{editClusterST()}} to edit existing clusters, \code{\link[=readClusterSTDesc]{readClusterSTDesc()}} to read cluster, +\code{\link[=removeClusterST]{removeClusterST()}} to remove clusters. } diff --git a/man/editClusterST.Rd b/man/editClusterST.Rd index 276f5216..bd88decc 100644 --- a/man/editClusterST.Rd +++ b/man/editClusterST.Rd @@ -7,8 +7,8 @@ editClusterST( area, cluster_name, - group = "Other", - ..., + group = NULL, + storage_parameters = NULL, PMAX_injection = NULL, PMAX_withdrawal = NULL, inflows = NULL, @@ -25,9 +25,7 @@ editClusterST( \item{group}{Group of the cluster, one of : "PSP_open", "PSP_closed", "Pondage", "Battery", "Other". It corresponds to the type of stockage.} -\item{...}{Parameters to write in the Ini file. Careful! -Some parameters must be set as \code{integers} to avoid warnings in Antares, for example, -to set \code{unitcount}, you'll have to use \code{unitcount = 1L}.} +\item{storage_parameters}{Parameters to write in the Ini file.} \item{PMAX_injection}{modulation of charging capacity on an 8760-hour basis. The values are float between 0 and 1.} @@ -48,7 +46,7 @@ to set \code{unitcount}, you'll have to use \code{unitcount = 1L}.} An updated list containing various information about the simulation. } \description{ -\ifelse{html}{\figure{badge_api_no.svg}{options: alt='Antares API NO'}}{Antares API: \strong{NO}} +\ifelse{html}{\figure{badge_api_ok.svg}{options: alt='Antares API OK'}}{Antares API: \strong{OK}} Edit parameters and time series of an existing \code{st-storage} cluster (Antares studies >= v8.6.0). } diff --git a/man/list_polluants_values.Rd b/man/list_polluants_values.Rd new file mode 100644 index 00000000..9f48674d --- /dev/null +++ b/man/list_polluants_values.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/createCluster.R +\name{list_polluants_values} +\alias{list_polluants_values} +\title{Output polluants list for thermal clusters} +\usage{ +list_polluants_values(multi_values = NULL) +} +\arguments{ +\item{multi_values}{put values to init list values, default as \code{NULL}} +} +\value{ +a named list +} +\description{ +Output polluants list for thermal clusters +} +\examples{ +list_polluants_values() +} diff --git a/man/storage_values_default.Rd b/man/storage_values_default.Rd new file mode 100644 index 00000000..1c7639fc --- /dev/null +++ b/man/storage_values_default.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/createClusterST.R +\name{storage_values_default} +\alias{storage_values_default} +\title{Output polluants list for thermal clusters} +\usage{ +storage_values_default() +} +\value{ +a named list +} +\description{ +Output polluants list for thermal clusters +} +\examples{ +storage_values_default() +} diff --git a/tests/testthat/test-createCluster.R b/tests/testthat/test-createCluster.R index 217694df..038e2229 100644 --- a/tests/testthat/test-createCluster.R +++ b/tests/testthat/test-createCluster.R @@ -90,6 +90,25 @@ opts_test <- antaresRead::setSimulationPath(study_temp_path, "input") test_that("Create cluster with polluants params (new feature v8.6)",{ + test_that("Create cluster default call (new feature v8.6)",{ + + createCluster( + area = getAreas()[1], + cluster_name = "cluster_default", + opts = opts_test) + + res_cluster <- antaresRead::readClusterDesc() + res_cluster_default <- res_cluster[cluster %in% + paste0(getAreas()[1], "_cluster_default"),] + + polluants_names <- names(antaresEditObject::list_polluants_values()) + + values_default <- res_cluster_default[, .SD, .SDcols = polluants_names] + + # check default values + testthat::expect_equal(all(is.na(values_default)), TRUE) + }) + polluants_params <- list( "nh3"= 0.25, "nox"= 0.45, "pm2_5"= 0.25, "pm5"= 0.25, "pm10"= 0.25, "nmvoc"= 0.25, "so2"= 0.25, diff --git a/tests/testthat/test-createClusterST.R b/tests/testthat/test-createClusterST.R index 3fad3ae4..2310e6f9 100644 --- a/tests/testthat/test-createClusterST.R +++ b/tests/testthat/test-createClusterST.R @@ -5,36 +5,76 @@ opts_test <- antaresRead::setSimulationPath(study_temp_path, "input") path_master <- file.path(opts_test$inputPath, "st-storage") - -test_that("Create short-term storage cluster (new feature v8.6)",{ - - if (opts_test$antaresVersion >= 860){ - area_test = getAreas()[1] +if (opts_test$antaresVersion >= 860){ + test_that("Create short-term storage cluster (new feature v8.6)",{ + ## basics errors cases ---- + + # default area with st cluster + area_test_clust = "al" + + # study parameters + # version ? == is ST study compatibility + # valid groups ? - # createClusterST throws error for invalid area name + # valid area ? testthat::expect_error(createClusterST("INVALID_AREA", "cluster_name", opts = opts_test), - regexp = "is not a valid area name") + regexp = "is not a valid area name") - # createClusterST throws error for incorrect number of rows in storage values. - testthat::expect_error(createClusterST(area_test, "cluster1", + # bad dimension of data parameters + testthat::expect_error(createClusterST(area_test_clust, "cluster1", PMAX_injection = matrix(1, 2, 2), - opts = opts_test)) + opts = opts_test), + regexp = "Input data for") + + # cluster already exist + name_st_clust <-levels(readClusterSTDesc(opts = opts_test)$cluster) + testthat::expect_error(createClusterST(area_test_clust, + name_st_clust, + add_prefix = FALSE, + opts = opts_test), + regexp = "already exist") + + ## default creation cluster ---- - # check cluster exists with default values + ## + # check parameters (ini file) + ## + + # check name cluster + area_test <- getAreas()[1] opts_test <- createClusterST(area_test, - "cluster1", - opts = opts_test) + "cluster1", + opts = opts_test) - testthat::expect_true(paste(area_test, "cluster1", sep = "_") %in% + namecluster_check <- paste(area_test, "cluster1", sep = "_") + testthat::expect_true(namecluster_check %in% levels(readClusterSTDesc(opts = opts_test)$cluster)) + # check default parameters(names + values) + info_clusters <- readClusterSTDesc() + info_clusters <- info_clusters[cluster %in% namecluster_check, ] + + # default values + default_values <- storage_values_default() + + info_clusters <- info_clusters[, .SD, .SDcols= names(default_values)] + + # compare to default list + info_clusters <- as.list(info_clusters) + + testthat::expect_equal(default_values, info_clusters) + + ## + # check data (series files) + ## + # read series (with fread_antares) file_series <- antaresRead:::fread_antares(opts = opts_test, - file = file.path(path_master, - "series", - area_test, - paste(area_test, "cluster1", sep = "_"), - "lower-rule-curve.txt")) + file = file.path(path_master, + "series", + area_test, + paste(area_test, "cluster1", sep = "_"), + "lower-rule-curve.txt")) # check default value and dimension testthat::expect_equal(dim(file_series), c(8760, 1)) testthat::expect_equal(mean(file_series$V1), 0) @@ -42,13 +82,20 @@ test_that("Create short-term storage cluster (new feature v8.6)",{ # read series (with readInputTS) st_ts <- readInputTS(st_storage = "all", opts = opts_test) - # check to find 5 names files created previously + # check to find 5 names files created previously files_names <- unique(st_ts$name_file) - testthat::expect_equal(c("inflows", "lower-rule-curve", "PMAX-injection", "PMAX-withdrawal" , "upper-rule-curve"), - files_names) + # names files from code + original_files_names <- c("inflows", + "lower-rule-curve", + "PMAX-injection", + "PMAX-withdrawal" , + "upper-rule-curve") - # chech default values of txt files + testthat::expect_true(all(original_files_names %in% + files_names)) + + # check default values of txt files storage_value <- list(PMAX_injection = list(N=1, string = "PMAX-injection"), PMAX_withdrawal = list(N=1, string = "PMAX-withdrawal"), inflows = list(N=0, string = "inflows"), @@ -66,30 +113,148 @@ test_that("Create short-term storage cluster (new feature v8.6)",{ df_ref_default_value <- df_ref_default_value[base::order(df_ref_default_value$name_file)] - # mean of default TS created + # mean of default TS created test_txt_value <- st_ts[area %in% area_test, list(mean=mean(`st-storage`)), by=name_file] # check default values testthat::expect_equal(df_ref_default_value$mean, test_txt_value$mean) + + + ## creation cluster (explicit data) ---- + val <- 0.7 + val_mat <- matrix(val, 8760) + + opts_test <- createClusterST(area = area_test, + cluster_name = "test_storage", + storage_parameters = storage_values_default()[1], + PMAX_injection = val_mat, + PMAX_withdrawal = val_mat, + inflows = val_mat, + lower_rule_curve = val_mat, + upper_rule_curve = val_mat, + overwrite = TRUE, + opts = opts_test) + + ## check name cluster created + namecluster_check <- paste(area_test, "test_storage", sep = "_") + testthat::expect_true(namecluster_check %in% + levels(readClusterSTDesc(opts = opts_test)$cluster)) + + ## check data + + # read series (with readInputTS) + st_ts <- readInputTS(st_storage = "all", opts = opts_test) + + # check to find 5 names files created previously + filter_st_ts <- st_ts[cluster %in% namecluster_check, + list(mean=mean(`st-storage`)), + by=name_file] + + testthat::expect_true(all(filter_st_ts$name_file %in% + original_files_names)) + testthat::expect_equal(val, unique(filter_st_ts$mean)) + + + ## remove cluster---- + # RemoveClusterST (if no cluster => function read return error => see readClusterDesc tests) + opts_test <- removeClusterST(area = area_test, "cluster1", + opts = opts_test) + + testthat::expect_false(paste(area_test, "cluster1", sep = "_") %in% + levels(readClusterSTDesc(opts = opts_test)$cluster)) + #Delete study + unlink(opts_test$studyPath, recursive = TRUE) - # createClusterST throws error when cluster already exist. - testthat::expect_error(createClusterST(area_test, - "cluster1", - opts = opts_test), - regexp = "already exist") - - test_that("Remove storage cluster (new feature v8.6)", { - # RemoveClusterST (if no cluster => function read return error => see readClusterDesc tests) - opts_test <- removeClusterST(area = area_test, "cluster1", - opts = opts_test) - - testthat::expect_false(paste(area_test, "cluster1", sep = "_") %in% - levels(readClusterSTDesc(opts = opts_test)$cluster)) }) +} + + + +# API ---- + +test_that("API Command test for createClusterST", { + # Simulation parameters for api code + opts_mock <- mockSimulationAPI(force = TRUE, + antares_version = "860") + + # create complete cluster st-storage + area_name <- "area01" + cluster_name <- "ClusTER01" - } - #Delete study - unlink(opts_test$studyPath, recursive = TRUE) + # no casse sensitiv + createClusterST(area = area_name, + cluster_name = cluster_name, + group = "Other", + storage_parameters = storage_values_default(), + PMAX_injection = matrix(1,8760), + PMAX_withdrawal = matrix(0.5,8760), + inflows = matrix(0.25,8760), + lower_rule_curve = matrix(0.2,8760), + upper_rule_curve = matrix(0.9,8760)) + + # use getVariantCommands to catch information + # here (specific st-storage : `list` with 1 group (parameters) + 5 data parameters) + res_list <- getVariantCommands(last = 6) + + ## test first group of list for ini parameters + action_api_1 <- res_list[[1]] + + # name of api instruction/action + testthat::expect_equal(action_api_1$action, "create_st_storage") + # check names and values parameters + names_st_paramas <- names(storage_values_default()) + names_vector_parameters <-setdiff(names(action_api_1$args$parameters), + c("name", "group")) + # check if all parameters are present + testthat::expect_true(all(names_st_paramas + %in% names_vector_parameters)) + # check casse name cluster + name_ori <- paste0(area_name, "_", cluster_name) + + testthat::expect_equal(tolower(name_ori), + action_api_1$args$parameters$name) + + ## test other group for data + # search "replace_matrix" action + index_data <- lapply(res_list, `[[`, 1) %in% + "replace_matrix" + + data_list <- res_list[index_data] + + # test for every floor in "args" : + # "target" (path of txt file) + # "matrix" (data) + data_path_files <- lapply(data_list, function(x){ + x$args$target + }) + + # test for every path, the path destination + name of txt file + # name txt files corresponding data parameters of function `createClusterST()` + full_root_path_name <- file.path("input", "st-storage", "series", area_name, + tolower(name_ori)) + + # from code + # these names ares approved with antares desktop but not with API + names_file_list <- c("PMAX-injection", "PMAX-withdrawal", "inflows", + "lower-rule-curve", "upper-rule-curve") + + # reformat API + names_file_list <- transform_name_to_id(names_file_list, id_dash = TRUE) + + # check root path for every file + is_good_path <- lapply(data_path_files, function(x){ + grepl(pattern = full_root_path_name, x = x) + }) + + testthat::expect_true(all(unlist(is_good_path))) + + # check names of files + names_file_api <- lapply(data_path_files, function(x){ + regmatches(x,regexpr("([^\\/]+$)",x)) + }) + + testthat::expect_true(all(unlist(names_file_api) %in% + names_file_list)) }) diff --git a/tests/testthat/test-editClusterST.R b/tests/testthat/test-editClusterST.R index 5129a446..48eb14e8 100644 --- a/tests/testthat/test-editClusterST.R +++ b/tests/testthat/test-editClusterST.R @@ -1,16 +1,15 @@ -# global params for structure v8.6 ---- -setup_study_860(sourcedir860) -opts_test <- antaresRead::setSimulationPath(study_temp_path, "input") - -# need to create a "st-storage" folder -path_master <- file.path(opts_test$inputPath, "st-storage") test_that("edit st-storage clusters (only for study >= v8.6.0" , { + # global params for structure v8.6 ---- + setup_study_860(sourcedir860) + opts_test <- antaresRead::setSimulationPath(study_temp_path, "input") # areas tests area_test = getAreas()[1] - - # create tests clusters + + ## + # INIT : create tests clusters + ## opts_test <- createClusterST(area_test, "cluster-st-1", opts = opts_test) @@ -21,26 +20,101 @@ test_that("edit st-storage clusters (only for study >= v8.6.0" , { st_clusters <- readClusterSTDesc(opts = opts_test) - # edit cluster - val <- 0.007 + ## basics errors cases ---- + testthat::expect_error(editClusterST(area = area_test, + cluster_name = "cluster-st-1", + opts = "toto"), + regexp = "inherit from class simOptions") + opts_fake <- opts_test + opts_fake$antaresVersion <- 820 + testthat::expect_error(editClusterST(area = area_test, + cluster_name = "cluster-st-1", + opts = opts_fake), + regexp = "only available if using Antares >= 8.6.0") + testthat::expect_error(editClusterST(area = "area_test", + cluster_name = "cluster-st-1", + opts = opts_test), + regexp = "is not a valid area name") + testthat::expect_error(editClusterST(area = area_test, + cluster_name = levels(st_clusters$cluster)[1], + group = "new group", + add_prefix = FALSE, + opts = opts_test), + regexp = "is not a valid group recognized by Antares") + testthat::expect_error(editClusterST(area = area_test, + cluster_name = "casper", + group = "Other1", + add_prefix = FALSE, + opts = opts_test), + regexp = "'casper' doesn't exist,") + + ## default edition cluster ---- + # if all parameters are NULL => no edition of ini and data .txt + testthat::expect_warning(editClusterST(area = area_test, + cluster_name = levels(st_clusters$cluster)[1], + opts = opts_test), + regexp = "No edition for 'list.ini' file") + + ## edit list ini ---- + # edit only group value + name_cluster_test <- levels(st_clusters$cluster)[1] opts_test <- editClusterST(area = area_test, - cluster_name = levels(st_clusters$cluster)[1], - test_param1= "test", - test_param2= 0.002154, - PMAX_injection = matrix(val, 8760), - PMAX_withdrawal = matrix(val, 8760), - inflows = matrix(0.007, 8760), - lower_rule_curve = matrix(val, 8760), - upper_rule_curve = matrix(val, 8760), - opts = opts_test, - add_prefix = FALSE) + cluster_name = name_cluster_test, + group = "Other2", + add_prefix = FALSE, + opts = opts_test) + # check update "group" st_clusters <- readClusterSTDesc(opts = opts_test) + group_test <- st_clusters[cluster %in% name_cluster_test, + .SD, + .SDcols= "group"] + testthat::expect_equal("Other2", group_test$group) - res <- st_clusters[cluster == levels(st_clusters$cluster)[1], test.param1, test.param2] + # edit values (only 2 parameters) + name_cluster_test <- levels(st_clusters$cluster)[2] + list_params <- storage_values_default()[1:2] + list_params$efficiency <- 0.5 + list_params$reservoircapacity <- 50 + + initial_values <- st_clusters[cluster %in% name_cluster_test, + .SD, + .SDcols= c("efficiency", "reservoircapacity")] + + opts_test <- editClusterST(area = area_test, + cluster_name = name_cluster_test, + storage_parameters = list_params, + opts = opts_test, + add_prefix = FALSE) + + st_clusters <- readClusterSTDesc(opts = opts_test) + value_to_test <- st_clusters[cluster %in% name_cluster_test, + .SD, + .SDcols= c("group", + "efficiency", + "reservoircapacity")] - # test parameters values edited - testthat::expect_true(all(res %in% c(0.002154, "test"))) + # test value group is default + testthat::expect_equal("Other1", value_to_test$group) + + # test parameters are updated + value_to_test <- as.list(value_to_test[, .SD, + .SDcols= c("efficiency", + "reservoircapacity")]) + testthat::expect_equal(list_params, value_to_test) + + + ## edit DATA ---- + val <- 0.007 + opts_test <- editClusterST(area = area_test, + cluster_name = levels(st_clusters$cluster)[1], + PMAX_injection = matrix(val, 8760), + PMAX_withdrawal = matrix(val, 8760), + inflows = matrix(0.007, 8760), + lower_rule_curve = matrix(val, 8760), + upper_rule_curve = matrix(val, 8760), + opts = opts_test, + add_prefix = FALSE) # test data value (with fread_antares) path_dir_test <- file.path(opts_test$inputPath, "st-storage", "series", area_test, @@ -63,3 +137,91 @@ test_that("edit st-storage clusters (only for study >= v8.6.0" , { # delete study unlink(opts_test$studyPath, recursive = TRUE) }) + + + +# API ---- + +test_that("API Command test for editClusterST", { + # Simulation parameters for api code + opts_mock <- mockSimulationAPI(force = TRUE, + antares_version = "860") + + # create complete cluster st-storage + area_name <- "area01" + cluster_name <- "ClusTER01" + + # create complete cluster st-storage + editClusterST(area = area_name, + cluster_name = cluster_name, + group = "Other1", + storage_parameters = storage_values_default(), + PMAX_injection = matrix(1,8760), + PMAX_withdrawal = matrix(0.5,8760), + inflows = matrix(0.25,8760), + lower_rule_curve = matrix(0.2,8760), + upper_rule_curve = matrix(0.9,8760)) + + # use getVariantCommands to catch information + # here (specific st-storage : list with 8 group (parameters) + 5 data parameters) + res_list <- getVariantCommands(last = 13) + + ## test first group of list for ini parameters + action_api_1 <- res_list[[1]] + + # name of api instruction/action + testthat::expect_equal(action_api_1$action, "update_config") + # check "args" name parameters (just for one parameter/one action) + param_target <- res_list[[3]]$args$target + param_target <- regmatches(param_target, regexpr("([^\\/]+$)",param_target)) + testthat::expect_equal(param_target, "efficiency") + + # check "data" (value of parameter) + testthat::expect_equal("1.000000", res_list[[3]]$args$data) + + ## test other group for data + # search "replace_matrix" action + index_data <- lapply(res_list, `[[`, 1) %in% + "replace_matrix" + + data_list <- res_list[index_data] + + # test for every floor in "args" : + # "target" (path of txt file) + # "matrix" (data) + data_path_files <- lapply(data_list, function(x){ + x$args$target + }) + + # test for every path, the path destination + name of txt file + # name txt files corresponding data parameters of function `editClusterST()` + # check casse of name cluster name in every path + name_ori <- paste0(area_name, "_", cluster_name) + + full_root_path_name <- file.path("input", "st-storage", "series", area_name, + tolower(name_ori)) + + # from code + # these names are approved with antares desktop but not with API + names_file_list <- c("PMAX-injection", "PMAX-withdrawal", "inflows", + "lower-rule-curve", "upper-rule-curve") + + # reformat API + names_file_list <- transform_name_to_id(names_file_list, id_dash = TRUE) + + # check root path for every file + is_good_path <- lapply(data_path_files, function(x){ + grepl(pattern = full_root_path_name, x = x) + }) + + testthat::expect_true(all(unlist(is_good_path))) + + # check names of files + names_file_api <- lapply(data_path_files, function(x){ + regmatches(x,regexpr("([^\\/]+$)",x)) + }) + + testthat::expect_true(all(unlist(names_file_api) %in% + names_file_list)) +}) +