From 9f16ee2d79489eec297269bfff7937a804ed248a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Berthet?= Date: Mon, 2 Sep 2024 17:18:42 +0200 Subject: [PATCH] Tomaster (#260) * resolve conflicts from develop * update to dev version * fix grep study path in tests --- DESCRIPTION | 2 +- NAMESPACE | 2 + NEWS.md | 19 +- R/importOutput.R | 26 +- R/readAntares.R | 4 +- R/readAntaresClusters.R | 54 +- R/readBindingConstraints.R | 2 +- R/readClusterDesc.R | 203 +++++-- R/setSimulationPathAPI.R | 513 ++++++++++++++++++ R/utils.R | 1 + R/utils_api.R | 448 +-------------- R/zzz.R | 32 +- README.md | 2 - _pkgdown.yml | 3 +- .../properties_input_renewable.csv | 7 + .../properties_input_storage.csv | 11 + .../properties_input_storage_test.csv | 13 + .../properties_input_thermal.csv | 37 ++ man/readAntares.Rd | 2 +- man/readAntaresSTClusters.Rd | 37 ++ man/readClusterDesc.Rd | 2 + man/setSimulationPath.Rd | 2 +- tests/testthat/helper_init.R | 1 + tests/testthat/test-importOutputForClusters.R | 124 ++--- tests/testthat/test-readAntares_STclusters.R | 58 +- tests/testthat/test-readBindingConstraints.R | 1 + tests/testthat/test-readClusterDesc.R | 83 ++- tests/testthat/test-readInputClusters.R | 32 ++ tests/testthat/test-setSimulationPath.R | 1 - 29 files changed, 1104 insertions(+), 618 deletions(-) create mode 100644 R/setSimulationPathAPI.R create mode 100644 inst/referential_properties/properties_input_renewable.csv create mode 100644 inst/referential_properties/properties_input_storage.csv create mode 100644 inst/referential_properties/properties_input_storage_test.csv create mode 100644 inst/referential_properties/properties_input_thermal.csv create mode 100644 man/readAntaresSTClusters.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 08d8dd60..f919f6c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: antaresRead Type: Package Title: Import, Manipulate and Explore the Results of an 'Antares' Simulation -Version: 2.7.1 +Version: 2.7.2.9000 Authors@R: c( person("Tatiana", "Vargas", email = "tatiana.vargas@rte-france.com", role = c("aut", "cre")), person("Jalal-Edine", "ZAWAM", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 2dd11f06..8bedfaff 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ export(ponderateMcAggregation) export(readAntares) export(readAntaresAreas) export(readAntaresClusters) +export(readAntaresSTClusters) export(readBindingConstraints) export(readClusterDesc) export(readClusterResDesc) @@ -98,6 +99,7 @@ importFrom(plyr,llply) importFrom(purrr,quietly) importFrom(shiny,getDefaultReactiveDomain) importFrom(shiny,incProgress) +importFrom(shiny,isRunning) importFrom(shiny,withProgress) importFrom(stats,as.formula) importFrom(stats,setNames) diff --git a/NEWS.md b/NEWS.md index f5bdf368..5da8aa81 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,23 @@ > Copyright © 2016 RTE Réseau de transport d’électricité +# antaresRead 2.7.2.9000 + +NEW FEATURES: + +* New function `readAntaresSTClusters()` +* `fread_antares()` shiny compatible with a conditional processing of the error messages + +BREAKING CHANGES : + +* `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 : + +* `setSimulationPathAPI()`: control the existence of the output folder **links** or **areas** before reading the data (upgrade Antares Web) +* `readClusterDesc()` / `readClusterResDesc()` / `readClusterSTDesc()` return a data.table in API mode + + # antaresRead 2.7.1 NEW FEATURES: @@ -22,7 +40,6 @@ BUGFIXES : * `setSimulationPath()` has also the parameter **areasWithSTClusters** in 'output' mode - # antaresRead 2.7.0 ### Breaking changes (Antares v8.7.0) : 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 dfc1ac62..58ab6448 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 @@ -912,7 +912,7 @@ readAntaresAreas <- function(areas, links = TRUE, clusters = TRUE, clustersRes = if ("mcYears" %in% unlist(select) & is.null(mcYears)) mcYears <- "all" # If all arguments are NULL, import all areas - if (is.null(areas) & is.null(links) & is.null(clusters) & is.null(districts)) { + if (is.null(areas) & is.null(links) & is.null(clusters) & is.null(districts) & is.null(clustersST)) { areas <- "all" } diff --git a/R/readAntaresClusters.R b/R/readAntaresClusters.R index 9717d70a..bb0ebc3f 100644 --- a/R/readAntaresClusters.R +++ b/R/readAntaresClusters.R @@ -36,4 +36,56 @@ readAntaresClusters <- function(clusters, selected = c("production", "NP Cost", subset(res, cluster %in% clusters, select = c(setdiff(colnames(res),c("production", "NP Cost", "NODU", "profit")), intersect(colnames(res),selected))) #support for up to v8.4 -} \ No newline at end of file +} + + +#' Read output for a list of short-term storage clusters +#' +#' @param clustersST vector of short-term storage clusters to be imported +#' @param selected vector of thematic trimming +#' @inheritParams readAntares +#' +#' @return data.table of results for short-term storage clusters +#' +#' @export +readAntaresSTClusters <- function(clustersST, selected = c("P.injection", "levels", "P.withdrawal"), + timeStep = c("hourly", "daily", "weekly", "monthly", "annual"), + opts = simOptions(), parallel = FALSE, showProgress = TRUE) { + + if (missing(clustersST)) { + stop("The function 'readAntaresSTClusters' expects a vector of short-term storage clusters names as argument.") + } + if ("Input" %in% opts$mode) { + stop("Cannot use 'readAntaresSTClusters' in 'Input' mode.") + } + if (opts$antaresVersion < 860) { + stop("Cannot use 'readAntaresSTClusters' for a study version < 860.") + } + + ##Add check control for all + allSTClusters <- readClusterSTDesc(opts = opts)[, c("area","cluster")] + allSTClusters$lower_cluster <- tolower(allSTClusters$cluster) + ind_cluster <- which(allSTClusters$lower_cluster %in% .checkArg(tolower(clustersST), + tolower(unique(allSTClusters$cluster)), + "short-term storage clusters %s do not exist in the simulation.")) + clustersST <- allSTClusters$cluster[ind_cluster] + + ind_cluster <- which(allSTClusters$lower_cluster %in% .checkArg(tolower(clustersST), + tolower(unique(allSTClusters[area %in% opts$areasWithSTClusters]$cluster)), + "short-term storage clusters %s have no output.")) + clustersST <- unique(allSTClusters$cluster[ind_cluster]) + + output_st_clusters <- data.table() + if (length(clustersST) > 0) { + areas <- unique(allSTClusters[cluster %in% clustersST]$area) + + res <- readAntares(clustersST = areas, timeStep = timeStep, opts = opts, + parallel = parallel, showProgress = showProgress) + + output_st_clusters <- subset(res, cluster %in% clustersST, select = c(setdiff(colnames(res),c("P.injection", "levels", "P.withdrawal")), + intersect(colnames(res),selected)) + ) + } + + return(output_st_clusters) +} diff --git a/R/readBindingConstraints.R b/R/readBindingConstraints.R index ebe65506..6c1f84ba 100644 --- a/R/readBindingConstraints.R +++ b/R/readBindingConstraints.R @@ -64,7 +64,7 @@ #' #' @export readBindingConstraints <- function(opts = simOptions()) { - + ## # API BLOC ## diff --git a/R/readClusterDesc.R b/R/readClusterDesc.R index 5f9ea0c1..b233b714 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 #' @@ -93,77 +95,158 @@ readClusterSTDesc <- function(opts = simOptions()) { dir = "thermal/clusters") { 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){ + if (api_study) { + # api request with all columns + list_clusters <- api_get( + opts = opts, + endpoint = paste0(opts$study_id, "/table-mode/", table_type), + query = list(columns = "") + ) - 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))] - }) - - } + dt_clusters <- .convert_list_clusterDesc_to_datatable(list_clusters) - 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)) + return(dt_clusters) } + + # "text" mode + areas <- list.files(path) + + # 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"]] + category_ref_cluster <- switch( + table_type, + "thermals" = "thermal", + "renewables" = "renewable", + "st-storages" = "storage" + ) - 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"), + # 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) +} + + +.convert_list_clusterDesc_to_datatable <- function(list_clusters) { + + if (length(list_clusters) == 0) { + return(data.table()) + } - "renewables/clusters" = c("group","ts_interpretation","enabled","unit_count","nominal_capacity") - #"st-storage/clusters" = #ATTENTE DEV COTé API + rows_cluster <- lapply(names(list_clusters), FUN = function(cl_name) { + + row_cluster <- as.data.frame(list_clusters[[cl_name]]) + row_cluster[,c("area", "cluster")] <- unlist(strsplit(cl_name, split = " / ")) + + return(row_cluster) + } ) - return(columns) + + df_clusters <- do.call("rbind", rows_cluster) + id_cols <- intersect(c("area", "cluster", "group"), colnames(df_clusters)) + additional_cols <- setdiff(colnames(df_clusters), id_cols) + df_clusters <- df_clusters[,c(id_cols, additional_cols)] + df_clusters$cluster <- as.factor(tolower(df_clusters$cluster)) + colnames(df_clusters) <- tolower(colnames(df_clusters)) + + return(as.data.table(df_clusters)) } diff --git a/R/setSimulationPathAPI.R b/R/setSimulationPathAPI.R new file mode 100644 index 00000000..274aa316 --- /dev/null +++ b/R/setSimulationPathAPI.R @@ -0,0 +1,513 @@ +.getPathsAPI <- function(host, study_id, simulation, ...){ + simNames <- NULL + path <- paste0(host, "/v1/studies/", study_id) + path <- gsub("[/\\]$", "", path) + path <- paste0(path, "/raw?path=") + inputPath <- file.path(path, "input") + outputPath <- file.path(path, "output") + if(is.null(simulation) | (!is.null(simulation) && !simulation %in% c(0, "input"))){ + outputContent <- names(read_secure_json(paste0(outputPath, "&depth=4"), ...)) + simNames <- setdiff(basename(outputContent), c("maps", "logs")) + } + if (length(simNames) == 0) { + if (length(simulation) > 0 && !simulation %in% c(0, "input")) { + stop("Cannot find any simulation result") + } else { + simulation <- 0 + } + } + + if (is.null(simulation)) { + if (length(simNames) == 1) { # Case 2 + simulation <- 1 + } else { # Case 3 + cat("Please, choose a simulation\n") + for (i in 1:length(simNames)) { + cat(sprintf(" %s - %s\n", i, simNames[i])) + } + simulation <- type.convert(scan(what = character(), nmax = 1), as.is = TRUE) + } + } + + if (simulation %in% c(0, "input")) { + studyPath <- path + simPath <- NULL + } else { + out <- .giv_sim(simulation, simNames, path) + + std_sel <- which(unlist(lapply(simNames, function(X){ + grepl(paste0(X, "$"), out$simPath) + }))) + + # out$simPath <- gsub(simNames[std_sel], std_sel, out$simPath) + out$simOutputName <- simNames[std_sel] + return(out) + } + + list(studyPath = studyPath, + simPath = simPath, + inputPath = inputPath) + +} + + +.getSimOptionsAPI <- function(paths, host, ...){ + + ## Read info from json + simPath <- paths$simPath + + # Get basic information about the simulation + params <- read_secure_json(file.path(simPath, "about-the-study", "parameters"), ...) + + info <- read_secure_json(file.path(simPath, "info", "general"), ...) + + # Where are located the results ? + simDataPath <- file.path(simPath, tolower(as.character(info$mode))) + + mc_ind_path <- file.path(simDataPath, "mc-ind&depth=1") + + synthesis <- .getSuccess(file.path(simDataPath, "mc-all&depth=1"), ...) + yearByYear <- .getSuccess(mc_ind_path, ...) + scenarios <- .getSuccess(file.path(simPath, "ts-numbers&depth=1"), ...) + + if (yearByYear) { + year_no_filter <- names(read_secure_json(mc_ind_path, ...)) + mcYears <- as.numeric(year_no_filter[grep("^\\d{5}$", year_no_filter)]) + } else { + mcYears <- numeric() + } + + if (!synthesis & !yearByYear) { + stop("No results/data found in API", call. = FALSE) + } + + # List of available areas and links + if (synthesis) { + dataPath <- file.path(simDataPath, "mc-all") + } else { + dataPath <- file.path(simDataPath, "mc-ind", sprintf("%05d", mcYears[1])) + } + + areaList <- gsub("\r$", "", tolower( + strsplit(read_secure_json(file.path(simPath, "about-the-study", "areas"), ...), "\n")[[1]] + ) + ) + districtList <- grep("^@", areaList, value = TRUE) + areaList <- areaList[!areaList %in% districtList] + + # linkList + links_path <- file.path(dataPath, "links&depth=2") + links_success <- .getSuccess(links_path, ...) + + linkList <- character(0) + if (links_success) { + linkList <- .scan_output_links_folder(links_path, ...) + } + + # areasWithClusters areasWithResClusters areasWithSTClusters + areas_path <- file.path(dataPath, "areas&depth=2") + areas_success <- .getSuccess(areas_path, ...) + + areasWithClusters <- character(0) + areasWithResClusters <- character(0) + areasWithSTClusters <- character(0) + if (areas_success) { + areasWithClusters <- .detect_areas_with_clusters(path = areas_path, + type = "thermal", + ...) + areasWithResClusters <- .detect_areas_with_clusters(path = areas_path, + type = "renewables", + ...) + areasWithSTClusters <- .detect_areas_with_clusters(path = areas_path, + type = "st-storage", + ...) + } + + # variables + variables <- list() + areas_variables <- character(0) + links_variables <- character(0) + if (areas_success) { + areas_variables <- .get_available_output_variables(path = dataPath, + type = "areas", + linkList = linkList, + areaList = areaList, + ...) + } + if (links_success) { + links_variables <- .get_available_output_variables(path = dataPath, + type = "links", + linkList = linkList, + areaList = areaList, + ...) + } + + if (length(areas_variables) > 0) { + variables[["areas"]] <- areas_variables + } + if (length(links_variables) > 0) { + variables[["links"]] <- links_variables + } + + # linksDef + linksDef <- .readLinksDef(strsplit(read_secure_json(file.path(simPath, "about-the-study", "links"), ...), "\n")[[1]]) + + return( + list( + simDataPath = simDataPath, + name = as.character(info$name), + mode = as.character(info$mode), + simDate = info$date, + synthesis = synthesis, + yearByYear = yearByYear, + scenarios = scenarios, + mcYears = mcYears, + antaresVersion = info$version, + areaList = areaList, + districtList = gsub("^@ ?", "", districtList), + linkList = linkList[linkList %in% linksDef$link], + linksDef = linksDef, + areasWithClusters = intersect(areasWithClusters, areaList), + areasWithResClusters = intersect(areasWithResClusters, areaList), + areasWithSTClusters = intersect(areasWithSTClusters, areaList), + variables = variables, + parameters = params + ) + ) +} + + +.getInputOptionsAPI <- function(paths, ...) { + + studyPath <- paths$studyPath + inputPath <- paths$inputPath + outputPath <- paths$simPath + + # Lists of areas, links and districts existing in the study + areaList <- unique( + tolower(unlist(read_secure_json(file.path(inputPath, "areas", "list"), ...))) + ) + + districtList <- unique( + tolower(names(read_secure_json(file.path(inputPath, "areas", "sets"), ...))) + ) + + areasWithLinks <- unique(names(read_secure_json(file.path(inputPath, "links&depth=1"), ...))) + areasWithLinks <- intersect(areasWithLinks, areaList) + + allLinks <- read_secure_json(file.path(inputPath, "links&depth=3"), ...) + linksDef <- data.table::rbindlist(mapply(function(X, Y){ + to = names(X$properties) + if (length(to) == 0) return(NULL) + + data.frame(link = paste(Y, "-", to), from = Y, to = to, stringsAsFactors = TRUE) + + }, allLinks, names(allLinks))) + + # info <- read_secure_json(studyPath, ...) + + antaresVersion <- paths$version + params <- read_secure_json(file.path(studyPath, "settings", "generaldata"), ...) + + # Areas with clusters + + clusterList <- read_secure_json(file.path(inputPath, "thermal", "clusters", "&depth=4"), ...) + areaHasClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { + TF <- FALSE + try({ + f <- clusterList[[a]]$list + if(!is.null(f))return(TRUE) + }) + return(TF) + }) + + # Areas with renewable clusters + areaHasResClusters <- logical(0) + if (!is.null(params$`other preferences`$`renewable-generation-modelling`)){ + if(params$`other preferences`$`renewable-generation-modelling` == "clusters"){ + clusterResList <- read_secure_json(file.path(inputPath, "renewables", "clusters", "&depth=4"), ...) + areaHasResClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { + TF <- FALSE + try({ + f <- clusterResList[[a]]$list + if(!is.null(f))return(TRUE) + }) + return(TF) + }) + } + } + + # Areas with st-storage (>=860) + if(paths$version>=860){ + clusterSTList <- read_secure_json(file.path(inputPath, "st-storage", "clusters", "&depth=4"), ...) + areaHasSTClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { + TF <- FALSE + try({ + f <- clusterSTList[[a]]$list + if(!is.null(f))return(TRUE) + }) + return(TF) + }) + + # return + list( + mode = "Input", + antaresVersion = antaresVersion, + areaList = areaList, + districtList = districtList, + linkList = as.character(linksDef$link), + linksDef = linksDef, + areasWithClusters = areaList[areaHasClusters], + areasWithResClusters = areaList[areaHasResClusters], + areasWithSTClusters = areaList[areaHasSTClusters], + parameters = params + ) + }else + list( + mode = "Input", + antaresVersion = antaresVersion, + areaList = areaList, + districtList = districtList, + linkList = as.character(linksDef$link), + linksDef = linksDef, + areasWithClusters = areaList[areaHasClusters], + areasWithResClusters = areaList[areaHasResClusters], + parameters = params + ) +} + +# valid_url <- function(url_in, t = 2){ +# con <- url(url_in) +# check <- suppressWarnings(try(open.connection(con, open = "rt",timeout = t), silent = T)[1]) +# suppressWarnings(try(close.connection(con), silent = T)) +# ifelse(is.null(check),TRUE ,FALSE ) +# } + +#' @import jsonlite +#' @export +#' @return +#' \item{sleep}{timer for api commande execute} +#' @rdname setSimulationPath +setSimulationPathAPI <- function(host, study_id, token, simulation = NULL, + timeout = 60, httr_config = list()) { + + if (missing(host)) { + stop("Please specify an url to antares API host") + } + + if (missing(study_id)) { + stop("Please specify the study_id") + } + + if (missing(token)) { + stop("Please specify your access token") + } + + valid_host <- tryCatch({ + .getSuccess(file.path(host, "health"), token = "", timeout = timeout, config = httr_config) + }, error = function(e) FALSE) + + if(!valid_host){ + stop("setSimulationPathAPI : invalid host '", host, "'") + } + + stopifnot(timeout > 0) + + check_study <- tryCatch({ + read_secure_json(file.path(host, "v1/studies", study_id), token = token, + timeout = timeout, config = httr_config + ) + }, error = function(e){ + # catch message from api_get() (from API) + stop(e) + }) + + # generic tests (legacy) + if(isTRUE(all.equal(names(check_study), "detail"))){ + stop("Can't connect to API. Please verify token") + } + + # generic tests (legacy) + if(!study_id %in% check_study$id){ + stop("Can't find your 'study_id' on the API") + } + + res <- .getPathsAPI(host, + study_id, + simulation, + token = token, + timeout = timeout, + config = httr_config) + + res$studyName <- check_study$name + + res$version <- check_study$version + + # If "input mode", read options from the input folder, else read them from + # the simulation folder. + if (is.null(res$simPath) | length(res$simPath) == 0) { + res <- append(res, + .getInputOptionsAPI(res, + token = token, + timeout = timeout, + config = httr_config)) + } else { + res$simPath <- URLencode(res$simPath) + res <- append(res, + .getSimOptionsAPI(res, + host, + token = token, + timeout = timeout, + config = httr_config)) + } + + # dates, TimeId min and max + tmin <- res$parameters$general$simulation.start + tmax <- res$parameters$general$simulation.end + + res$timeIdMin <- 1 + (tmin - 1) * 24 + res$timeIdMax <- ((tmax - tmin + 1) %/% 7 * 7 + tmin - 1) * 24 + + res$start <- .getStartDate(res$parameters) + res$firstWeekday <- as.character(res$parameters$general$first.weekday) + + # Other informations that has to be read in input folder + res$districtsDef <- .readDistrictsDefAPI(res$inputPath, res$areaList, token, timeout) + + + res$energyCosts <- .readEnergyCostsAPI(res$inputPath, token, timeout) + + res$typeLoad <- "api" + res$host <- host + res$study_id <- study_id + res$token <- token + res$timeout <- timeout + res$httr_config <- httr_config + res$modeAPI <- "sync" + + # delete version to keep only "antares_version" + res$version <- NULL + + # timer for api commande execute + res$sleep <- 0.5 + + class(res) <- c("simOptions") + + options(antares = res) + + res +} + + +# Private function that reads the definition of the districts +.readDistrictsDefAPI <- function(inputPath, areas, token = NULL, timeout = 60) { + districts <- read_secure_json(file.path(inputPath, "areas/sets"), token = token, timeout = timeout) + if (length(districts) == 0) return(NULL) + + res <- ldply(names(districts), function(n) { + x <- districts[[n]] + if (any(unlist(x) == "add-all")) { + areasToRemove <- unlist(x[names(x) == "-"], use.names = FALSE) + areas <- setdiff(areas, areasToRemove) + } else { + areas <- unlist(x[names(x) == "+"], use.names = FALSE) + } + if (length(areas) == 0) return(NULL) + + data.frame(district = tolower(n), area = tolower(areas), stringsAsFactors = TRUE) + }) + + data.table(res) +} + + + +# Private function that reads costs of unsuplied and spilled energy +.readEnergyCostsAPI <- function(inputPath, token = NULL, timeout = 60) { + + costs <- read_secure_json(file.path(inputPath, "thermal", "areas"), token = token, timeout = timeout) + + list( + unserved = unlist(costs$unserverdenergycost), + spilled = unlist(costs$spilledenergycost) + ) +} + + +# Detect if there is at least one output by type of cluster +.detect_areas_with_clusters <- function(path, type, ...) { + + assertthat::assert_that(type %in% c("thermal", "renewables", "st-storage")) + + pattern_type <- switch(type, + "thermal" = "(details-annual)|(details-daily)|(details-hourly)|(details-monthly)|(details-weekly)", + "renewables" = "details-res-", + "st-storage" = "details-STstorage-" + ) + + hasClusters <- unlist( + lapply( + read_secure_json(path, ...), + function(x) any(grepl(pattern = pattern_type, x = names(x))) + ) + ) + + return(names(hasClusters)[hasClusters]) +} + + +# Build the link list by scanning the output folder links +.scan_output_links_folder <- function(path, ...) { + + linkList <- read_secure_json(path, ...) + linkList <- mapply(function(X, Y){ + if (length(Y) >= 1) { + paste(X, names(Y), sep = " - ") + } else { + NULL + } + }, names(linkList), linkList + ) + linkList <- unlist(linkList) + names(linkList) <- NULL + + return(linkList) +} + + +.get_available_output_variables <- function(path, type, linkList, areaList, ...) { + + variables <- character(0) + + lst_type <- list("areas" = list("object_name" = "area", "elements" = areaList), + "links" = list("object_name" = "link", "elements" = linkList) + ) + lst_type_target <- lst_type[[type]] + + target_list <- lst_type_target[["elements"]] + + has_items <- length(target_list) > 0 + if (!has_items) { + return(variables) + } + + if (has_items) { + path_element <- target_list[1] + if (type == "links") { + path_element <- gsub(pattern = " - ", replacement = "/", x = path_element) + } + d <- file.path(path, type, path_element) + f <- names(read_secure_json(paste0(d, "&depth=1"), ...)) + f <- f[grep("values", f)] + if (length(f) > 0) { + v <- .getOutputHeader(file.path(d, f[1]), lst_type_target[["object_name"]], api = TRUE, ...) + if (exists("pkgEnv")) { + variables <- setdiff(v, pkgEnv$idVars) + } else { + variables <- v + } + } + } + + return(variables) +} 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/utils_api.R b/R/utils_api.R index 38743b77..b9f80387 100644 --- a/R/utils_api.R +++ b/R/utils_api.R @@ -1,4 +1,5 @@ #' @importFrom utils URLencode +#' @importFrom shiny isRunning fread_antares <- function(opts, file, ...) { if (identical(opts$typeLoad, "api")) { file <- gsub("\\.txt$", "", file) @@ -9,7 +10,10 @@ fread_antares <- function(opts, file, ...) { ) suppressWarnings( tryCatch(fread(response, ...), error = function(e){ - message(file); message(e) + if(isRunning()) + e <- as.character(e) + message(file) + message(e) })) } else { suppressWarnings( @@ -42,193 +46,6 @@ read_secure_json <- function(url, token = NULL, timeout = 60, config = list()) { } -.getPathsAPI <- function(host, study_id, simulation, ...){ - simNames <- NULL - path <- paste0(host, "/v1/studies/", study_id) - path <- gsub("[/\\]$", "", path) - path <- paste0(path, "/raw?path=") - inputPath <- file.path(path, "input") - outputPath <- file.path(path, "output") - if(is.null(simulation) | (!is.null(simulation) && !simulation %in% c(0, "input"))){ - outputContent <- names(read_secure_json(paste0(outputPath, "&depth=4"), ...)) - simNames <- setdiff(basename(outputContent), c("maps", "logs")) - } - if (length(simNames) == 0) { - if (length(simulation) > 0 && !simulation %in% c(0, "input")) { - stop("Cannot find any simulation result") - } else { - simulation <- 0 - } - } - - if (is.null(simulation)) { - if (length(simNames) == 1) { # Case 2 - simulation <- 1 - } else { # Case 3 - cat("Please, choose a simulation\n") - for (i in 1:length(simNames)) { - cat(sprintf(" %s - %s\n", i, simNames[i])) - } - simulation <- type.convert(scan(what = character(), nmax = 1), as.is = TRUE) - } - } - - if (simulation %in% c(0, "input")) { - studyPath <- path - simPath <- NULL - } else { - out <- .giv_sim(simulation, simNames, path) - - std_sel <- which(unlist(lapply(simNames, function(X){ - grepl(paste0(X, "$"), out$simPath) - }))) - - # out$simPath <- gsub(simNames[std_sel], std_sel, out$simPath) - out$simOutputName <- simNames[std_sel] - return(out) - } - - list(studyPath = studyPath, - simPath = simPath, - inputPath = inputPath) - -} - - -.getSimOptionsAPI <- function(paths, host, ...){ - - ## Read info from json - simPath <- paths$simPath - - # Get basic information about the simulation - params <- read_secure_json(file.path(simPath, "about-the-study", "parameters"), ...) - - info <- read_secure_json(file.path(simPath, "info", "general"), ...) - - # Where are located the results ? - simDataPath <- file.path(simPath, tolower(as.character(info$mode))) - - synthesis <- .getSuccess(file.path(simDataPath, "mc-all&depth=1"), ...) - yearByYear <- .getSuccess(file.path(simDataPath, "mc-ind&depth=1"), ...) - scenarios <- .getSuccess(file.path(simPath, "ts-numbers&depth=1"), ...) - - - if(yearByYear) { - year_no_filter <- names(read_secure_json(file.path(simDataPath, "mc-ind&depth=1"), ...)) - mcYears <- as.numeric(year_no_filter[grep("^\\d{5}$", year_no_filter)]) - } else mcYears <- numeric() - - if (!synthesis & !yearByYear) stop("No results/data found in API", call. = FALSE) - - # List of available areas and links - if (synthesis) { - dataPath <- file.path(simDataPath, "mc-all") - } else { - dataPath <- file.path(simDataPath, "mc-ind",sprintf("%05d", mcYears[1])) - } - - areaList <- gsub("\r$", "", tolower(strsplit( - read_secure_json(file.path(paths$simPath, "about-the-study", "areas"), ...), "\n")[[1]] - )) - districtList <- grep("^@", areaList, value=TRUE) - areaList <- areaList[!areaList %in% districtList] - - linkList <- read_secure_json(file.path(dataPath, "links&depth=2"), ...) - linkList <- unlist(mapply(function(X, Y){ - if(length(Y) >= 1){ - paste(X, names(Y), sep = " - ") - } else { - NULL - } - }, names(linkList), linkList)) - names(linkList) <- NULL - - # Areas containing clusters - hasClusters <- unlist( - lapply( - read_secure_json(file.path(dataPath, "areas&depth=2"), ...), - function(x) any(grepl("(details-annual)|(details-daily)|(details-hourly)|(details-monthly)|(details-weekly)", names(x))) - ) - ) - - areasWithClusters <- names(hasClusters)[hasClusters] - - # Areas containing clusters - hasResClusters <- unlist( - lapply( - read_secure_json(file.path(dataPath, "areas&depth=2"), ...), - function(x) any(grepl("details-res-", names(x))) - ) - ) - - areasWithResClusters <- names(hasResClusters)[hasResClusters] - - hasSTClusters <- unlist( - lapply( - read_secure_json(file.path(dataPath, "areas&depth=2"), ...), - function(x) any(grepl("details-STstorage-", names(x))) - ) - ) - - areasWithSTClusters <- names(hasSTClusters)[hasSTClusters] - # Available variables - variables <- list() - - # Available variables for areas - d <- file.path(dataPath, "areas", areaList[1]) - f <- names(read_secure_json(paste0(d, "&depth=1"), ...)) - f <- f[grep("values", f)] - if (length(f) > 0) { - v <- .getOutputHeader(file.path(d, f[1]), "area", api = TRUE, ...) - if(exists("pkgEnv")){ - variables$areas <- setdiff(v, pkgEnv$idVars) - } else { - variables$areas <- v - } - } - - # Available variables for links - if(length(linkList) > 0){ - d <- file.path(dataPath, "links", gsub(" - ", "/",linkList[1])) - f <- names(read_secure_json(paste0(d, "&depth=1"), ...)) - f <- f[grep("values", f)] - if (length(f) > 0) { - v <- .getOutputHeader(file.path(d, f[1]), "link", api = TRUE, ...) - if(exists("pkgEnv")){ - variables$links <- setdiff(v, pkgEnv$idVars) - } else { - variables$links <- v - } - } - } - - linksDef <- .readLinksDef(strsplit(read_secure_json(file.path(paths$simPath, "about-the-study", "links"), ...), "\n")[[1]]) - - return( - list( - simDataPath = simDataPath, - name = as.character(info$name), - mode = as.character(info$mode), - simDate = info$date, - synthesis = synthesis, - yearByYear = yearByYear, - scenarios = scenarios, - mcYears = mcYears, - antaresVersion = info$version, - areaList = areaList, - districtList = gsub("^@ ?", "", districtList), - linkList = linkList[linkList %in% linksDef$link], - linksDef = linksDef, - areasWithClusters = intersect(areasWithClusters, areaList), - areasWithResClusters = intersect(areasWithResClusters, areaList), - areasWithSTClusters = intersect(areasWithSTClusters, areaList), - variables = variables, - parameters = params - ) - ) -} - - #' @importFrom httr GET timeout add_headers http_status .getSuccess <- function(path, token, timeout = 60, config = list()) { if (!is.null(token) && token != "") { @@ -244,227 +61,6 @@ read_secure_json <- function(url, token = NULL, timeout = 60, config = list()) { } -.getInputOptionsAPI <- function(paths, ...) { - - studyPath <- paths$studyPath - inputPath <- paths$inputPath - outputPath <- paths$simPath - - # Lists of areas, links and districts existing in the study - areaList <- unique( - tolower(unlist(read_secure_json(file.path(inputPath, "areas", "list"), ...))) - ) - - districtList <- unique( - tolower(names(read_secure_json(file.path(inputPath, "areas", "sets"), ...))) - ) - - areasWithLinks <- unique(names(read_secure_json(file.path(inputPath, "links&depth=1"), ...))) - areasWithLinks <- intersect(areasWithLinks, areaList) - - allLinks <- read_secure_json(file.path(inputPath, "links&depth=3"), ...) - linksDef <- data.table::rbindlist(mapply(function(X, Y){ - to = names(X$properties) - if (length(to) == 0) return(NULL) - - data.frame(link = paste(Y, "-", to), from = Y, to = to, stringsAsFactors = TRUE) - - }, allLinks, names(allLinks))) - - # info <- read_secure_json(studyPath, ...) - - antaresVersion <- paths$version - params <- read_secure_json(file.path(studyPath, "settings", "generaldata"), ...) - - # Areas with clusters - - clusterList <- read_secure_json(file.path(inputPath, "thermal", "clusters", "&depth=4"), ...) - areaHasClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { - TF <- FALSE - try({ - f <- clusterList[[a]]$list - if(!is.null(f))return(TRUE) - }) - return(TF) - }) - - # Areas with renewable clusters - areaHasResClusters <- logical(0) - if (!is.null(params$`other preferences`$`renewable-generation-modelling`)){ - if(params$`other preferences`$`renewable-generation-modelling` == "clusters"){ - clusterResList <- read_secure_json(file.path(inputPath, "renewables", "clusters", "&depth=4"), ...) - areaHasResClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { - TF <- FALSE - try({ - f <- clusterResList[[a]]$list - if(!is.null(f))return(TRUE) - }) - return(TF) - }) - } - } - - # Areas with st-storage (>=860) - if(paths$version>=860){ - clusterSTList <- read_secure_json(file.path(inputPath, "st-storage", "clusters", "&depth=4"), ...) - areaHasSTClusters <- vapply(areaList, FUN.VALUE = logical(1), function(a) { - TF <- FALSE - try({ - f <- clusterSTList[[a]]$list - if(!is.null(f))return(TRUE) - }) - return(TF) - }) - - # return - list( - mode = "Input", - antaresVersion = antaresVersion, - areaList = areaList, - districtList = districtList, - linkList = as.character(linksDef$link), - linksDef = linksDef, - areasWithClusters = areaList[areaHasClusters], - areasWithResClusters = areaList[areaHasResClusters], - areasWithSTClusters = areaList[areaHasSTClusters], - parameters = params - ) - }else - list( - mode = "Input", - antaresVersion = antaresVersion, - areaList = areaList, - districtList = districtList, - linkList = as.character(linksDef$link), - linksDef = linksDef, - areasWithClusters = areaList[areaHasClusters], - areasWithResClusters = areaList[areaHasResClusters], - parameters = params - ) -} - -# valid_url <- function(url_in, t = 2){ -# con <- url(url_in) -# check <- suppressWarnings(try(open.connection(con, open = "rt",timeout = t), silent = T)[1]) -# suppressWarnings(try(close.connection(con), silent = T)) -# ifelse(is.null(check),TRUE ,FALSE ) -# } - -#' @import jsonlite -#' @export -#' @return -#' \item{sleep}{timer for api commande execute} -#' @rdname setSimulationPath -setSimulationPathAPI <- function(host, study_id, token, simulation = NULL, - timeout = 60, httr_config = list()) { - - if (missing(host)) { - stop("Please specify an url to antares API host") - } - - if (missing(study_id)) { - stop("Please specify the study_id") - } - - if (missing(token)) { - stop("Please specify your access token") - } - - valid_host <- tryCatch({ - .getSuccess(file.path(host, "health"), token = "", timeout = timeout, config = httr_config) - }, error = function(e) FALSE) - - if(!valid_host){ - stop("setSimulationPathAPI : invalid host '", host, "'") - } - - stopifnot(timeout > 0) - - check_study <- tryCatch({ - read_secure_json(file.path(host, "v1/studies", study_id), token = token, - timeout = timeout, config = httr_config - ) - }, error = function(e){ - # catch message from api_get() (from API) - stop(e) - }) - - # generic tests (legacy) - if(isTRUE(all.equal(names(check_study), "detail"))){ - stop("Can't connect to API. Please verify token") - } - - # generic tests (legacy) - if(!study_id %in% check_study$id){ - stop("Can't find your 'study_id' on the API") - } - - res <- .getPathsAPI(host, - study_id, - simulation, - token = token, - timeout = timeout, - config = httr_config) - - res$studyName <- check_study$name - - res$version <- check_study$version - - # If "input mode", read options from the input folder, else read them from - # the simulation folder. - if (is.null(res$simPath) | length(res$simPath) == 0) { - res <- append(res, - .getInputOptionsAPI(res, - token = token, - timeout = timeout, - config = httr_config)) - } else { - res$simPath <- URLencode(res$simPath) - res <- append(res, - .getSimOptionsAPI(res, - host, - token = token, - timeout = timeout, - config = httr_config)) - } - - # dates, TimeId min and max - tmin <- res$parameters$general$simulation.start - tmax <- res$parameters$general$simulation.end - - res$timeIdMin <- 1 + (tmin - 1) * 24 - res$timeIdMax <- ((tmax - tmin + 1) %/% 7 * 7 + tmin - 1) * 24 - - res$start <- .getStartDate(res$parameters) - res$firstWeekday <- as.character(res$parameters$general$first.weekday) - - # Other informations that has to be read in input folder - res$districtsDef <- .readDistrictsDefAPI(res$inputPath, res$areaList, token, timeout) - - - res$energyCosts <- .readEnergyCostsAPI(res$inputPath, token, timeout) - - res$typeLoad <- "api" - res$host <- host - res$study_id <- study_id - res$token <- token - res$timeout <- timeout - res$httr_config <- httr_config - res$modeAPI <- "sync" - - # delete version to keep only "antares_version" - res$version <- NULL - - # timer for api commande execute - res$sleep <- 0.5 - - class(res) <- c("simOptions") - - options(antares = res) - - res -} - #' Change API Timeout #' #' @param opts @@ -492,40 +88,6 @@ setTimeoutAPI <- function(opts, timeout){ return(opts) } -# Private function that reads the definition of the districts -.readDistrictsDefAPI <- function(inputPath, areas, token = NULL, timeout = 60) { - districts <- read_secure_json(file.path(inputPath, "areas/sets"), token = token, timeout = timeout) - if (length(districts) == 0) return(NULL) - - res <- ldply(names(districts), function(n) { - x <- districts[[n]] - if (any(unlist(x) == "add-all")) { - areasToRemove <- unlist(x[names(x) == "-"], use.names = FALSE) - areas <- setdiff(areas, areasToRemove) - } else { - areas <- unlist(x[names(x) == "+"], use.names = FALSE) - } - if (length(areas) == 0) return(NULL) - - data.frame(district = tolower(n), area = tolower(areas), stringsAsFactors = TRUE) - }) - - data.table(res) -} - - - -# Private function that reads costs of unsuplied and spilled energy -.readEnergyCostsAPI <- function(inputPath, token = NULL, timeout = 60) { - - costs <- read_secure_json(file.path(inputPath, "thermal", "areas"), token = token, timeout = timeout) - - list( - unserved = unlist(costs$unserverdenergycost), - spilled = unlist(costs$spilledenergycost) - ) -} - is_api_study <- function(opts) { isTRUE(opts$typeLoad == "api") diff --git a/R/zzz.R b/R/zzz.R index 70e125cd..6c922c84 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,18 +105,39 @@ 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") ) +## 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) + +res_prop_st <- data.table::fread(system.file("referential_properties/properties_input_storage.csv", + package = "antaresRead"), + sep = ";", + header = TRUE) + +df_files_ref <- do.call("rbind", + list(res_prop_ref, res_prop_therm, res_prop_st)) +pkgEnv$inputProperties <- df_files_ref + integerVariable <- as.character(unique(pkgEnv$formatName$Name[which(pkgEnv$formatName$digits == 0)])) integerVariable <- unlist(apply(expand.grid(integerVariable, c("", "_std", "_min", "_max")), 1, function(X){paste0(X, collapse = "")})) - +# some tools functions ---- .tidymess <- function(..., prefix = " ", initial = ""){ as.character(strwrap(..., prefix = prefix, initial = initial)) } @@ -141,3 +166,4 @@ integerVariable <- unlist(apply(expand.grid(integerVariable, c("", "_std", "_min bydistrict <- c("district", .get_by(x)) return(bydistrict) } + diff --git a/README.md b/README.md index 56b31069..e1d4bdde 100644 --- a/README.md +++ b/README.md @@ -152,8 +152,6 @@ tar( setwd(saveWd) ``` -You must also change the h5 file [here](https://github.com/rte-antares-rpackage/antaresRead/blob/master/tests/testthat/helper_init.R#L35). - ## ANTARES : Antares is a powerful software developed by RTE to simulate and study electric power systems (more information about Antares here : ). diff --git a/_pkgdown.yml b/_pkgdown.yml index 4691d4e3..4d95075f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,5 +1,6 @@ +development: + mode: auto destination: docs - template: params: bootswatch: readable 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/readAntaresSTClusters.Rd b/man/readAntaresSTClusters.Rd new file mode 100644 index 00000000..1ca29727 --- /dev/null +++ b/man/readAntaresSTClusters.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readAntaresClusters.R +\name{readAntaresSTClusters} +\alias{readAntaresSTClusters} +\title{Read output for a list of short-term storage clusters} +\usage{ +readAntaresSTClusters( + clustersST, + selected = c("P.injection", "levels", "P.withdrawal"), + timeStep = c("hourly", "daily", "weekly", "monthly", "annual"), + opts = simOptions(), + parallel = FALSE, + showProgress = TRUE +) +} +\arguments{ +\item{clustersST}{vector of short-term storage clusters to be imported} + +\item{selected}{vector of thematic trimming} + +\item{timeStep}{Resolution of the data to import: hourly (default), daily, +weekly, monthly or annual.} + +\item{opts}{list of simulation parameters returned by the function +\code{\link{setSimulationPath}}} + +\item{parallel}{Should the importation be parallelized ? (See details)} + +\item{showProgress}{If TRUE the function displays information about the progress of the +importation.} +} +\value{ +data.table of results for short-term storage clusters +} +\description{ +Read output for a list of short-term storage clusters +} 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/man/setSimulationPath.Rd b/man/setSimulationPath.Rd index f085a136..617fffba 100644 --- a/man/setSimulationPath.Rd +++ b/man/setSimulationPath.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/setSimulationPath.R, R/utils_api.R +% Please edit documentation in R/setSimulationPath.R, R/setSimulationPathAPI.R \name{setSimulationPath} \alias{setSimulationPath} \alias{setSimulationPathAPI} diff --git a/tests/testthat/helper_init.R b/tests/testthat/helper_init.R index bc627223..23421e42 100644 --- a/tests/testthat/helper_init.R +++ b/tests/testthat/helper_init.R @@ -118,6 +118,7 @@ setup_study_empty <- function(dir_path){ # choose pattern studies <- studies[grep(x = studies, pattern = "empty_study_v870")] + # untar etude path_sty <- file.path(tempdir(), "study_empty_latest_version") diff --git a/tests/testthat/test-importOutputForClusters.R b/tests/testthat/test-importOutputForClusters.R index 33d1d730..c41f90bc 100644 --- a/tests/testthat/test-importOutputForClusters.R +++ b/tests/testthat/test-importOutputForClusters.R @@ -1,62 +1,62 @@ -# #Copyright © 2016 RTE Réseau de transport d’électricité -# -# context("Functions .importOutput") -# -# path_study_test <- grep(pattern = "test_case_study_v870", x = studyPathSV8, value = TRUE) -# -# opts <- setSimulationPath(path_study_test,simulation="20240105-0934eco") -# -# test_that(".importOutputForClusters is ok", { -# -# OutputForClusters <- .importOutputForClusters( -# areas="fr", -# timeStep="annual", -# showProgress=FALSE, -# parallel=FALSE, -# opts=opts -# ) -# -# required_order_simulation_variables <- c("production","NP Cost","NODU","profit") -# -# order_simulation_variables <- colnames(OutputForClusters)[colnames(OutputForClusters) %in% required_order_simulation_variables] -# -# expect_equal(order_simulation_variables,required_order_simulation_variables) -# expect_equal(nrow(OutputForClusters),1) -# }) -# -# -# test_that(".importOutputForResClusters is ok", { -# -# OutputForResClusters <- .importOutputForResClusters( -# areas="fr", -# timeStep="annual", -# showProgress=FALSE, -# parallel=FALSE, -# opts=opts -# ) -# -# required_order_simulation_variables <- c("production") -# -# order_simulation_variables <- colnames(OutputForResClusters)[colnames(OutputForResClusters) %in% required_order_simulation_variables] -# -# expect_equal(order_simulation_variables,required_order_simulation_variables) -# expect_equal(nrow(OutputForResClusters),1) -# }) -# -# test_that(".importOutputForSTClusters is ok", { -# -# OutputForSTClusters <- .importOutputForSTClusters( -# areas="fr", -# timeStep="annual", -# showProgress=FALSE, -# parallel=FALSE, -# opts=opts -# ) -# -# required_order_simulation_variables <- c("P.injection","levels","P.withdrawal") -# -# order_simulation_variables <- colnames(OutputForSTClusters)[colnames(OutputForSTClusters) %in% required_order_simulation_variables] -# -# expect_equal(order_simulation_variables,required_order_simulation_variables) -# expect_equal(nrow(OutputForSTClusters),1) -# }) +#Copyright © 2016 RTE Réseau de transport d’électricité + +context("Functions .importOutput") + +path_study_test <- grep(pattern = "test_case_study_v870", x = studyPathSV8, value = TRUE) + +opts <- setSimulationPath(path_study_test,simulation="20240105-0934eco") + +test_that(".importOutputForClusters is ok", { + + OutputForClusters <- .importOutputForClusters( + areas="fr", + timeStep="annual", + showProgress=FALSE, + parallel=FALSE, + opts=opts + ) + + required_order_simulation_variables <- c("production","NP Cost","NODU","profit") + + order_simulation_variables <- colnames(OutputForClusters)[colnames(OutputForClusters) %in% required_order_simulation_variables] + + expect_equal(order_simulation_variables,required_order_simulation_variables) + expect_equal(nrow(OutputForClusters),1) +}) + + +test_that(".importOutputForResClusters is ok", { + + OutputForResClusters <- .importOutputForResClusters( + areas="fr", + timeStep="annual", + showProgress=FALSE, + parallel=FALSE, + opts=opts + ) + + required_order_simulation_variables <- c("production") + + order_simulation_variables <- colnames(OutputForResClusters)[colnames(OutputForResClusters) %in% required_order_simulation_variables] + + expect_equal(order_simulation_variables,required_order_simulation_variables) + expect_equal(nrow(OutputForResClusters),1) +}) + +test_that(".importOutputForSTClusters is ok", { + + OutputForSTClusters <- .importOutputForSTClusters( + areas="fr", + timeStep="annual", + showProgress=FALSE, + parallel=FALSE, + opts=opts + ) + + required_order_simulation_variables <- c("P.injection","levels","P.withdrawal") + + order_simulation_variables <- colnames(OutputForSTClusters)[colnames(OutputForSTClusters) %in% required_order_simulation_variables] + + expect_equal(order_simulation_variables,required_order_simulation_variables) + expect_equal(nrow(OutputForSTClusters),1) +}) diff --git a/tests/testthat/test-readAntares_STclusters.R b/tests/testthat/test-readAntares_STclusters.R index e0c0dc67..118261e5 100644 --- a/tests/testthat/test-readAntares_STclusters.R +++ b/tests/testthat/test-readAntares_STclusters.R @@ -1,15 +1,53 @@ #Copyright © 2016 RTE Réseau de transport d’électricité +context("Function readAntares (ST clusters)") +path_study_test <- grep(pattern = "test_case_study_v870", x = studyPathSV8, value = TRUE) +suppressWarnings(opts <- setSimulationPath(path_study_test, simulation = "20240105-0934eco")) -# test_that("ST clusters importation is ok", { -# path_study_test <- grep(pattern = "test_case_study_v870", x = studyPathSV8, value = TRUE) -# opts <- setSimulationPath(path_study_test,simulation="20240105-0934eco") -# -# clustersST <- readAntares(clustersST="all",timeStep="annual",opts = opts)$clustersST -# expect_true(all(opts$areasWithSTClusters %in% clustersST$area)) -# -# clustersST_fr <- readAntares(clustersST="fr",timeStep="annual",opts = opts)$clustersST -# expect_true("fr"==unique(clustersST_fr$area)) -# }) +test_that("ST clusters importation is ok", { + + clustersST <- readAntares(clustersST = "all", timeStep = "annual",opts = opts) + expect_true(all(opts$areasWithSTClusters %in% clustersST$area)) + + clustersST_fr <- readAntares(clustersST = "fr", timeStep = "annual", opts = opts) + expect_true("fr" == unique(clustersST_fr$area)) +}) + + +test_that("ST clusters importation is OK", { + nweeks_study <- 52 + output_cols <- c("P.injection", "levels", "P.withdrawal") + clusters <- readAntaresSTClusters(clusters = "fr_st_other1", selected = output_cols[1:2], timeStep = "hourly", showProgress = FALSE, opts = opts) + expect_is(clusters, "data.table") + expect_true(!is.null(clusters$cluster)) + expect_equal(nrow(clusters), 24 * 7 * nweeks_study) + expect_true(all(output_cols[1:2] %in% colnames(clusters))) + expect_false(output_cols[3] %in% colnames(clusters)) +}) + + +test_that("ST clusters importation is OK for all time resolutions.", { + nweeks_study <- 52 + for (timeStep in c("hourly", "daily", "weekly", "monthly", "annual")) { + expected_rows = switch(timeStep, + hourly = 24 * 7 * nweeks_study, + daily = 7 * nweeks_study, + weekly = nweeks_study, + monthly = 12, + annual = 1) + + clusters <- readAntaresSTClusters(clusters = "fr_st_other1", showProgress = FALSE, timeStep = timeStep) + expect_equal(nrow(clusters), expected_rows) + } +}) + + +test_that("ST clusters importation is KO if clusters do not belong to the study output", { + expect_warning(clusters <- readAntaresSTClusters(clusters = c("fake_one", "not_a_cluster"), timeStep = "hourly", showProgress = FALSE, opts = opts), + regexp = "do not exist in the simulation" + ) + expect_is(clusters, "data.table") + expect_true(nrow(clusters) == 0) +}) diff --git a/tests/testthat/test-readBindingConstraints.R b/tests/testthat/test-readBindingConstraints.R index 14710db6..6029f1b0 100644 --- a/tests/testthat/test-readBindingConstraints.R +++ b/tests/testthat/test-readBindingConstraints.R @@ -50,6 +50,7 @@ test_that("test if exist data value file", { # read latest version of empty study study_empty_latest_version <- setup_study_empty(sourcedir_empty_study) + opts_test_empty <- antaresRead::setSimulationPath(study_empty_latest_version, "input") diff --git a/tests/testthat/test-readClusterDesc.R b/tests/testthat/test-readClusterDesc.R index 75929a29..e01a6980 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 = "test_case_study_v870", 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()) }) diff --git a/tests/testthat/test-readInputClusters.R b/tests/testthat/test-readInputClusters.R index f9d6f8d8..9232a2f0 100644 --- a/tests/testthat/test-readInputClusters.R +++ b/tests/testthat/test-readInputClusters.R @@ -86,4 +86,36 @@ test_that("test reading TS RES", { }) + +}) + +# >= v870 ---- +## RES ---- +test_that("test reading TS RES", { + + # read latest version study + path_study_test <- grep(pattern = "test_case_study_v870", x = studyPathSV8, value = TRUE) + setSimulationPath(path_study_test, simulation = "input") + + res_clust_properties <- readClusterResDesc() + + test_that("read one cluster", { + # read /series files (default) + input <- readInputRES(areas = "all", + clusters = unique(res_clust_properties$cluster)[1]) + expect_is(input, "antaresDataTable") + expect_gt(nrow(input), 0) + expect_equal(nrow(input) %% (24 * 7 * nweeks), 0) + }) + + test_that("read various clusters", { + nb_cluster <- length(unique(res_clust_properties$cluster)) + # read /series files (default) + input <- readInputRES(areas = "all", + clusters = unique(res_clust_properties$cluster)) + expect_is(input, "antaresDataTable") + expect_gt(nrow(input), 0) + expect_equal(nrow(input) %% (24 * 7 * nweeks), 0) + }) + }) diff --git a/tests/testthat/test-setSimulationPath.R b/tests/testthat/test-setSimulationPath.R index a4a3c0c2..ae9bbb09 100644 --- a/tests/testthat/test-setSimulationPath.R +++ b/tests/testthat/test-setSimulationPath.R @@ -177,7 +177,6 @@ test_that("Folder 'maps' is not interpreted as a study (#49)", { expect_silent(opts <- setSimulationPath(studyPath, -1)) }) - test_that("No meta info areas with a ST cluster < 860", { opts <- setSimulationPath(studyPath, "input") expect_true(length(opts$areasWithSTClusters)==0)