From 6192af2453f4800ada05b0e786aebf3ceb179634 Mon Sep 17 00:00:00 2001 From: Anna Krystalli Date: Wed, 18 Dec 2024 10:40:33 +0200 Subject: [PATCH] Do not allow target_keys of length more than 1 in v4.0.1 and above when creating programmatically. Rsolves #89 --- R/create_target_metadata_item.R | 34 ++++++--- man/create_target_metadata_item.Rd | 15 ++-- .../_snaps/create_target_metadata_item.md | 11 +++ .../test-create_target_metadata_item.R | 69 ++++++++++++++++++- 4 files changed, 112 insertions(+), 17 deletions(-) diff --git a/R/create_target_metadata_item.R b/R/create_target_metadata_item.R index 9e2e290..11a9719 100644 --- a/R/create_target_metadata_item.R +++ b/R/create_target_metadata_item.R @@ -11,13 +11,14 @@ #' @param target_name character string. A longer human readable target description #' that could be used, for example, as a visualisation axis label. #' @param target_units character string. Unit of observation of the target. -#' @param target_keys named list or `NULL`. Should be `NULL`, in the case -#' where the target is not specified as a task_id but is specified solely through -#' the `target_id` argument. Otherwise, should be a named list of one or more -#' character strings. The name of each element should match a task_id variable -#' within the same model_tasks object. Each element should be of length 1. -#' Each value, or the combination of values if multiple keys are specified, -#' define a single target value. +#' @param target_keys named list or `NULL`. The `target_keys` value defines a +#' single target. +#' Should be `NULL`, in the case where the target is not specified as a task_id +#' but is specified solely through the `target_id` argument. +#' Otherwise, should be a named list containing a single character string element +#' The name of the element should match a `task_id` +#' variable name within the same `model_tasks` object and the value match a +#' single value of that variable. #' @param description character string (optional). An optional verbose description #' of the target that might include information such as definitions of a 'rate' or similar. #' @param target_type character string. Target statistical data type. Consult the @@ -117,7 +118,7 @@ create_target_metadata_item <- function(target_id, target_name, target_units, } ) - check_target_keys(target_keys, call = call) + check_target_keys(target_keys, schema_version, call = call) structure(mget(property_names), class = c("target_metadata_item", "list"), @@ -127,7 +128,8 @@ create_target_metadata_item <- function(target_id, target_name, target_units, ) } -check_target_keys <- function(target_keys, call = rlang::caller_env()) { +check_target_keys <- function(target_keys, schema_version, + call = rlang::caller_env()) { if (is.null(target_keys)) { return() } @@ -149,6 +151,20 @@ check_target_keys <- function(target_keys, call = rlang::caller_env()) { call = call ) } + is_gte_v4_0_1 <- hubUtils::version_gte( + "v4.0.1", + schema_version = schema_version + ) + target_key_n <- length(target_keys) + if (is_gte_v4_0_1 && target_key_n > 1L) { + cli::cli_abort( + c( + "!" = "{.arg target_keys} must be a named {.cls list} of + length {.val {1L}} not {.val {target_key_n}}." + ), + call = call + ) + } purrr::walk2( target_keys, diff --git a/man/create_target_metadata_item.Rd b/man/create_target_metadata_item.Rd index 97e2387..b464f4c 100644 --- a/man/create_target_metadata_item.Rd +++ b/man/create_target_metadata_item.Rd @@ -26,13 +26,14 @@ that could be used, for example, as a visualisation axis label.} \item{target_units}{character string. Unit of observation of the target.} -\item{target_keys}{named list or \code{NULL}. Should be \code{NULL}, in the case -where the target is not specified as a task_id but is specified solely through -the \code{target_id} argument. Otherwise, should be a named list of one or more -character strings. The name of each element should match a task_id variable -within the same model_tasks object. Each element should be of length 1. -Each value, or the combination of values if multiple keys are specified, -define a single target value.} +\item{target_keys}{named list or \code{NULL}. The \code{target_keys} value defines a +single target. +Should be \code{NULL}, in the case where the target is not specified as a task_id +but is specified solely through the \code{target_id} argument. +Otherwise, should be a named list containing a single character string element +The name of the element should match a \code{task_id} +variable name within the same \code{model_tasks} object and the value match a +single value of that variable.} \item{description}{character string (optional). An optional verbose description of the target that might include information such as definitions of a 'rate' or similar.} diff --git a/tests/testthat/_snaps/create_target_metadata_item.md b/tests/testthat/_snaps/create_target_metadata_item.md index 2cae71e..574c957 100644 --- a/tests/testthat/_snaps/create_target_metadata_item.md +++ b/tests/testthat/_snaps/create_target_metadata_item.md @@ -162,3 +162,14 @@ - "https://raw.githubusercontent.com/hubverse-org/schemas/main/v3.0.1/tasks-schema.json" + "https://raw.githubusercontent.com/hubverse-org/schemas/main/v4.0.0/tasks-schema.json" +# Target_keys of length more than 1 are not allowed post v4.0.1 + + Code + create_target_metadata_item(target_id = "flu inc hosp", target_name = "Weekly incident influenza hospitalizations", + target_units = "rate per 100,000 population", target_keys = list(target = "flu", + target_metric = "inc hosp"), target_type = "discrete", is_step_ahead = TRUE, + time_unit = "week") + Condition + Error in `create_target_metadata_item()`: + ! `target_keys` must be a named of length 1 not 2. + diff --git a/tests/testthat/test-create_target_metadata_item.R b/tests/testthat/test-create_target_metadata_item.R index 8231cbb..777e086 100644 --- a/tests/testthat/test-create_target_metadata_item.R +++ b/tests/testthat/test-create_target_metadata_item.R @@ -131,7 +131,7 @@ test_that("schema version option works for create_target_metadata_item", { withr::with_options( list( hubAdmin.schema_version = "v3.0.1", - hubAmin.branch = "main" + hubAdmin.branch = "main" ), { opt_version <- create_target_metadata_item( @@ -148,3 +148,70 @@ test_that("schema version option works for create_target_metadata_item", { expect_equal(arg_version, opt_version) expect_snapshot(waldo::compare(opt_version, version_default)) }) + +test_that("Target_keys of length more than 1 are not allowed post v4.0.1", { + skip_if_offline() + withr::with_options( + list( + hubAdmin.schema_version = "v4.0.1", + # TDOD: remove branch argument when v4.0.1 is released. + hubAdmin.branch = "ak/v4.0.1/restrict-target-key-value-pair-n/117" + ), + { + # One target_key is allowed in v4.0.1 and later versions. + target_keys_n1 <- create_target_metadata_item( + target_id = "inc hosp", + target_name = "Weekly incident influenza hospitalizations", + target_units = "rate per 100,000 population", + target_keys = list(target = "inc hosp"), + target_type = "discrete", + is_step_ahead = TRUE, + time_unit = "week", + branch = "ak/v4.0.1/restrict-target-key-value-pair-n/117" + ) + expect_s3_class(target_keys_n1, "target_metadata_item") + expect_length(target_keys_n1$target_keys, 1L) + + # More than one target_key is NOT allowed in v4.0.1 and later versions + # and throws error. + expect_snapshot( + create_target_metadata_item( + target_id = "flu inc hosp", + target_name = "Weekly incident influenza hospitalizations", + target_units = "rate per 100,000 population", + target_keys = list( + target = "flu", + target_metric = "inc hosp" + ), + target_type = "discrete", + is_step_ahead = TRUE, + time_unit = "week" + ), + error = TRUE + ) + } + ) + # More than 1 target_keys still allowed in earlier versions to conform to + # schema. + withr::with_options( + list( + hubAdmin.schema_version = "v4.0.0" + ), + { + target_keys_n2 <- create_target_metadata_item( + target_id = "flu inc hosp", + target_name = "Weekly incident influenza hospitalizations", + target_units = "rate per 100,000 population", + target_keys = list( + target = "flu", + target_metric = "inc hosp" + ), + target_type = "discrete", + is_step_ahead = TRUE, + time_unit = "week" + ) + expect_s3_class(target_keys_n2, "target_metadata_item") + expect_length(target_keys_n2$target_keys, 2L) + } + ) +})