From 49b8e29589204b18f5fc0c3ac20856989324402d Mon Sep 17 00:00:00 2001 From: KKamel67 <58913912+KKamel67@users.noreply.github.com> Date: Mon, 4 Sep 2023 11:31:59 +0200 Subject: [PATCH] Add deduplicateScenarioBuilder, tests, doc (#104) deduplicate scenario builder and keep the last key --- NAMESPACE | 1 + NEWS.md | 2 + R/scenarioBuilder.R | 64 +++++++++++++++++- man/scenario-builder.Rd | 13 +++- tests/testthat/test-scenarioBuilder.R | 96 ++++++++++++++++++++++++++- 5 files changed, 171 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ceeabcd0..32482d05 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,6 +30,7 @@ export(createPSP) export(createStudy) export(createStudyAPI) export(createVariant) +export(deduplicateScenarioBuilder) export(deleteStudy) export(dicoGeneralSettings) export(dicoOptimizationSettings) diff --git a/NEWS.md b/NEWS.md index 13605868..07dfb15c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,9 +19,11 @@ NEW FEATURES (Antares v8.6) : NEW FEATURES : +* Add deduplicateScenarioBuilder() function to keep the last value if a key is duplicated in settings/scenariobuilder.dat * Add writeIniHydro() function to make easier the edition of the input/hydro/hydro.ini file * Call writeIniHydro() in createArea() and removeArea() + ### Breaking changes * `deleteStudy()` no longer requires user confirmation diff --git a/R/scenarioBuilder.R b/R/scenarioBuilder.R index 80efa8b5..11dc5c9b 100644 --- a/R/scenarioBuilder.R +++ b/R/scenarioBuilder.R @@ -1,9 +1,9 @@ -#' @title Read, create & update scenario builder +#' @title Read, create, update & deduplicate scenario builder #' #' @description #' `r antaresEditObject:::badge_api_ok()` #' -#' Read, create & update scenario builder. +#' Read, create, update & deduplicate scenario builder. #' #' @param n_scenario Number of scenario. #' @param n_mc Number of Monte-Carlo years. @@ -72,6 +72,9 @@ #' s = solar_sb #' )) #' +#' # Deduplicate scenario builder +#' +#' deduplicateScenarioBuilder() #' } scenarioBuilder <- function(n_scenario, n_mc = NULL, @@ -432,3 +435,60 @@ linksAsDT <- function(x) { as.data.table(x) } + +#' @title Keep the last element of a named list +#' +#' @param row of a data frame with 2 columns : key of the scenario builder and its frequency in the scenariobuilder.dat file +#' @param prevldata a named list +#' +#' @noRd +keep_last_element_from_named_list <- function(row, prevldata){ + + newldata <- list() + + key <- as.character(row[1]) + nb_values <- as.numeric(row[2]) + + prevldata_key <- prevldata[which(names(prevldata) == key)] + newldata[[key]] <- prevldata_key[[nb_values]] + + if(nb_values > 1){ + cat("The following lines will be removed from scenariobuilder.dat\n") + for(i in seq(1, nb_values-1)){ + cat(key, "=", prevldata_key[[i]], "\n") + } + } + + return(newldata) +} + + +#' @title Deduplicate the scenariobuilder.dat file +#' +#' @param ruleset Ruleset to read. +#' @param opts +#' List of simulation parameters returned by the function +#' [antaresRead::setSimulationPath()] +#' +#' @export +#' +#' @rdname scenario-builder +deduplicateScenarioBuilder <- function(ruleset = "Default Ruleset", + opts = antaresRead::simOptions()){ + + assertthat::assert_that(inherits(opts, "simOptions")) + + prevSB <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + lnewSB <- lapply(prevSB, FUN = function(x){ + table_freq <- as.data.frame(table(names(x))) + newSBkey <- apply(table_freq, MARGIN = 1, FUN = keep_last_element_from_named_list, prevldata = x) + newSBkey <- do.call("c", newSBkey) + }) + + res <- do.call("c", c(lnewSB, use.names = FALSE)) + newSB <- list() + newSB[[ruleset]] <- res + pathSB <- file.path(opts$studyPath, "settings", "scenariobuilder.dat") + writeIni(listData = newSB, pathIni = pathSB, overwrite = TRUE, default_ext = ".dat") + cat("\u2713", "Scenario Builder deduplicated\n") +} diff --git a/man/scenario-builder.Rd b/man/scenario-builder.Rd index 822b2afc..83dcd255 100644 --- a/man/scenario-builder.Rd +++ b/man/scenario-builder.Rd @@ -6,7 +6,8 @@ \alias{readScenarioBuilder} \alias{updateScenarioBuilder} \alias{clearScenarioBuilder} -\title{Read, create & update scenario builder} +\alias{deduplicateScenarioBuilder} +\title{Read, create, update & deduplicate scenario builder} \usage{ scenarioBuilder( n_scenario, @@ -35,6 +36,11 @@ clearScenarioBuilder( ruleset = "Default Ruleset", opts = antaresRead::simOptions() ) + +deduplicateScenarioBuilder( + ruleset = "Default Ruleset", + opts = antaresRead::simOptions() +) } \arguments{ \item{n_scenario}{Number of scenario.} @@ -74,7 +80,7 @@ Default is to read existing links and update them all.} \description{ \ifelse{html}{\figure{badge_api_ok.svg}{options: alt='Antares API OK'}}{Antares API: \strong{OK}} -Read, create & update scenario builder. +Read, create, update & deduplicate scenario builder. } \note{ \code{series = "ntc"} is only available with Antares >= 8.2.0. @@ -131,5 +137,8 @@ updateScenarioBuilder(ldata = list( s = solar_sb )) +# Deduplicate scenario builder + +deduplicateScenarioBuilder() } } diff --git a/tests/testthat/test-scenarioBuilder.R b/tests/testthat/test-scenarioBuilder.R index 9671bc8d..81fb751e 100644 --- a/tests/testthat/test-scenarioBuilder.R +++ b/tests/testthat/test-scenarioBuilder.R @@ -7,7 +7,7 @@ sapply(studies, function(study) { setup_study(study, sourcedir) opts <- antaresRead::setSimulationPath(studyPath, "input") - + original_scbuilder <- readScenarioBuilder(ruleset = "Default Ruleset", opts = opts, as_matrix = FALSE) test_that("scenarioBuilder works", { @@ -133,6 +133,100 @@ sapply(studies, function(study) { expect_length(readScenarioBuilder(), 0L) }) + test_that("deduplicateScenarioBuilder keeps only one value by key", { + + added_list <- list() + final_sbuilder <- list() + original_scbuilder_to_write <- list() + ruleset <- "Default Ruleset" + nb_new_values <- 10 + + pathSB <- file.path(opts$studyPath, "settings", "scenariobuilder.dat") + original_scbuilder_to_write[[ruleset]] <- do.call("c", c(original_scbuilder, use.names = FALSE)) + writeIni(listData = original_scbuilder_to_write, pathIni = pathSB, overwrite = TRUE, default_ext = ".dat") + + sbuilder <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + + series <- names(sbuilder) + serie <- series[1] + sbuilder_ftype <- sbuilder[[serie]] + fkey <- names(sbuilder_ftype)[1] + + for(i in seq(1,nb_new_values)){ + added_list[i] <- i + } + names(added_list) <- rep(fkey,nb_new_values) + sbuilder_ftype <- append(sbuilder_ftype, added_list) + sbuilder[[serie]] <- sbuilder_ftype + final_sbuilder[[ruleset]] <- do.call("c", c(sbuilder, use.names = FALSE)) + + writeIni(listData = final_sbuilder, pathIni = pathSB, overwrite = TRUE, default_ext = ".dat") + + dupSB <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + dupSB_serie <- dupSB[[serie]] + freq_dupSB_serie <- as.data.frame(table(names(dupSB_serie))) + nb_occur_dup_fkey <- freq_dupSB_serie[freq_dupSB_serie$Var1==fkey,"Freq"] + + deduplicateScenarioBuilder(ruleset = ruleset, opts = opts) + + dedupSB <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + dedupSB_serie <- dedupSB[[serie]] + freq_dedupSB_serie <- as.data.frame(table(names(dedupSB_serie))) + nb_occur_dedup_fkey <- freq_dedupSB_serie[freq_dedupSB_serie$Var1==fkey,"Freq"] + + expect_equal(nb_occur_dup_fkey-nb_new_values,1) + }) + + test_that("deduplicateScenarioBuilder keeps the last value from a duplicated key", { + + added_list <- list() + final_sbuilder <- list() + original_scbuilder_to_write <- list() + ruleset <- "Default Ruleset" + fixed_value <- "123456789" + nb_new_values <- 10 + + pathSB <- file.path(opts$studyPath, "settings", "scenariobuilder.dat") + original_scbuilder_to_write[[ruleset]] <- do.call("c", c(original_scbuilder, use.names = FALSE)) + writeIni(listData = original_scbuilder_to_write, pathIni = pathSB, overwrite = TRUE, default_ext = ".dat") + + sbuilder <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + + series <- names(sbuilder) + serie <- series[1] + sbuilder_ftype <- sbuilder[[serie]] + fkey <- names(sbuilder_ftype)[1] + + for(i in seq(1,nb_new_values)){ + added_list[i] <- i + } + added_list[nb_new_values+1] <- fixed_value + names(added_list) <- rep(fkey,nb_new_values+1) + sbuilder_ftype <- append(sbuilder_ftype, added_list) + sbuilder[[serie]] <- sbuilder_ftype + + final_sbuilder[[ruleset]] <- do.call("c", c(sbuilder, use.names = FALSE)) + + writeIni(listData = final_sbuilder, pathIni = pathSB, overwrite = TRUE, default_ext = ".dat") + + dupSB <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + dupSB_serie <- dupSB[[serie]] + dupSB_fkey <- dupSB_serie[which(names(dupSB_serie)==fkey)] + dupSB_fkey <- unlist(dupSB_fkey, use.names = FALSE) + dupSB_fkey <- dupSB_fkey[length(dupSB_fkey)] + + deduplicateScenarioBuilder(ruleset = ruleset, opts = opts) + + dedupSB <- readScenarioBuilder(ruleset = ruleset, opts = opts, as_matrix = FALSE) + dedupSB_serie <- dedupSB[[serie]] + dedupSB_fkey <- dedupSB_serie[which(names(dedupSB_serie)==fkey)] + dedupSB_fkey <- unlist(dedupSB_fkey, use.names = FALSE) + dedupSB_fkey <- dedupSB_fkey[1] + + expect_equal(dupSB_fkey, dedupSB_fkey) + expect_equal(dupSB_fkey, as.numeric(fixed_value)) + }) + # remove temporary study unlink(x = file.path(pathstd, "test_case"), recursive = TRUE)