Nothing
#' @title Setting parameter values into xml files
#'
#' @description Setting parameter values for a parameter or a vector of and
#' with a parameters values vector
#'
#' @param file Path (including name) of the xml file to modify
#' @param param Vector of parameter names.
#' @param values A vector or a list of parameter(s) values (see details).
#' @param save_as Path (including name) of the xml file to generate.
#' Optional, if NULL `file` is overwritten.
#' @param select node name or attribute name to use for selection
#' (optional, default to no selection)
#' @param select_value Vector of values used for select (see examples).
#' Optional, should be provided only if select is provided.
#' @param overwrite Logical TRUE for overwriting the output file,
#' FALSE otherwise (default)
#' @param xml_file `r lifecycle::badge("deprecated")` `xml_file` is no
#' longer supported, use file instead.
#' @param out_path `r lifecycle::badge("deprecated")` `out_path` is no
#' longer supported, use save_as instead.
#' @param param_name `r lifecycle::badge("deprecated")` `param_name` is no
#' longer supported, use param instead.
#' @param param_value `r lifecycle::badge("deprecated")` `param_value` is no
#' longer supported, use values instead.
#' @param value `r lifecycle::badge("deprecated")` `value` is no
#' longer supported, use select_value instead.
#' @param... Pass further arguments to `set_param_value()`.
#'
#' @return A logical value TRUE for operation success, FALSE otherwise
#'
#' @details It is possible to give several values for a parameter by passing
#' a vector of values. For example, for two parameters with two values each:
#' value= list(c(1,2), c(2.3,4.5))
#'
#' @examples
#'
#' ex_path <- get_examples_path(file_type = "xml")
#'
#' # Soil file
#'
#' sol_path <- file.path(ex_path, "sols.xml")
#'
#' # For scalar parameters per soil
#' # Setting all soils "argi" values to 50
#' set_param_xml(sol_path, "argi", 50, overwrite = TRUE)
#' # Getting changed values
#' # get_param_xml(sol_path, "argi")
#'
#' # Setting a specific value to "argi" for "solcanne" soil
#' set_param_xml(file = sol_path, param = "argi", values = 56,
#' select = "sol", select_value = "solcanne", overwrite = TRUE
#' )
#' # Getting changed values
#' # get_param_xml(sol_path, "argi",
#' # select = "sol", select_value = "solcanne"
#' #)
#'
#'
#' # Setting a specific values to 2 parameters "argi" and
#' # "norg" for "solcanne" soil
#' set_param_xml(sol_path, c("argi", "norg"), list(100, 150),
#' select = "sol", select_value = "solcanne", overwrite = TRUE
#' )
#' # Getting changed values
#' # get_param_xml(sol_path, c("argi", "norg"),
#' # select = "sol", select_value = "solcanne"
#' #)
#'
#'
#' # For vector parameters per soil (5 values, one per soil layer)
#' set_param_xml(sol_path, c("epc", "HCCF"),
#' select = "sol",
#' select_value = c("solcanne", "solbanane"),
#' param_value = list(c(20:24, 10:14), c(50:54, 40:44)), overwrite = TRUE
#' )
#' # Getting changed values
#' # get_param_xml(sol_path, c("epc", "HCCF"),
#' # select = "sol",
#' # select_value = c("solcanne", "solbanane")
#' # )
#'
#'
#' # Crop management file
#'
#' tec_path <- file.path(ex_path, "file_tec.xml")
#'
#' # Modifying irrigations parameters
#' set_param_xml(tec_path, c("julapI_or_sum_upvt", "amount"),
#' param_value = list(200:215, 20:35), overwrite = TRUE
#' )
#' # Getting changed values
#' # get_param_xml(tec_path, c("julapI_or_sum_upvt", "amount"))
#'
#'
#' @export
set_param_xml <- function(file,
param,
values,
save_as = NULL,
select = NULL,
select_value = NULL,
overwrite = FALSE,
xml_file = lifecycle::deprecated(),
out_path = lifecycle::deprecated(),
param_name = lifecycle::deprecated(),
param_value = lifecycle::deprecated(),
value = lifecycle::deprecated(),
...) {
# ... argument for passing : ids, show_xpath to get_param_value
if (lifecycle::is_present(xml_file)) {
lifecycle::deprecate_warn("1.0.0",
"set_param_xml(xml_file)",
"set_param_xml(file)")
} else {
xml_file <- file # to remove when we update inside the function
}
if (lifecycle::is_present(out_path)) {
lifecycle::deprecate_warn("1.0.0",
"set_param_xml(out_path)",
"set_param_xml(save_as)")
} else {
out_path <- save_as # to remove when we update inside the function
}
if (lifecycle::is_present(param_name)) {
lifecycle::deprecate_warn("1.0.0",
"set_param_xml(param_name)",
"set_param_xml(param)")
} else {
param_name <- param # to remove when we update inside the function
}
if (lifecycle::is_present(param_value)) {
lifecycle::deprecate_warn("1.0.0",
"set_param_xml(param_value)",
"set_param_xml(values)")
} else {
param_value <- values # to remove when we update inside the function
}
if (lifecycle::is_present(value)) {
lifecycle::deprecate_warn("1.0.0",
"set_param_xml(value)",
"set_param_xml(select_value)")
} else {
value <- select_value # to remove when we update inside the function
}
# Setting output file path
if (base::is.null(out_path)) {
out_path <- xml_file
}
# Checking output directory
if (!dir.exists(dirname(path = out_path))) {
stop("The output directory does not exist: ", dirname(path = out_path))
}
# Ckecking if file exists and overwriting right
if (base::file.exists(out_path) && !overwrite) {
warning(paste(
"The file already exists, ",
"set overwrite argument to TRUE or delete the file: ",
out_path
))
return(invisible(FALSE))
}
# For future version
# TODO: multiple files and multiple params list and values ...ids ...?
xml_doc <- xmldocument(xml_file)
# Checking if any of param_name can be in intervention
# nodes of 2 option choices (specific of "cut crop" in tec files)
check_choice_param(
xml_doc = xml_doc,
param_name = param_name,
stop = TRUE
)
# Setting parameters values in the xmlDoxument object
set_param_value(xml_doc,
param_name = param_name,
param_value = param_value,
parent_name = select,
parent_sel_attr = value,
...
)
# Saving
save_xml_doc(xml_doc, out_path)
delete(xml_doc)
# Output status
return(invisible(TRUE))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.