diff --git a/NEWS.md b/NEWS.md index 4d5fcb5e..d6b4a45e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,8 @@ It contains a table with group dimensions of time series for binding constraints BREAKING CHANGES : * `readInputThermal()` / `readInputRES()` default value when no time series in the selected clusters. +* `readClusterDesc()` / `readClusterResDesc()` / `readClusterSTDesc()` are updated with new endpoint "table mode". + - In "text" mode, functions return all properties (with default properties) according to study version. BUGFIXES : diff --git a/R/importOutput.R b/R/importOutput.R index 95036833..a944e5fd 100644 --- a/R/importOutput.R +++ b/R/importOutput.R @@ -377,14 +377,16 @@ # Get cluster capacity and must run mode clusterDesc <- readClusterDesc(opts) - if(is.null(clusterDesc$must.run)) clusterDesc$must.run <- FALSE - clusterDesc[is.na(must.run), must.run := FALSE] - if (is.null(clusterDesc$min.stable.power)) clusterDesc$min.stable.power <- 0 - clusterDesc[is.na(min.stable.power), min.stable.power := 0] + if(is.null(clusterDesc[["must-run"]])) + clusterDesc[["must-run"]] <- FALSE + clusterDesc[is.na(`must-run`), `must-run` := FALSE] + if (is.null(clusterDesc[["min-stable-power"]])) + clusterDesc[["min-stable-power"]] <- 0 + clusterDesc[is.na(`min-stable-power`), `min-stable-power` := 0] clusterDesc <- clusterDesc[, .(area, cluster, capacity = nominalcapacity * unitcount, - min.stable.power, - must.run)] + `min-stable-power`, + `must-run`)] # Are clusters in partial must run mode ? mod <- llply(areas, .importThermalModulation, opts = opts, timeStep = "hourly") @@ -449,16 +451,16 @@ } - .mergeByRef(res, clusterDesc[,.(area, cluster, must.run, min.stable.power)]) + .mergeByRef(res, clusterDesc[,.(area, cluster, `must-run`, `min-stable-power`)]) if (is.null(res$NODU)) res[, thermalPmin := 0] - else res[, thermalPmin := min.stable.power * NODU] + else res[, thermalPmin := `min-stable-power` * NODU] res[, `:=`( - mustRun = production * must.run, - mustRunTotal = production * must.run + mustRunPartial, - must.run = NULL, - min.stable.power = NULL + mustRun = production * `must-run`, + mustRunTotal = production * `must-run` + mustRunPartial, + `must-run` = NULL, + `min-stable-power` = NULL )] res[, thermalPmin := pmax(thermalPmin, mustRunTotal)] diff --git a/R/readAntares.R b/R/readAntares.R index c45afa65..86ea9683 100644 --- a/R/readAntares.R +++ b/R/readAntares.R @@ -123,7 +123,7 @@ #' similar to mustRunTotal except it also takes into account the production #' induced by the minimum stable power of the units of a cluster. More #' precisely, for a given cluster and a given time step, it is equal to -#' \code{min(NODU x min.stable.power, mustRunTotal)}. +#' \code{min(NODU x min-stable-power, mustRunTotal)}. #' @param select #' Character vector containing the name of the columns to import. If this #' argument is \code{NULL}, all variables are imported. Special names diff --git a/R/readClusterDesc.R b/R/readClusterDesc.R index dad0515e..f9f75032 100644 --- a/R/readClusterDesc.R +++ b/R/readClusterDesc.R @@ -34,6 +34,8 @@ #' \code{readClusterResDesc} : read renewable clusters (Antares >= V8.1) #' #' \code{readClusterSTDesc} : read st-storage clusters (Antares >= V8.6) +#' +#' If you have no clusters properties, `Null data.table (0 rows and 0 cols)` is returned. #' #' @examples #' @@ -92,90 +94,134 @@ readClusterSTDesc <- function(opts = simOptions()) { .readClusterDesc <- function(opts = simOptions(), dir = "thermal/clusters") { - if(isH5Opts(opts)){ - if(dir %in% "thermal/clusters"){ - if(.requireRhdf5_Antares(stopP = FALSE)){ - return(h5ReadClusterDesc(opts)) - } else { - stop(rhdf5_message, call. = FALSE) - } - } else { - stop("Read cluster Description from '", dir, "' not available using .h5", call. = FALSE) - } - } - path <- file.path(opts$inputPath, dir) - - columns <- .generate_columns_by_type(dir = dir) api_study <- is_api_study(opts) + table_type <- switch( + dir, + "thermal/clusters" = "thermals", + "renewables/clusters" = "renewables", + "st-storage/clusters" = "st-storages" + ) + if(api_study){ - jsoncld <- read_secure_json(paste0(path, "&depth=4"), token = opts$token, timeout = opts$timeout, config = opts$httr_config) - res <- rbindlist(mapply(function(X1, Y1){ - clusters <- rbindlist( - mapply(function(X, Y){ - out <- as.data.frame(X) - if(nrow(out) == 0)return(NULL) - out$area = Y - out - }, X1$list, names(X1$list), SIMPLIFY = FALSE), fill = TRUE) - if(is.null(clusters))return(NULL) - if(nrow(clusters)==0)return(NULL) - clusters$area <- Y1 - clusters[, .SD, .SDcols = order(names(clusters))] - },jsoncld, names(jsoncld), SIMPLIFY = FALSE), fill = TRUE) - - - }else{ - - areas <- list.files(path) - - res <- ldply(areas, function(x) { - clusters <- readIniFile(file.path(path, x, "list.ini")) - - if (length(clusters) == 0) return(NULL) - - clusters <- ldply(clusters, as.data.frame) - clusters$.id <- NULL - clusters$area <- x - - clusters[, c(ncol(clusters), 1:(ncol(clusters) - 1))] - }) + # api request with all columns + list_clusters = api_get( + opts = opts, + endpoint = paste0(opts$study_id, "/table-mode/", table_type), + query = list( + columns = "" + ) + ) + return(list_clusters) } + + # "text" mode + areas <- list.files(path) - if(length(res) == 0){ - mandatory_cols <- c("area","cluster") - warning("No cluster description available.", call. = FALSE) - res <- setNames(data.table(matrix(nrow = 0, ncol = length(mandatory_cols) + length(columns))), c(mandatory_cols, columns)) - }else{ - if(api_study){ - mandatory_cols <- c("area", "name", "group") - additional_cols <- setdiff(colnames(res),mandatory_cols) - res <- res[, .SD, .SDcols = c(mandatory_cols, additional_cols)] - } - res <- as.data.table(res) - setnames(res, "name", "cluster") - res$cluster <- as.factor(tolower(res$cluster)) - } + # READ cluster properties + properties <- get_input_cluster_properties(table_type = table_type, + opts = opts) + # read properties for each area + res <- plyr::llply(areas, function(x, prop_ref=properties) { + clusters <- readIniFile(file.path(path, x, "list.ini")) + if (length(clusters) == 0) + return(NULL) + # conversion list to data.frame + clusters <- plyr::ldply(clusters, function(x){ + df_clust <- data.frame(x, check.names = FALSE) + colnames_to_add <- setdiff(names(prop_ref), names(df_clust)) + if(!identical(colnames_to_add, character(0))) + df_clust <- cbind(df_clust, prop_ref[, .SD, .SDcols = colnames_to_add]) + df_clust + }) # check.names = FALSE (too many side effects) + clusters$.id <- NULL + clusters$area <- x + # re order columns + clusters[, c("area", setdiff(colnames(clusters), "area"))] + }) + + res <- data.table::rbindlist(l = res, fill = TRUE) + + # NO PROPERTIES CLUSTER FOUND + if(length(res) == 0) + return(data.table()) + + # output format conversion + res <- data.table::as.data.table(res) + data.table::setnames(res, "name", "cluster") + res$cluster <- as.factor(tolower(res$cluster)) res } -.generate_columns_by_type <- function(dir = c("thermal/clusters", "renewables/clusters", "st-storage/clusters")) { - + +# read and manage referential properties + # return referential according to type and study version +get_input_cluster_properties <- function(table_type, opts){ + # READ cluster properties + full_ref_properties <- pkgEnv[["inputProperties"]] - columns <- switch( - dir, - "thermal/clusters" = c("group","enabled","must_run","unit_count","nominal_capacity", - "min_stable_power","spinning","min_up_time","min_down_time", - "co2","marginal_cost","fixed_cost","startup_cost","market_bid_cost", - "spread_cost","ts_gen","volatility_forced","volatility_planned", - "law_forced","law_planned"), - - "renewables/clusters" = c("group","ts_interpretation","enabled","unit_count","nominal_capacity") - #"st-storage/clusters" = #ATTENTE DEV COTé API + category_ref_cluster <- switch( + table_type, + "thermals" = "thermal", + "renewables" = "renewable", + "st-storages" = "storage" ) - return(columns) + + # filter by category + ref_filter_by_cat <- full_ref_properties[`Category` %in% + category_ref_cluster] + # filter by study version + ref_filter_by_vers <- ref_filter_by_cat[`Version Antares` <= + opts$antaresVersion | + `Version Antares` %in% NA] + + # detect evolution on parameter ? (new value according to study version) + # filter on value according to study version + df_multi_params <- ref_filter_by_vers[, + count := .N, + by = c("INI Name"), + keyby = TRUE][ + count>1][, + .SD[which.max(`Version Antares`)], + by="INI Name"] + + df_unique_params <- ref_filter_by_vers[, + count := .N, + by = c("INI Name"), + keyby = TRUE][ + count==1] + + ref_filter_by_vers <- rbind(df_unique_params, df_multi_params) + + # select key colums and put wide format + ref_filter_by_vers <- ref_filter_by_vers[ , + .SD, + .SDcols = c("INI Name", + "Default", + "Type")] + + # select names columns to convert to logical + numerical + logical_col_names <- ref_filter_by_vers[Type%in%"bool"][["INI Name"]] + numerical_col_names <- ref_filter_by_vers[Type%in%c("int", "float")][["INI Name"]] + + wide_ref <- data.table::dcast(data = ref_filter_by_vers, + formula = .~`INI Name`, + value.var = "Default")[ + , + .SD, + .SDcols = -c(".", "name")] + # /!\ column type conversion on + wide_ref[, + (logical_col_names):= lapply(.SD, as.logical), + .SDcols = logical_col_names][ + , + (numerical_col_names):= lapply(.SD, as.numeric), + .SDcols = numerical_col_names + ] + + return(wide_ref) } diff --git a/R/utils.R b/R/utils.R index 4ac4d8b5..c26aa91e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,4 @@ +# badge doc ---- badge_api_ok <- function() { "\\ifelse{html}{\\figure{badge_api_ok.svg}{options: alt='Antares API OK'}}{Antares API: \\strong{OK}}" } diff --git a/R/zzz.R b/R/zzz.R index 3ebc75fd..8efef0a5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,11 +11,14 @@ #' @importFrom utils untar #' @importFrom stringr str_match str_replace + +# private variables ---- # Private variables accessible only by functions from the package pkgEnv <- new.env() +## output variables ---- pkgEnv$formatName <- read.table(system.file("format_output/tableOutput.csv", package = "antaresRead"), sep = ";", header = TRUE) @@ -86,6 +89,7 @@ setAlias("nostat", "All variables except summary variable (MIN, MAX and STD)", "FLOW QUAD.", "CONG. FEE (ALG.)", "CONG. FEE (ABS.)", "MARG. COST", "CONG. PROB +", "CONG. PROB -", "HURDLE COST")) +## global vars package ---- # The goal of the following lines is only to remove many useless warnings in # R CMD CHECK: "no visible binding for global variable 'XXX'". # They come from the use of the data.table syntax. @@ -93,7 +97,7 @@ utils::globalVariables( c("timeId", "tsId", "area", "hydroStorage", "thermalAvailability", "cluster", "FLOW LIN.", "FLOW QUAD.", "direction", "flow", "BALANCE", "totalFlow", "prop", "to", "link", "change", - "district", "must.run", ".txt", "detailsLength", + "district", "must-run", ".txt", "detailsLength", "linkLength", "connectedToVirtualArea", "from", "correction", "nominalcapacity", "unitcount", "capacity", "minGenModulation", "production", "mustRunPartial", "mustRunTotal", "mcYear", @@ -101,58 +105,38 @@ utils::globalVariables( "pumpingCapacity", "pumpingCapacity.x", "pumpingCapacity.y", "rarea", "storageCapacity", "storageCapacity.x", "storageCapacity.y", "toDistrict", "transCapacityDirect", "transCapacityIndirect", "varea", "x", "y", - "NODU", "min.stable.power", "thermalPmin", "name", "value", + "NODU", "min-stable-power", 'Category', 'Version Antares', 'Type', + "thermalPmin", "name", "value", "Folder", "Mode", "Stats", "Name", "progNam", "mrgprice", "isLOLD_cum", "...To", "upstream", "downstream", "LOLD", "LOLD_data", "LOLP", "warn_for_status", "MRG. PRICE", "H. LEV", "V2", "V1", "size", "ORDINAL_POSITION_BY_TOPIC", "DETAILS_FILES_TYPE","ANTARES_DISPLAYED_NAME") ) -#----------------------------- HDF5 ------------------------------------# +## INPUT Properties REF ---- +res_prop_ref <- data.table::fread(system.file("referential_properties/properties_input_renewable.csv", + package = "antaresRead"), + sep = ";", + header = TRUE) +res_prop_therm <- data.table::fread(system.file("referential_properties/properties_input_thermal.csv", + package = "antaresRead"), + sep = ";", + header = TRUE) -is.installed <- function(mypkg) is.element(mypkg, utils::installed.packages()[,1]) +res_prop_st <- data.table::fread(system.file("referential_properties/properties_input_storage.csv", + package = "antaresRead"), + sep = ";", + header = TRUE) -rhdf5_version <- "2.24.0" -rhdf5_message <- "This function require 'rhdf5' (>= 2.24.0) package. - This is a bioconductor package. You can install it with : - source('https://bioconductor.org/biocLite.R') - biocLite('rhdf5')" - -# !! parameter versionCheck of requireNamespace does not work correctly, use utils::package_version instead -.requireRhdf5_Antares <- function(stopP = TRUE){ - if(.check_rhdf5(stopP = stopP)){ - if(.check_rhdf5_version(stopP = stopP)){ - return(TRUE) - } - } - return(FALSE) -} - -.stop_rhdf5_version <- function(stopP = TRUE) { - if(stopP){ - stop(rhdf5_message) - }else{ - return(FALSE) - } -} +df_files_ref <- do.call("rbind", + list(res_prop_ref, res_prop_therm, res_prop_st)) +pkgEnv$inputProperties <- df_files_ref -.check_rhdf5 <- function(stopP = TRUE){ - if(requireNamespace("rhdf5", quietly = TRUE)){ - return(TRUE) - }else{ - .stop_rhdf5_version(stopP) - } -} -.check_rhdf5_version <- function(stopP = TRUE){ - if(utils::packageVersion("rhdf5") >= rhdf5_version){ - return(TRUE) - }else{ - .stop_rhdf5_version(stopP) - } -} +#----------------------------- HDF5 ------------------------------------# +# HDF5 ---- # .addClassAndAttributes <- antaresRead:::.addClassAndAttributes pkgEnvAntareasH5 <- new.env() @@ -258,7 +242,50 @@ integerVariable <- as.character(unique(pkgEnv$formatName$Name[which(pkgEnv$forma integerVariable <- unlist(apply(expand.grid(integerVariable, c("", "_std", "_min", "_max")), 1, function(X){paste0(X, collapse = "")})) +# rhfd5 functions ---- +is.installed <- function(mypkg) is.element(mypkg, utils::installed.packages()[,1]) +rhdf5_version <- "2.24.0" +rhdf5_message <- "This function require 'rhdf5' (>= 2.24.0) package. + This is a bioconductor package. You can install it with : + source('https://bioconductor.org/biocLite.R') + biocLite('rhdf5')" + +# !! parameter versionCheck of requireNamespace does not work correctly, use utils::package_version instead +.requireRhdf5_Antares <- function(stopP = TRUE){ + if(.check_rhdf5(stopP = stopP)){ + if(.check_rhdf5_version(stopP = stopP)){ + return(TRUE) + } + } + return(FALSE) +} + +.stop_rhdf5_version <- function(stopP = TRUE) { + if(stopP){ + stop(rhdf5_message) + }else{ + return(FALSE) + } +} + +.check_rhdf5 <- function(stopP = TRUE){ + if(requireNamespace("rhdf5", quietly = TRUE)){ + return(TRUE) + }else{ + .stop_rhdf5_version(stopP) + } +} + +.check_rhdf5_version <- function(stopP = TRUE){ + if(utils::packageVersion("rhdf5") >= rhdf5_version){ + return(TRUE) + }else{ + .stop_rhdf5_version(stopP) + } +} + +# some tools functions ---- .tidymess <- function(..., prefix = " ", initial = ""){ as.character(strwrap(..., prefix = prefix, initial = initial)) } @@ -287,3 +314,4 @@ integerVariable <- unlist(apply(expand.grid(integerVariable, c("", "_std", "_min bydistrict <- c("district", .get_by(x)) return(bydistrict) } + diff --git a/inst/referential_properties/properties_input_renewable.csv b/inst/referential_properties/properties_input_renewable.csv new file mode 100644 index 00000000..2b20fe44 --- /dev/null +++ b/inst/referential_properties/properties_input_renewable.csv @@ -0,0 +1,7 @@ +Topic;INI Name;Tech Name;Type;Default;Version;Category;Version Antares +General;name;name;str;;8.1;renewable;810 +General;group;group;str;;8.1;renewable;810 +General;ts-interpretation;ts-interpretation;str;power-generation;8.1;renewable;810 +Operating parameters;enabled;enabled;bool;True;8.1;renewable;810 +Operating parameters;unitcount;unitCount;int;1;8.1;renewable;810 +Operating parameters;nominalcapacity;nominalCapacity;float;0.0;8.1;renewable;810 diff --git a/inst/referential_properties/properties_input_storage.csv b/inst/referential_properties/properties_input_storage.csv new file mode 100644 index 00000000..e4b464cf --- /dev/null +++ b/inst/referential_properties/properties_input_storage.csv @@ -0,0 +1,11 @@ +Topic;INI Name;Tech Name;Type;Default;Version;Category;Version Antares +General;name;name;str;;8.6;storage;860 +General;group;group;str;;8.6;storage;860 +General;injectionnominalcapacity;injection_nominal_capacity;float;0.0;8.6;storage;860 +General;withdrawalnominalcapacity;withdrawal_nominal_capacity;float;0.0;8.6;storage;860 +General;reservoircapacity;reservoir_capacity;float;0.0;8.6;storage;860 +General;efficiency;efficiency;float;0.0;8.6;storage;860 +General;initiallevel;initial_level;float;0;8.6;storage;860 +General;initialleveloptim;initial_level_optim;bool;False;8.6;storage;860 +General;enabled;enabled;bool;True;8.8;storage;880 +General;initiallevel;initial_level;float;0.5;8.8;storage;880 diff --git a/inst/referential_properties/properties_input_storage_test.csv b/inst/referential_properties/properties_input_storage_test.csv new file mode 100644 index 00000000..ed9c8918 --- /dev/null +++ b/inst/referential_properties/properties_input_storage_test.csv @@ -0,0 +1,13 @@ +Topic;INI Name;Tech Name;Type;Default;Version;Category;Version Antares +General;efficiency;efficiency;float;0.0;8.6;storage;860 +General;enabled;enabled;bool;True;8.8;storage;880 +General;group;group;str;;8.6;storage;860 +General;initiallevel;initial_level;float;0;8.6;storage;860 +General;initiallevel;initial_level;float;0.5;8.8;storage;880 +General;initialleveloptim;initial_level_optim;bool;False;8.6;storage;860 +General;injectionnominalcapacity;injection_nominal_capacity;float;0.2;8.4;storage;840 +General;injectionnominalcapacity;injection_nominal_capacity;float;0.1;8.5;storage;850 +General;injectionnominalcapacity;injection_nominal_capacity;float;0.0;8.6;storage;860 +General;name;name;str;;8.6;storage;860 +General;reservoircapacity;reservoir_capacity;float;0.0;8.6;storage;860 +General;withdrawalnominalcapacity;withdrawal_nominal_capacity;float;0.0;8.6;storage;860 diff --git a/inst/referential_properties/properties_input_thermal.csv b/inst/referential_properties/properties_input_thermal.csv new file mode 100644 index 00000000..22768cd3 --- /dev/null +++ b/inst/referential_properties/properties_input_thermal.csv @@ -0,0 +1,37 @@ +Topic;INI Name;Tech Name;Type;Default;Version;Category;Version Antares +Pollutant emission rates;nh3;nh3;float;0.0;8.6;thermal;860 +Pollutant emission rates;so2;so2;float;0.0;8.6;thermal;860 +Pollutant emission rates;nox;nox;float;0.0;8.6;thermal;860 +Pollutant emission rates;pm2_5;pm25;float;0.0;8.6;thermal;860 +Pollutant emission rates;pm5;pm5;float;0.0;8.6;thermal;860 +Pollutant emission rates;pm10;pm10;float;0.0;8.6;thermal;860 +Pollutant emission rates;nmvoc;nmvoc;float;0.0;8.6;thermal;860 +Pollutant emission rates;op1;op1;float;0.0;8.6;thermal;860 +Pollutant emission rates;op2;op2;float;0.0;8.6;thermal;860 +Pollutant emission rates;op3;op3;float;0.0;8.6;thermal;860 +Pollutant emission rates;op4;op4;float;0.0;8.6;thermal;860 +Pollutant emission rates;op5;op5;float;0.0;8.6;thermal;860 +Operating costs;costgeneration;costGeneration;str;SetManually;8.7;thermal;870 +Operating costs;efficiency;efficiency;float;100.0;8.7;thermal;870 +Operating costs;variableomcost;variableOMCost;float;0.0;8.7;thermal;870 +General;name;name;str;;;thermal; +General;group;group;str;Other 1;;thermal; +Operating parameters;unitcount;unitCount;int;1;;thermal; +Operating parameters;enabled;enabled;bool;True;;thermal; +Operating parameters;nominalcapacity;nominalCapacity;float;0.0;;thermal; +Operating parameters;min-stable-power;minStablePower;float;0.0;;thermal; +Operating parameters;min-up-time;minUpTime;int;1;;thermal; +Operating parameters;min-down-time;minDownTime;int;1;;thermal; +Operating parameters;must-run;mustRun;bool;False;;thermal; +Operating parameters;spinning;spinning;float;0.0;;thermal; +Operating costs;marginal-cost;marginalCost;float;0.0;;thermal; +Operating costs;spread-cost;spreadCost;float;0.0;;thermal; +Operating costs;fixed-cost;fixedCost;float;0.0;;thermal; +Operating costs;startup-cost;startupCost;float;0.0;;thermal; +Operating costs;market-bid-cost;marketBidCost;float;0.0;;thermal; +Pollutant emission rates;co2;co2;float;0.0;;thermal; +Timeseries generation;gen-ts;genTs;str;Use Global;;thermal; +Timeseries generation;volatility.forced;volatilityForced;float;0.0;;thermal; +Timeseries generation;volatility.planned;volatilityPlanned;float;0.0;;thermal; +Timeseries generation;law.forced;lawForced;str;Uniform;;thermal; +Timeseries generation;law.planned;lawPlanned;str;Uniform;;thermal; diff --git a/man/readAntares.Rd b/man/readAntares.Rd index 2431cc23..2e390585 100644 --- a/man/readAntares.Rd +++ b/man/readAntares.Rd @@ -85,7 +85,7 @@ is the sum of the two previous columns. Finally \code{thermalPmin} is similar to mustRunTotal except it also takes into account the production induced by the minimum stable power of the units of a cluster. More precisely, for a given cluster and a given time step, it is equal to -\code{min(NODU x min.stable.power, mustRunTotal)}.} +\code{min(NODU x min-stable-power, mustRunTotal)}.} \item{thermalModulation}{Should thermal modulation time series be imported ? If \code{TRUE}, the columns "marginalCostModulation", "marketBidModulation", "capacityModulation" diff --git a/man/readClusterDesc.Rd b/man/readClusterDesc.Rd index fe3bcd15..8ed4337e 100644 --- a/man/readClusterDesc.Rd +++ b/man/readClusterDesc.Rd @@ -39,6 +39,8 @@ study. You can use the argument \code{opts} to specify another study. \code{readClusterResDesc} : read renewable clusters (Antares >= V8.1) \code{readClusterSTDesc} : read st-storage clusters (Antares >= V8.6) + +If you have no clusters properties, \verb{Null data.table (0 rows and 0 cols)} is returned. } \description{ This function reads in the input files of an antares study the diff --git a/tests/testthat/test-readClusterDesc.R b/tests/testthat/test-readClusterDesc.R index 3b938df7..42dd1204 100644 --- a/tests/testthat/test-readClusterDesc.R +++ b/tests/testthat/test-readClusterDesc.R @@ -1,14 +1,10 @@ -# read study ---- - # latest version -path_study_test <- grep(pattern = "87", x = studyPathSV8, value = TRUE) -opts_study_test <- setSimulationPath(path_study_test, simulation = "input") - -# all version ---- -#minimal columns -mandatory_cols <- c("area","cluster") +# v710---- ## Thermal ---- test_that("test read cluster", { + path_study_test <- studyPathS + opts_study_test <- setSimulationPath(path_study_test, simulation = "input") + # function setSimulationPath() provide areas names with st-storage clusters areas <- opts_study_test$areasWithClusters @@ -17,13 +13,30 @@ test_that("test read cluster", { # tests testthat::expect_true("data.table" %in% class(input)) - testthat::expect_true(all(areas %in% unique(readClusterDesc()$area))) - testthat::expect_true(all(mandatory_cols %in% colnames(input))) - testthat::expect_true(nrow(input) == length(input$cluster)) + testthat::expect_true(all(areas %in% unique(input$area))) + + # tests if all colnames are returned according to ref + ref_thermal <- antaresRead:::pkgEnv$inputProperties[ + Category%in%"thermal"] + ref_thermal <- ref_thermal[`Version Antares` <= + opts_study_test$antaresVersion | + `Version Antares` %in% NA] + + # "name" in INI file corresponding "cluster" in output + testthat::expect_true(all( + setdiff(ref_thermal$`INI Name`, "name")%in% + setdiff(colnames(input), c("area", "cluster")))) + + # object returned is one line per area/cluster + testthat::expect_equal(nrow(input), nrow(unique(input))) }) ## Renewables ---- test_that("test read cluster renewables", { + path_study_test <- grep(pattern = "test_case_study_v870", + x = studyPathSV8, value = TRUE) + opts_study_test <- setSimulationPath(path_study_test, simulation = "input") + # function setSimulationPath() provide areas names with st-storage clusters areas_res <- opts_study_test$areasWithResClusters @@ -33,13 +46,30 @@ test_that("test read cluster renewables", { # tests testthat::expect_true("data.table" %in% class(input)) testthat::expect_true(all(areas_res %in% unique(input$area))) - testthat::expect_true(all(mandatory_cols %in% colnames(input))) - testthat::expect_true(nrow(input) == length(input$cluster)) + + # tests if all colnames are returned according to ref + ref_res <- antaresRead:::pkgEnv$inputProperties[ + Category%in%"renewable"] + ref_res <- ref_res[`Version Antares` <= + opts_study_test$antaresVersion | + `Version Antares` %in% NA] + + # "name" in INI file corresponding "cluster" in output + testthat::expect_true(all( + setdiff(ref_res$`INI Name`, "name")%in% + setdiff(colnames(input), c("area", "cluster")))) + + # object returned is one line per area/cluster + testthat::expect_equal(nrow(input), nrow(unique(input))) }) # v860 ---- ## st-storage ---- test_that("test read cluster st-storage v860", { + path_study_test <- grep(pattern = "test_case_study_v870", + x = studyPathSV8, value = TRUE) + opts_study_test <- setSimulationPath(path_study_test, simulation = "input") + # function setSimulationPath() provide areas names with st-storage clusters areas_st <- opts_study_test$areasWithSTClusters @@ -50,7 +80,28 @@ test_that("test read cluster st-storage v860", { testthat::expect_true("data.table" %in% class(input_st)) testthat::expect_true(all( areas_st %in% unique(readClusterSTDesc()$area))) - testthat::expect_true(all(areas_st %in% unique(readClusterSTDesc()$area))) - testthat::expect_true(all(mandatory_cols %in% colnames(input_st))) - testthat::expect_true(nrow(input_st) == length(input_st$cluster)) + + # tests if all colnames are returned according to ref + ref_st <- antaresRead:::pkgEnv$inputProperties[ + Category%in%"storage"] + ref_st <- ref_st[`Version Antares` <= + opts_study_test$antaresVersion | + `Version Antares` %in% NA] + + # "name" in INI file corresponding "cluster" in output + testthat::expect_true(all( + setdiff(ref_st$`INI Name`, "name")%in% + setdiff(colnames(input_st), c("area", "cluster")))) + + # object returned is one line per area/cluster + testthat::expect_equal(nrow(input_st), nrow(unique(input_st))) +}) + +# read empty study ---- +test_that("test when study has no cluster (empty)", { + path_empty_study <- setup_study_empty(sourcedir_empty_study) + opts_study_test <- setSimulationPath(path_empty_study, simulation = "input") + + testthat::expect_equal(readClusterDesc(), + data.table::data.table()) })