Add deduplicateScenarioBuilder, tests, doc (#104)

deduplicate scenario builder and keep the last key

NAMESPACE

@@ -30,6 +30,7 @@ export(createPSP)
 export(createStudy)
 export(createStudyAPI)
 export(createVariant)
+export(deduplicateScenarioBuilder)
 export(deleteStudy)
 export(dicoGeneralSettings)
 export(dicoOptimizationSettings)

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

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")
+}

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)