#' @title Remove a Binding Constraint
#'
#' @description
#' `r antaresEditObject:::badge_api_ok()`
#' `r lifecycle::badge("experimental")`
#'
#' Remove a binding constraint in an Antares study.
#'
#'
#' @param name Name(s) of the binding constraint(s) to remove.
#' @param group `character` Name(s) of group to delete
#'
#' @template opts
#'
#' @note
#' Starting with version **v8.7.0**, you can delete binding constraints by
#' name or by group.
#'
#' @family binding constraints functions
#'
#' @export
#'
#' @examples
#' \dontrun{
#'# < v8.7.0 :
#' removeBindingConstraint(name = "mybindingconstraint")
#'
#' # >= v8.7.0 (delete by names group) :
#' # read
#' bc <- readBindingConstraints()
#'
#' # select all groups
#' group_to_delete <- sapply(bc, function(x){
#' x$properties$group
#' })
#'
#' # delete all groups
#' removeBindingConstraint(group = group_to_delete)
#' }
removeBindingConstraint <- function(name = NULL,
group = NULL,
opts = antaresRead::simOptions()) {
assertthat::assert_that(inherits(opts, "simOptions"))
# some checks for "group" parameter according to study version
if(!is.null(group)){
if(!opts$antaresVersion >= 870){
stop("Parameter 'group' is only for Antares study version >= v8.7.0",
call. = FALSE)
}
else if(!is.null(name)){
stop("You can only delete binding constraint by id/name or by group",
call. = FALSE)
}
}
# API block
if (is_api_study(opts)) {
opts_api <- .remove_bc_api(name = name,
group = group,
opts = opts)
return(invisible(opts_api))
}
## read Ini file
pathIni <- file.path(opts$inputPath, "bindingconstraints/bindingconstraints.ini")
bindingConstraints <- readIniFile(pathIni, stringsAsFactors = FALSE)
namesbc <- unlist(lapply(bindingConstraints, `[[`, "id"), use.names = FALSE)
# suppression txt files + remove constraint from ini file
if(!is.null(name))
updated_bc <- .delete_by_name(bc_properties = bindingConstraints,
names_to_delete = name,
all_bc_names = namesbc,
opts = opts)
# suppression txt files + remove constraint from ini file [by group]
if(!is.null(group))
updated_bc <- .delete_by_group(group = group,
bc_properties = bindingConstraints,
all_bc_names = namesbc,
opts = opts)
# Write Ini
writeIni(listData = updated_bc, pathIni = pathIni, overwrite = TRUE)
# Maj simulation
suppressWarnings({
res <- antaresRead::setSimulationPath(path = opts$studyPath, simulation = "input")
})
invisible(res)
}
.delete_by_name <- function(bc_properties,
names_to_delete,
all_bc_names,
opts){
# delete all bc with names/id matching in study
# delete values
# delete .ini section
for (i in names_to_delete) {
if (! i %in% all_bc_names) {
warning(paste0("No binding constraint with name '", i, "'"))
} else {
index <- which(all_bc_names == i)
id <- bc_properties[[index]]$id
bc_properties[[index]] <- NULL
# v870
if(opts$antaresVersion>=870){
path_lt <- file.path(opts$inputPath,
sprintf("bindingconstraints/%s.txt",
paste0(id, "_lt")))
path_gt <- file.path(opts$inputPath,
sprintf("bindingconstraints/%s.txt",
paste0(id, "_gt")))
path_eq <- file.path(opts$inputPath,
sprintf("bindingconstraints/%s.txt",
paste0(id, "_eq")))
lapply(c(path_lt, path_gt, path_eq),
unlink)
}else{
pathValues <- file.path(opts$inputPath, "bindingconstraints", paste0(id, ".txt"))
unlink(x = pathValues)
}
all_bc_names <- unlist(lapply(bc_properties, `[[`, "id"), use.names = FALSE)
names(bc_properties) <- as.character(seq_along(bc_properties) - 1)
}
}
return(bc_properties)
}
# feature v870 delete bc by group
.delete_by_group <- function(group,
bc_properties,
all_bc_names,
opts){
# extract groups
bc_groups <- unlist(
lapply(bc_properties,
`[[`,
"group"),
use.names = FALSE)
if(!all(group%in%bc_groups))
stop(paste0("No binding constraint with group '",
group[!group%in%bc_groups], "'"),
call. = FALSE)
else{
index <- which(bc_groups%in%group)
names_to_delete <- sapply(index,
function(x,
bc = bc_properties){
bc[[x]]$id
})
updated_bc <- .delete_by_name(bc_properties = bc_properties,
names_to_delete = names_to_delete,
all_bc_names = all_bc_names,
opts = opts)
updated_bc
}
}
.remove_bc_api <- function(..., opts){
args <- list(...)
# <v870
if(opts$antaresVersion<870){
# remove serial bc
for (i in args$name) {
cmd <- api_command_generate(
"remove_binding_constraint",
id = i
)
api_command_register(cmd, opts = opts)
`if`(
should_command_be_executed(opts),
api_command_execute(cmd, opts = opts, text_alert = "remove_binding_constraint: {msg_api}"),
cli_command_registered("remove_binding_constraint")
)
}
return(invisible(opts))
}
# >=v870
# delete by group(s) name(s)
if(!is.null(args$group)){
group <- args$group
all_bc <- readBindingConstraints(opts = opts)
# extract groups
bc_groups <- sapply(all_bc, function(x){
x$properties$group
})
# check
if(!all(group%in%bc_groups))
stop(paste0("No binding constraint with group '",
group[!group%in%bc_groups], "'"),
call. = FALSE)
# select name to delete
index <- which(bc_groups%in%group)
names_to_delete <- sapply(index,
function(x,
bc = all_bc){
bc[[x]]$properties$id
})
# delete names
lapply(names_to_delete, function(x){
# send request
api_delete(opts = opts,
endpoint = file.path(opts$study_id, "bindingconstraints", x),
encode = "raw")
cli::cli_alert_success("Endpoint {.emph {'Delete bindingconstraints'}} {.emph
{.strong {x}}} success")
})
}else
lapply(args$name, function(x){
# send request
api_delete(opts = opts,
endpoint = file.path(opts$study_id, "bindingconstraints", x),
encode = "raw")
cli::cli_alert_success("Endpoint {.emph {'Delete bindingconstraints'}} {.emph
{.strong {x}}} success")
})
return(invisible(opts))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.