From 8285a60b44d0ab41c516cf8ecc3ef471982eb49e Mon Sep 17 00:00:00 2001 From: Anna Krystalli Date: Mon, 20 May 2024 11:41:38 +0300 Subject: [PATCH] handle v3 samples when checking required values --- R/check_tbl_values_required.R | 3 ++ inst/testhubs/samples/hub-config/tasks.json | 14 +++--- .../_snaps/check_tbl_values_required.md | 41 ++++++++++++++++++ .../testthat/test-check_tbl_values_required.R | 43 +++++++++++++++++++ 4 files changed, 95 insertions(+), 6 deletions(-) diff --git a/R/check_tbl_values_required.R b/R/check_tbl_values_required.R index 9a349721..73ae55f2 100644 --- a/R/check_tbl_values_required.R +++ b/R/check_tbl_values_required.R @@ -8,6 +8,9 @@ check_tbl_values_required <- function(tbl, round_id, file_path, hub_path) { tbl[["value"]] <- NULL config_tasks <- hubUtils::read_config(hub_path, "tasks") + if (hubUtils::is_v3_config(config_tasks)) { + tbl[tbl$output_type == "sample", "output_type_id"] <- NA + } req <- hubData::expand_model_out_val_grid( config_tasks, round_id = round_id, diff --git a/inst/testhubs/samples/hub-config/tasks.json b/inst/testhubs/samples/hub-config/tasks.json index f781e3f7..e0016688 100644 --- a/inst/testhubs/samples/hub-config/tasks.json +++ b/inst/testhubs/samples/hub-config/tasks.json @@ -32,10 +32,11 @@ "optional": [0, 1, 2, 3] }, "location": { - "required": null, - "optional": [ + "required": [ "US", - "01", + "01" + ], + "optional": [ "02", "04", "05" @@ -120,10 +121,11 @@ "optional": [0, 1, 2, 3] }, "location": { - "required": null, - "optional": [ + "required": [ "US", - "01", + "01" + ], + "optional": [ "02", "04", "05" diff --git a/tests/testthat/_snaps/check_tbl_values_required.md b/tests/testthat/_snaps/check_tbl_values_required.md index 6b584a10..89c819fd 100644 --- a/tests/testthat/_snaps/check_tbl_values_required.md +++ b/tests/testthat/_snaps/check_tbl_values_required.md @@ -130,3 +130,44 @@ $ use_cli_format: logi TRUE - attr(*, "class")= chr [1:5] "check_failure" "hub_check" "rlang_warning" "warning" ... +# check_tbl_values_required works with v3 spec samples + + Code + check_tbl_values_required(tbl = tbl, round_id = round_id, file_path = file_path, + hub_path = hub_path) + Output + + Message: + Required task ID/output type/output type ID combinations all present. + +--- + + Code + check_tbl_values_required(tbl = tbl, round_id = round_id, file_path = file_path, + hub_path = hub_path) + Output + + Warning: + Required task ID/output type/output type ID combinations missing. See `missing` attribute for details. + +--- + + Code + missing + Output + # A tibble: 21 x 7 + location reference_date horizon target_end_date target output_type + + 1 US 2022-10-22 0 2022-10-22 wk flu hosp rate~ pmf + 2 US 2022-10-22 0 2022-10-22 wk flu hosp rate~ pmf + 3 US 2022-10-22 0 2022-10-22 wk flu hosp rate~ pmf + 4 US 2022-10-22 0 2022-10-22 wk flu hosp rate~ pmf + 5 US 2022-10-22 1 2022-10-29 wk flu hosp rate~ pmf + 6 US 2022-10-22 1 2022-10-29 wk flu hosp rate~ pmf + 7 US 2022-10-22 1 2022-10-29 wk flu hosp rate~ pmf + 8 US 2022-10-22 1 2022-10-29 wk flu hosp rate~ pmf + 9 US 2022-10-22 2 2022-11-05 wk flu hosp rate~ pmf + 10 US 2022-10-22 2 2022-11-05 wk flu hosp rate~ pmf + # i 11 more rows + # i 1 more variable: output_type_id + diff --git a/tests/testthat/test-check_tbl_values_required.R b/tests/testthat/test-check_tbl_values_required.R index 3ce8083b..9d202465 100644 --- a/tests/testthat/test-check_tbl_values_required.R +++ b/tests/testthat/test-check_tbl_values_required.R @@ -181,3 +181,46 @@ test_that( ) } ) + +test_that("check_tbl_values_required works with v3 spec samples", { + hub_path <- system.file("testhubs/samples", package = "hubValidations") + file_path <- "Flusight-baseline/2022-10-22-Flusight-baseline.csv" + round_id <- "2022-10-22" + tbl <- read_model_out_file( + file_path = file_path, + hub_path = hub_path, + coerce_types = "chr" + ) + expect_snapshot( + check_tbl_values_required( + tbl = tbl, + round_id = round_id, + file_path = file_path, + hub_path = hub_path + ) + ) + # Remove US location to test missing required values identified and reported + # correctly. + tbl <- tbl[tbl$location != "US", ] + expect_snapshot( + check_tbl_values_required( + tbl = tbl, + round_id = round_id, + file_path = file_path, + hub_path = hub_path + ) + ) + missing <- check_tbl_values_required( + tbl = tbl, + round_id = round_id, + file_path = file_path, + hub_path = hub_path + )$missing + expect_snapshot(missing) + expect_equal( + unique(missing$output_type), + c("pmf", "sample", "mean", "median") + ) + expect_true(all(missing$location == "US")) + +})