diff --git a/NEWS.md b/NEWS.md index 15c8429..27579d0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# SMHvalidation 1.1.0 (in development) +# SMHvalidation 1.1.0 - add `store_msg_val()` function to store `validate_submission()` function output in a character vector with a slightly different format (#39) @@ -8,6 +8,7 @@ compound id check) on output of the function (#44) - fix message output style by removing unnecessary new line and output an error if a value is incorrect instead of failure (#46) +- fix required value test (#48) # SMHvalidation 1.0.0 diff --git a/R/test_req_value.R b/R/test_req_value.R index 560d4b5..7f736a4 100644 --- a/R/test_req_value.R +++ b/R/test_req_value.R @@ -138,30 +138,39 @@ check_df_values_required <- function(test_df, model_task, file_path) { .data[["output_type"]] %in% names(outtype_df), .data[["output_type_id"]] %in% unlist(outtype_df)) |> distinct() - opt_targ <- - lapply(seq_along(opt_targ), - function(y) { - vect <- opt_targ[[y]][opt_targ[[y]] %in% - unique(test[, names(opt_targ[y])])] - if (length(vect) == 0) vect <- NULL - vect - }) |> - setNames(names(opt_targ)) - opt_df <- create_table(c(opt_targ, outtype_df), outtype_df) - if (nrow(opt_df) > 0) { - df_res_opt <- - dplyr::setdiff(opt_df, - dplyr::select(test, tidyr::all_of(c(names(opt_df), - "output_type", - "output_type_id")))) - if (any(grepl("cdf|quantile|pmf", df_res_opt$output_type)) & - nrow(df_res_opt) > 0) { - opt_err <- purrr::map(as.list(df_res_opt), unique) - opt_err <- paste(names(opt_err), purrr::map(opt_err, as.character), - sep = ": ", collapse = ";\n") + if (nrow(test) > 0) { + opt_targ <- + lapply(seq_along(opt_targ), + function(y) { + req_vect <- opt_targ[[y]][grepl("required", + names(opt_targ[[y]]))] + vect <- opt_targ[[y]][opt_targ[[y]] %in% + unique(test[, names(opt_targ[y])])] + vect <- unique(c(req_vect, vect)) + if (length(vect) == 0) vect <- NULL + vect + }) |> + setNames(names(opt_targ)) + opt_df <- create_table(c(opt_targ, outtype_df), outtype_df) + if (nrow(opt_df) > 0) { + df_res_opt <- + dplyr::setdiff(opt_df, + dplyr::select(test, + tidyr::all_of(c(names(opt_df), + "output_type", + "output_type_id")))) + if (any(grepl("cdf|quantile|pmf", df_res_opt$output_type)) & + nrow(df_res_opt) > 0) { + opt_err <- purrr::map(as.list(df_res_opt), unique) + opt_err <- paste(names(opt_err), purrr::map(opt_err, as.character), + sep = ": ", collapse = ";\n") + } } + } else { + opt_err <- NULL } + if (is.null(err) & is.null(opt_err)) { NULL } else {