Fix required value

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
 

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 {