116 lines
4.1 KiB
R
116 lines
4.1 KiB
R
options(box.path = here::here())
|
||
box::use(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}")
|
||
}
|
||
} |