diff --git a/DESCRIPTION b/DESCRIPTION index 4e048b0..1ce94db 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,7 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true Depends: R (>= 4.0.0) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Imports: arrow, cli, diff --git a/NEWS.md b/NEWS.md index 9075e19..7f9c76b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,8 @@ - fix bug in `check_df_values_required()` dealing with model task containing multiple output types - fix sample pairing information test +- adapt to hubValidations v2.0 (past version should continue to work as + expected) - minor fixes: read partition of one file, improve output error message of invalid or missing variables combination, fix `n_decimal` comparison diff --git a/R/generate_validation_plots.R b/R/generate_validation_plots.R index 450c671..c56c124 100644 --- a/R/generate_validation_plots.R +++ b/R/generate_validation_plots.R @@ -91,7 +91,7 @@ generate_validation_plots <- function(path_proj, target_data = NULL, message("No output type quantiles for incident/cumulative case, death", "hospitalization or infection found in the file - no plot", "generated.") - return(NULL) + NULL } } diff --git a/R/plot_utils.R b/R/plot_utils.R index e48cae0..8d23361 100644 --- a/R/plot_utils.R +++ b/R/plot_utils.R @@ -245,7 +245,7 @@ plot_projections <- function(data, st, projection_date, legend_rows = 1, plot <- plot + scale_y_funct(paste0("Weekly Cumulative Outcomes, ", st)) } - return(plot) + plot } #' Generate PDF of state plots diff --git a/R/pull_gs_data.R b/R/pull_gs_data.R index 3e9c407..f4df448 100644 --- a/R/pull_gs_data.R +++ b/R/pull_gs_data.R @@ -123,6 +123,6 @@ pull_gs_data <- function(signals = c("deaths_cumulative_num", lst_df <- purrr::map(signals, std_covidcast_signal, limit_date, vect_week_date) |> setNames(signals) - return(lst_df) + lst_df } # nocov end diff --git a/R/read_files.R b/R/read_files.R index 427bbe2..7e6d318 100644 --- a/R/read_files.R +++ b/R/read_files.R @@ -45,5 +45,5 @@ read_files <- function(path, na_string = c("", "NA", "NaN"), sep = ",") { } df <- factor_columns(df) df <- location_fips_format(df) - return(df) + df } diff --git a/R/utils.R b/R/utils.R index 6489a3f..252a18d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -130,7 +130,7 @@ make_schema <- function(js_def, js_def_round, round_id, path = NULL, } } schema <- schema[schema$names %in% exp_col] - return(schema) + schema } # Load partitioned files using Arrow @@ -153,7 +153,7 @@ load_partition_arrow <- function(path, partition, schema = NULL) { hive_style = FALSE) |> dplyr::collect() } df <- factor_columns(df) |> location_fips_format() - return(df) + df } # Function from ?is.integer() function documentation @@ -162,7 +162,7 @@ is_wholenumber <- function(x, tol = .Machine$double.eps^0.5) { if (length(unique(na.omit(x))) > 0) { abs(x - round(x)) < tol } else { - return(FALSE) + FALSE } } @@ -236,7 +236,7 @@ merge_sample_id <- function(df, req_colnames, merge_sample_col, js_def0, js_def, } else { df <- df_sample } - return(list(df = df, msg = pair_info)) + list(df = df, msg = pair_info) } # Function for pairing information @@ -292,7 +292,7 @@ verbose_pairing <- function(df_sample, m_task, checks, or_pair, n_sample, paste(n_sample, collapse = ", ")) pair_inf <- list(message = pair_inf, n_sample = n_sample, run_group = run_group, sto_group = sto_group) - return(pair_inf) + pair_inf } # extract pairing information @@ -354,7 +354,7 @@ paired_info <- function(df, rm_col = NULL, tasks_list = NULL, unlist() |> unique() } - return(paired_info) + paired_info } @@ -408,6 +408,6 @@ filter_df <- function(df, task_id, exclusion = NULL, required = FALSE, } })) attr(df_test, "filter") <- text_var - return(df_test) + df_test } # nocov end diff --git a/R/validate_part_file.R b/R/validate_part_file.R index cd64e67..f553a34 100644 --- a/R/validate_part_file.R +++ b/R/validate_part_file.R @@ -35,6 +35,8 @@ validate_part_file <- function(hub_path, folder_path, partition) { # Prerequisite checks <- new_hub_validations() full_path <- paste0(hub_path, "/model-output/", folder_path) + all_files <- dir(full_path, recursive = TRUE) + file_name <- unique(basename(all_files)) # file exists test <- file.exists(dir(full_path, recursive = TRUE, full.names = TRUE)) @@ -50,10 +52,6 @@ validate_part_file <- function(hub_path, folder_path, partition) { return(checks) } - # Prerequisite - all_files <- dir(full_path, recursive = TRUE) - file_name <- gsub("0\\.", "\\.", unique(basename(all_files))) - # Number of files checks$file_n <- capture_check_cnd(check = length(file_name) == 1, @@ -66,13 +64,11 @@ validate_part_file <- function(hub_path, folder_path, partition) { } # Prerequisite - file_meta <- parse_file_name(file_name) - round_id <- file_meta$round_id + round_id <- parse_file_name(file_name)$round_id # Round id is correct - checks$round_id_valid <- try_check(check_valid_round_id(round_id = round_id, - file_path = file_name, - hub_path = hub_path), - folder_path) + checks$round_id_valid <- + try_check(check_valid_round_id(round_id = round_id, file_path = folder_path, + hub_path = hub_path), folder_path) if (is_any_error(checks$round_id_valid)) { return(checks) } @@ -128,19 +124,26 @@ validate_part_file <- function(hub_path, folder_path, partition) { } # File name is correct - checks$file_name <- try_check(check_file_name(file_name), folder_path) + checks_file_name <- try_check(check_file_name(file_name), folder_path) + checks_file_name$where <- folder_path + checks$file_name <- checks_file_name # File format - checks$file_format <- try_check(check_file_format(file_path = file_name, + checks_file_format <- try_check(check_file_format(file_path = file_name, hub_path = hub_path, round_id = round_id), folder_path) + checks_file_format$where <- folder_path + checks$file_format <- checks_file_format # Associated metadata exists - checks$metadata_exists <- + file_name <- gsub("0\\.", "\\.", unique(basename(all_files))) + checks_metadata_exists <- try_check(check_submission_metadata_file_exists(hub_path = hub_path, file_path = file_name), folder_path) + checks_metadata_exists$where <- folder_path + checks$metadata_exists <- checks_metadata_exists checks } diff --git a/R/validate_submission.R b/R/validate_submission.R index fb36cee..079de73 100644 --- a/R/validate_submission.R +++ b/R/validate_submission.R @@ -25,7 +25,7 @@ run_all_validation <- function(df, path, js_def0, js_def, round_id, hub_path, if (!is.null(partition)) { file_path <- unique(basename(dir(path, recursive = TRUE))) } else { - file_path <- path + file_path <- basename(path) } # Merge sample ID column @@ -123,7 +123,7 @@ run_all_validation <- function(df, path, js_def0, js_def, round_id, hub_path, checks <- value_test(df, checks, file_path, n_decimal = n_decimal, pop = pop, obs = obs) - return(checks) + checks } @@ -260,6 +260,11 @@ validate_submission <- function(path, hub_path, js_def = NULL, # Select validation file(s) and print message -------- file_path <- file_path_info(path, hub_path, partition = partition, round_id = round_id, verbose = verbose) + if (!is.null(partition)) { + file_where <- unique(basename(file_path)) + } else { + file_where <- basename(file_path) + } # Read hub config JSON file ------ if (is.null(js_def)) js_def <- paste0(hub_path, "/hub-config/tasks.json") @@ -272,10 +277,10 @@ validate_submission <- function(path, hub_path, js_def = NULL, "round ids are: ", paste(unique(hubUtils::get_round_ids(js_def0)), collapse = ", ")) check$round_id <- - try_check(capture_check_cnd(check_round_id, file_path, + try_check(capture_check_cnd(check_round_id, file_where, msg_subject = "{.var round_id}", msg_attribute = "valid.", - etails = details_mess, error = TRUE)) + details = details_mess, error = TRUE)) if (is_any_error(check$round_id)) { return(check) } else { @@ -288,7 +293,7 @@ validate_submission <- function(path, hub_path, js_def = NULL, check_file_ext <- sub_file_ext %in% config_ext details_mess <- paste0("Extension(s) accepted: {.val ", config_ext, "}") check$file_extension <- - try_check(capture_check_cnd(check_file_ext, file_path, + try_check(capture_check_cnd(check_file_ext, file_where, msg_subject = "File(s) format extension", msg_attribute = "valid.", details = details_mess, error = TRUE)) @@ -317,7 +322,7 @@ validate_submission <- function(path, hub_path, js_def = NULL, details_mess <- "The column should be in a ISO date format {.val YYYY-MM-DD}" message <- "The column(s) containing date information" check$date_format <- - try_check(capture_check_cnd(check_test_format, file_path, + try_check(capture_check_cnd(check_test_format, file_where, msg_subject = message, msg_attribute = "in a valid format.", details = details_mess, error = TRUE)) diff --git a/R/value_test.R b/R/value_test.R index 27f9323..d583cf7 100644 --- a/R/value_test.R +++ b/R/value_test.R @@ -139,5 +139,5 @@ value_test <- function(df, checks, file_path, n_decimal = NULL, pop = NULL, msg_attribute = "than the population size.") } checks <- cumul_value_test(df, checks, obs, file_path) - return(checks) + checks }