From a0fa79fb1d62e0974c6ef02e4a9c354101b47c1c Mon Sep 17 00:00:00 2001 From: kemihak Date: Mon, 29 Jul 2024 17:52:10 +0200 Subject: [PATCH] Control matrix dimension not at the first index --- NEWS.md | 3 +- R/createBindingConstraint.R | 80 +++++++++++-------- tests/testthat/test-createBindingConstraint.R | 42 ++++++++++ 3 files changed, 91 insertions(+), 34 deletions(-) diff --git a/NEWS.md b/NEWS.md index 925ab3fb..e0c1b28d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,7 +21,8 @@ BUGFIXES : * `createBindingConstraint()` in API mode (for study =8.7.0 - if(opts$antaresVersion>=870) - .check_bulk_object_dim(constraints = constraints, - opts = opts) - ## Ini file - pathIni <- file.path(opts$inputPath, "bindingconstraints/bindingconstraints.ini") - bindingConstraints <- readIniFile(pathIni, stringsAsFactors = FALSE) + assertthat::assert_that(inherits(opts, "simOptions")) + if(opts[["antaresVersion"]] >= 870) { + # check matrix dimension + .check_bulk_object_dim(constraints = constraints, opts = opts) + } + pathIni <- file.path(opts$inputPath, "bindingconstraints", "bindingconstraints.ini") + bindingConstraints <- readIniFile(pathIni, stringsAsFactors = FALSE) for (i in seq_along(constraints)) { - values_operator <- switch(constraints[[i]]$operator, - less = "lt", - equal = "eq", - greater = "gt", - both = c("lt", "gt")) + values_operator <- switch_to_list_name_operator_870(constraints[[i]][["operator"]]) bindingConstraints <- do.call("createBindingConstraint_", c( constraints[[i]], @@ -780,6 +773,7 @@ createBindingConstraintBulk <- function(constraints, suppressWarnings({ res <- antaresRead::setSimulationPath(path = opts$studyPath, simulation = "input") }) + invisible(res) } @@ -794,33 +788,38 @@ createBindingConstraintBulk <- function(constraints, # In all_dim_group, group is column V1, number of columns is column V2 all_dim_group <- do.call("rbind", c(lapply(constraints, function(x){ - data.table(name_group <- x$group, - dim_group <- dim(x$values[[1]])[2])}), - fill = TRUE)) + operator_symbol <- switch_to_list_name_operator_870(x[["operator"]]) + dim_matrix <- lapply(x[["values"]][which(names(x[["values"]]) %in% operator_symbol)], dim) + data.table(rep(x[["group"]], length(dim_matrix)), sapply(dim_matrix, "[[", 2)) + } + ), + fill = TRUE + ) + ) # If each matrix is NULL, there is no second dimension in the table if (dim(all_dim_group)[2] < 2) { return() } - # no duplicated - all_dim_group <- unique(all_dim_group) - select_dim <- all_dim_group[V2>1] + # Deduplicate rows and filter V2 > 1 + select_dim <- unique(all_dim_group)[V2 > 1] - # count - t_df <- table(select_dim) - check_row <- rowSums(t_df) + # Detect duplicated groups + duplicated_groups <- select_dim[duplicated(select_dim$V1),]$V1 - if(any(check_row>1)) + if (!identical(duplicated_groups, character(0))) { stop("Problem dimension with group : ", - paste0(names(check_row[check_row>1]), sep = " "), + paste0(duplicated_groups, sep = " "), call. = FALSE) + } # check input object with study - if(is.null(opts$binding)) + if (is.null(opts[["binding"]])) { return() + } else{ - merge_groups <- merge.data.table(x = opts$binding, + merge_groups <- merge.data.table(x = opts[["binding"]], y = select_dim, by.x ="name_group", by.y = "V1") @@ -830,10 +829,25 @@ createBindingConstraintBulk <- function(constraints, # check diff diff_dim <- merge_groups[dim_study!=dim_input] - if(nrow(diff_dim)>0) + if (nrow(diff_dim) > 0) { stop("Problem dimension with group in Study: ", paste0(diff_dim$name_group, sep = " "), call. = FALSE) + } } } + +switch_to_list_name_operator_870 <- function(operator) { + + assertthat::assert_that(operator %in% c("less", "greater", "equal", "both")) + + operator_symbol <- switch(operator, + "less" = "lt", + "equal" = "eq", + "greater" = "gt", + "both" = c("lt", "gt") + ) + + return(operator_symbol) +} diff --git a/tests/testthat/test-createBindingConstraint.R b/tests/testthat/test-createBindingConstraint.R index 57d365a6..887b4f9e 100644 --- a/tests/testthat/test-createBindingConstraint.R +++ b/tests/testthat/test-createBindingConstraint.R @@ -824,6 +824,48 @@ test_that("test mixed VALUES in study v8.7", { +}) + + +test_that("test that control of matrix dimension is not dependent of the order in the list values", { + + val_cstr1 <- list("lt" = matrix(data = rep(0, 8760 * 1), ncol = 1), + "gt" = matrix(data = rep(555, 8760 * 3), ncol = 3), + "eq" = matrix(data = rep(0, 8760 * 1), ncol = 1) + ) + val_cstr2 <- list("lt" = matrix(data = rep(0, 8760 * 1), ncol = 1), + "eq" = matrix(data = rep(0, 8760 * 1), ncol = 1), + "gt" = matrix(data = rep(777, 8760 * 5), ncol = 5) + ) + lst_cstr <- list( + list( + name = "cstr1", + id = "cstr1", + values = val_cstr1, + enabled = TRUE, + timeStep = "hourly", + operator = "greater", + coefficients = list("at%fr" = 1), + group= "group_bulk_123", + overwrite = TRUE + ), + list( + name = "cstr2", + id = "cstr2", + values = val_cstr2, + enabled = TRUE, + timeStep = "hourly", + operator = "greater", + coefficients = list("at%fr" = 1), + group= "group_bulk_123", + overwrite = TRUE + ) + ) + expect_error( + createBindingConstraintBulk(constraints = lst_cstr, opts = simOptions()), + regexp = "Problem dimension with group" + ) + }) # remove temporary study ----