refactor: вся основа кода в отдельной папке

R/modules/data_validation.R

@@ -0,0 +1,117 @@
+options(box.path = here::here())
+box::use(R/modules/data_manipulations[is_this_empty_value])
+
+#' @export
+init_val = function(scheme, ns) {
+
+  iv <- shinyvalidate::InputValidator$new()
+
+  # если передана функция с пространством имен, то происходит модификация id
+  if (!missing(ns)) {
+    scheme <- scheme |>
+      dplyr::mutate(form_id = ns(form_id))
+  }
+
+  # формируем список id - тип
+  inputs_simple_list <- scheme |>
+    dplyr::filter(!form_type %in% c("nested_forms", "description", "description_header")) |>
+    dplyr::distinct(form_id, form_type) |>
+    tibble::deframe()
+
+  # add rules to all inputs
+  purrr::walk(
+    .x = names(inputs_simple_list),
+    .f = \(x_input_id) {
+
+      form_type <- inputs_simple_list[[x_input_id]]
+
+      choices <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
+        dplyr::pull(choices)
+
+      val_required <- dplyr::filter(scheme, form_id == {{x_input_id}}) |>
+        dplyr::distinct(required) |>
+        dplyr::pull(required)
+
+      # for `number` type: if in `choices` column has values then parsing them to range validation
+      # value `0; 250` -> transform to rule validation value from 0 to 250
+      if (form_type == "number") {
+
+        iv$add_rule(x_input_id, val_is_a_number)
+
+        # проверка на соответствие диапазону значений
+        if (!is.na(choices)) {
+          # разделить на несколько елементов
+          ranges <- as.integer(stringr::str_split_1(choices, "; "))
+
+          # проверка на кол-во значений
+          if (length(ranges) > 3) {
+            warning("Количество переданных элементов'", x_input_id, "' > 2")
+          } else {
+            iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
+          }
+        }
+      }
+
+      if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
+        iv$add_rule(x_input_id, val_choice_within_a_dict, choices = choices)
+      }
+
+      # if in `required` column value is `1` apply standart validation
+      if (!is.na(val_required) && val_required == 1) {
+        iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
+      }
+    }
+  )
+  iv
+}
+
+# работа с числовыми значениями ------------------
+## проверка является ли значение числом ----------
+val_is_a_number = function(x) {
+
+  # exit if empty
+  if (is_this_empty_value(x)) return(NULL)
+
+  # хак для пропуска значений
+  if (x == "NA") return(NULL)
+
+  # check for numeric
+  # if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
+  if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
+
+}
+
+## находится ли число в заданном диапазоне значений -------
+val_number_within_a_range = function(x, ranges) {
+  
+  # exit if empty
+  if (is_this_empty_value(x)) return(NULL)
+  if (x == "NA") return(NULL)
+
+  # замена разделителя десятичных цифр
+  x <- stringr::str_replace(x, ",", ".")
+
+  # check for currect value
+  if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
+    NULL
+  } else {
+    glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
+  }
+}
+
+# списки ---------------------------------------------------------
+## являются ли выбранные значения допустимы (согласно файлу схемы)
+val_choice_within_a_dict = function(x, choices) {
+
+  if (length(x) == 1) {
+    if (is_this_empty_value(x)) return(NULL)
+  }
+
+  # проверка на соответствие вариантов схеме ---------
+  compare_to_dict <- (x %in% choices)
+  if (!all(compare_to_dict)) {
+
+    text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
+    glue::glue("варианты, не соответствующие схеме: {text}")
+  }
+}