diff --git a/NEWS.md b/NEWS.md index f621e28..930505e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ - fix bug in `check_df_values_required()` dealing with model task containing multiple output types. +- minor fixes: read partition of one file, improve output error message + of invalid or missing variables combination. # SMHvalidation 1.1.0 diff --git a/R/imports-hubValidations.R b/R/imports-hubValidations.R index c2c5c6e..672d644 100644 --- a/R/imports-hubValidations.R +++ b/R/imports-hubValidations.R @@ -82,6 +82,7 @@ check_tbl_values <- function(tbl, round_id, file_path, hub_path) { if (check) { details <- NULL } else { + valid_tbl <- dplyr::filter(valid_tbl, is.na(.data[["valid"]])) valid_tbl <- tibble::rowid_to_column(valid_tbl) error_summary <- summarise_invalid_values(valid_tbl, config_tasks, round_id) details <- error_summary$msg diff --git a/R/plot_utils.R b/R/plot_utils.R index 65412f3..e48cae0 100644 --- a/R/plot_utils.R +++ b/R/plot_utils.R @@ -94,8 +94,8 @@ print_table <- function(data, tab_title, metric = "prctdiff_gt", #"median", dplyr::select(tidyr::all_of(c("scenario_id", "state", "outcome", "ground truth")), value = tidyr::all_of(metric)) |> - tidyr::pivot_wider(names_from = .data[["scenario_id"]], - values_from = .data[["value"]]) + tidyr::pivot_wider(names_from = dplyr::matches("scenario_id"), + values_from = dplyr::matches("value")) # Cells to highlight nas <- na_cells(tab_data, sel_group) diff --git a/R/test_req_value.R b/R/test_req_value.R index 62ad39a..8b03dbb 100644 --- a/R/test_req_value.R +++ b/R/test_req_value.R @@ -115,7 +115,7 @@ check_df_values_required <- function(test_df, model_task, file_path) { req_targ <- NULL } else { req_targ <- purrr::map(x$task_ids, "required") - opt_targ <- purrr::map(x$task_ids, "optional") + opt_targ <- purrr::map(x$task_ids, unlist) } outtype_df <- extract_output_type(x) diff --git a/R/validate_submission.R b/R/validate_submission.R index 78061db..fb36cee 100644 --- a/R/validate_submission.R +++ b/R/validate_submission.R @@ -296,7 +296,7 @@ validate_submission <- function(path, hub_path, js_def = NULL, return(check) } else { # Read file - if (length(file_path) == 1) { + if (length(file_path) == 1 && is.null(partition)) { df <- read_files(paste0(hub_path, "/", path)) } else if (!is.null(partition)) { schema <- make_schema(js_def0, js_def, round_id, diff --git a/tests/testthat/test_visualization.R b/tests/testthat/test_visualization.R index 75b2b96..3aca3e4 100644 --- a/tests/testthat/test_visualization.R +++ b/tests/testthat/test_visualization.R @@ -26,6 +26,8 @@ test_that("Test visualization", { "target"))) df <- dplyr::filter(df0, .data[["output_type"]] == "sample") + if (!dir.exists(basename(path_f))) + dir.create(basename(path_f), recursive = TRUE) arrow::write_parquet(df, path_f) rm(df)