Update code for hubValidations v2.0

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,

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
 

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
   }
 
 }

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

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

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
 }

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

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
 }

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))

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
 }