From 625afbff49ac2b213b0c19d10866e53c9661cefd Mon Sep 17 00:00:00 2001 From: Patrice Lecharpentier Date: Tue, 16 Jul 2024 16:14:59 +0200 Subject: [PATCH] added management if parameters vector values ids for extracting or replacing specific values. --- R/get_param_xml.R | 4 + R/set_param_xml.R | 25 +++- man/get_param_xml.Rd | 4 + man/set_param_xml.Rd | 25 +++- tests/testthat/test-set_get_param_xml.R | 174 ++++++++++++++---------- 5 files changed, 154 insertions(+), 78 deletions(-) diff --git a/R/get_param_xml.R b/R/get_param_xml.R index 653738bc..66ca785e 100644 --- a/R/get_param_xml.R +++ b/R/get_param_xml.R @@ -15,6 +15,8 @@ #' (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 value_id Vector of ids of the parameters values to be retrieved +#' from the parameter values vector #' @param value `r lifecycle::badge("deprecated")` `value` is no #' longer supported, use `select_value` instead. #' @param ... Pass further arguments to `get_param_value()` @@ -48,6 +50,7 @@ get_param_xml <- function(file, param = NULL, select = NULL, select_value = NULL, + value_id = NULL, xml_file = lifecycle::deprecated(), param_name = lifecycle::deprecated(), value = lifecycle::deprecated(), @@ -97,6 +100,7 @@ get_param_xml <- function(file, param_name = param_name, parent_name = select, parent_sel_attr = value, + ids = value_id, ... ) xml_names <- lapply(xml_file, basename) %>% unlist() diff --git a/R/set_param_xml.R b/R/set_param_xml.R index 7c054218..9c3857f4 100644 --- a/R/set_param_xml.R +++ b/R/set_param_xml.R @@ -12,6 +12,8 @@ #' (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 value_id Vector of ids of the parameters values to be retrieved +#' from the parameter values vector #' @param overwrite Logical TRUE for overwriting the output file, #' FALSE otherwise (default) #' @param xml_file `r lifecycle::badge("deprecated")` `xml_file` is no @@ -71,14 +73,31 @@ #' 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 +#' values = 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") #' # ) #' +#' # For specific values of vector parameters +#' set_param_xml(sol_path, "HCCF", +#' select = "sol", +#' select_value = "solcanne", +#' values = c(46.8, 48.5, 50.1), +#' value_id = c(1,3,5), +#' overwrite = TRUE +#' ) +#' +#' # Getting changed values +#' # get_param_xml(sol_path, "HCCF", +#' # select = "sol", +#' # select_value = "solcanne", +#' # value_id = c(1,3,5) +#' # ) #' #' # Crop management file #' @@ -86,7 +105,7 @@ #' #' # Modifying irrigations parameters #' set_param_xml(tec_path, c("julapI_or_sum_upvt", "amount"), -#' param_value = list(200:215, 20:35), overwrite = TRUE +#' values = list(200:215, 20:35), overwrite = TRUE #' ) #' # Getting changed values #' # get_param_xml(tec_path, c("julapI_or_sum_upvt", "amount")) @@ -99,6 +118,7 @@ set_param_xml <- function(file, save_as = NULL, select = NULL, select_value = NULL, + value_id = NULL, overwrite = FALSE, xml_file = lifecycle::deprecated(), out_path = lifecycle::deprecated(), @@ -188,6 +208,7 @@ set_param_xml <- function(file, param_value = param_value, parent_name = select, parent_sel_attr = value, + ids = value_id, ... ) diff --git a/man/get_param_xml.Rd b/man/get_param_xml.Rd index 30af49ce..5ae99567 100644 --- a/man/get_param_xml.Rd +++ b/man/get_param_xml.Rd @@ -9,6 +9,7 @@ get_param_xml( param = NULL, select = NULL, select_value = NULL, + value_id = NULL, xml_file = lifecycle::deprecated(), param_name = lifecycle::deprecated(), value = lifecycle::deprecated(), @@ -28,6 +29,9 @@ function returns information for all parameters.} \item{select_value}{Vector of values used for select (see examples). Optional, should be provided only if select is provided.} +\item{value_id}{Vector of ids of the parameters values to be retrieved +from the parameter values vector} + \item{xml_file}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{xml_file} is no longer supported, use \code{file} instead.} diff --git a/man/set_param_xml.Rd b/man/set_param_xml.Rd index 189a75af..1dde2273 100644 --- a/man/set_param_xml.Rd +++ b/man/set_param_xml.Rd @@ -11,6 +11,7 @@ set_param_xml( save_as = NULL, select = NULL, select_value = NULL, + value_id = NULL, overwrite = FALSE, xml_file = lifecycle::deprecated(), out_path = lifecycle::deprecated(), @@ -36,6 +37,9 @@ Optional, if NULL \code{file} is overwritten.} \item{select_value}{Vector of values used for select (see examples). Optional, should be provided only if select is provided.} +\item{value_id}{Vector of ids of the parameters values to be retrieved +from the parameter values vector} + \item{overwrite}{Logical TRUE for overwriting the output file, FALSE otherwise (default)} @@ -107,14 +111,31 @@ set_param_xml(sol_path, c("argi", "norg"), list(100, 150), 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 + values = 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") # ) +# For specific values of vector parameters +set_param_xml(sol_path, "HCCF", + select = "sol", + select_value = "solcanne", + values = c(46.8, 48.5, 50.1), + value_id = c(1,3,5), + overwrite = TRUE + ) + +# Getting changed values +# get_param_xml(sol_path, "HCCF", +# select = "sol", +# select_value = "solcanne", +# value_id = c(1,3,5) +# ) # Crop management file @@ -122,7 +143,7 @@ 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 + values = list(200:215, 20:35), overwrite = TRUE ) # Getting changed values # get_param_xml(tec_path, c("julapI_or_sum_upvt", "amount")) diff --git a/tests/testthat/test-set_get_param_xml.R b/tests/testthat/test-set_get_param_xml.R index 1fd3cc05..c6ef5ec9 100644 --- a/tests/testthat/test-set_get_param_xml.R +++ b/tests/testthat/test-set_get_param_xml.R @@ -15,24 +15,25 @@ file.copy( file <- file.path(tempdir(), "file_plt.xml") tmp1 <- unlist(get_param_xml(file, - param = "stlevamf", - stics_version = stics_version + param = "stlevamf", + stics_version = stics_version )) codevar <- unlist(get_param_xml(file, - param = "codevar", - stics_version = stics_version + param = "codevar", + stics_version = stics_version )) tmp2 <- unlist(get_param_xml(file, - param = "stlevamf", - variety = codevar, stics_version = stics_version + param = "stlevamf", + variety = codevar, stics_version = stics_version )) variete <- unlist(get_param_xml(file, - param = "variete", - stics_version = stics_version + param = "variete", + stics_version = stics_version# ) + # path <- tempdir() )) tmp3 <- unlist(get_param_xml(file, - param = "stlevamf", - variety = variete, stics_version = stics_version + param = "stlevamf", + variety = variete, stics_version = stics_version )) test_that("variety argument can take NULL, integer or characters", { @@ -46,12 +47,12 @@ varieties <- get_param_xml(file, )$file_plt.xml$variete[1:1] tmp1 <- get_param_xml(file, - param = "stlevamf", - variety = varieties, - stics_version = stics_version + param = "stlevamf", + variety = varieties, + stics_version = stics_version )$file_plt.xml$stlevamf tmp2 <- get_param_xml(file, - stics_version = stics_version + stics_version = stics_version )$file_plt.xml$stlevamf[1:1] test_that("variety argument can be a vector of characters", { expect_equal(tmp1, tmp2) @@ -61,18 +62,18 @@ test_that("variety argument can be a vector of characters", { # (another parameter has a similar name : rapforme ...) tmp <- unlist(get_param_xml(file, - param = "forme", exact = TRUE, - stics_version = stics_version + param = "forme", exact = TRUE, + stics_version = stics_version )) set_param_xml(file, - param = "forme", - values = tmp + 1, - overwrite = TRUE + param = "forme", + values = tmp + 1, + overwrite = TRUE ) tmp2 <- unlist(get_param_xml(file, - param = "forme", exact = TRUE, - stics_version = stics_version + param = "forme", exact = TRUE, + stics_version = stics_version )) test_that("Set and get of a non-varietal parameter for a unique plant", { expect_equal(length(tmp), 1) @@ -81,96 +82,121 @@ test_that("Set and get of a non-varietal parameter for a unique plant", { # Get and modify the varietal parameter "stlevamf" for the simulated variety tmp <- unlist(get_param_xml(file, - param = "stlevamf", - stics_version = stics_version + param = "stlevamf", + stics_version = stics_version )) set_param_xml(file, - param = "stlevamf", - values = tmp + 1, - overwrite = TRUE + param = "stlevamf", + values = tmp + 1, + overwrite = TRUE ) tmp2 <- unlist(get_param_xml(file, - param = "stlevamf", - stics_version = stics_version + param = "stlevamf", + stics_version = stics_version )) test_that("Set and get of a varietal parameter for a unique plant for the simulated variety", { - expect_equal(tmp + 1, tmp2) -}) + expect_equal(tmp + 1, tmp2) + }) # Get and modify the varietal parameter "stlevamf" for a given variety tmp <- unlist(get_param_xml(file, - param = "stlevamf", variety = 1, - stics_version = stics_version + param = "stlevamf", variety = 1, + stics_version = stics_version )) set_param_xml(file, - param = "stlevamf", - values = as.numeric(tmp) + 1, - variety = 1, - overwrite = TRUE + param = "stlevamf", + values = as.numeric(tmp) + 1, + variety = 1, + overwrite = TRUE ) tmp2 <- unlist(get_param_xml(file, - workspace = path, param = "stlevamf", variety = 1, - stics_version = stics_version + workspace = path, param = "stlevamf", variety = 1, + stics_version = stics_version )) test_that("Set and get of a varietal parameter for a unique plant for a given variety", { - expect_equal(tmp + 1, tmp2) -}) + expect_equal(tmp + 1, tmp2) + }) -# Now let's work on intercrops ... -path <- file.path(file, - get_examples_path("txt", stics_version = stics_version), - "intercrop_pea_barley" -) -# Copy example to test in tempdir since the files will be modified by set_param -file.copy( - from = file.path(path, list.files(path)), to = tempdir(), - overwrite = TRUE -) -path <- tempdir() - # Get and modify the non-varietal parameter "forme" for the simulated variety tmp <- unlist(get_param_xml(file, - param = "forme", exact = TRUE, - stics_version = stics_version + param = "forme", exact = TRUE, + stics_version = stics_version )) -plant <- 2 + set_param_xml(file, - param = "forme", - values = tmp + 1, - plant_id = plant, - overwrite = TRUE + param = "forme", + values = tmp + 1, + overwrite = TRUE ) tmp2 <- unlist(get_param_xml(file, - param = "forme", exact = TRUE, - stics_version = stics_version + param = "forme", exact = TRUE, + stics_version = stics_version )) test_that("Set and get of a non-varietal parameter for an intercrop for the simulated variety", { - expect_equal(tmp + 1, tmp2) -}) + expect_equal(tmp + 1, tmp2) + }) # Get and modify the varietal parameter "stlevamf" for the simulated variety tmp <- unlist(get_param_xml(file, - param = "stlevamf", - stics_version = stics_version + param = "stlevamf", + stics_version = stics_version )) -plant <- 2 + set_param_xml(file, - param = "stlevamf", - values = tmp + 1, - plant_id = 2, - overwrite = TRUE + param = "stlevamf", + values = tmp + 1, + overwrite = TRUE ) + tmp2 <- unlist(get_param_xml(file, - param = "stlevamf", - stics_version = stics_version + param = "stlevamf", + stics_version = stics_version )) test_that("Set and get of a varietal parameter for an intercrop for the simulated variety", { - expect_equal(tmp + 1, tmp2) -}) + expect_equal(tmp + 1, tmp2) + }) + + + +# Get parameters values using value_id (i.e. id of values to be +# retrieved from parameter values vector) for the soil parameter "HCCF" +# for a specific soil +file <- file.path(tempdir(), "sols.xml") +tmp <- get_param_xml( + file = file, + param = "HCCF", + select = "sol", + select_value= "solcanne", + value_id = c(1,3,5) +) +tmp <- unlist(tmp) + + +set_param_xml(file, + param = "HCCF", + values = tmp + 1, + select = "sol", + select_value= "solcanne", + value_id = c(1,3,5), + overwrite = TRUE +) + +tmp2 <- unlist(get_param_xml(file, + param = "HCCF", + select = "sol", + select_value= "solcanne", + value_id = c(1,3,5)) +) + +test_that("Set and get of a varietal parameter for an intercrop + for the simulated variety", { + expect_equal(tmp + 1, tmp2) + }) +