250 lines
8.3 KiB
R
250 lines
8.3 KiB
R
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}")
|
||
}
|
||
}
|
||
|
||
# ЭКСПОРТ ДАННЫХ ДЛЯ ВАЛИДАЦИИ
|
||
#' @export
|
||
validate_value_for_form <- function(data_to_check, form_type, choices, val_required) {
|
||
|
||
res <- NULL
|
||
# 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") {
|
||
|
||
res <- val_is_a_number(data_to_check)
|
||
if(!is.null(res)) return(res)
|
||
|
||
# проверка на соответствие диапазону значений
|
||
if (!is.na(choices)) {
|
||
|
||
# разделить на несколько елементов
|
||
ranges <- as.integer(stringr::str_split_1(choices, "; "))
|
||
|
||
# проверка на кол-во значений
|
||
if (length(ranges) > 3) {
|
||
warning("Количество переданных элементов'", x_input_id, "' > 2")
|
||
} else {
|
||
|
||
res <- val_number_within_a_range(data_to_check, ranges = ranges)
|
||
if (!is.null(res)) return(res)
|
||
|
||
}
|
||
}
|
||
}
|
||
|
||
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
|
||
|
||
if (!is_this_empty_value(data_to_check)) {
|
||
split_data <- stringr::str_split_1(data_to_check, "; ")
|
||
} else {
|
||
split_data <- NA
|
||
}
|
||
|
||
res <- val_choice_within_a_dict(split_data, choices = choices)
|
||
if(!is.null(res)) return(res)
|
||
}
|
||
|
||
# if in `required` column value is `1` apply standart validation
|
||
if (!is.na(val_required) && val_required == 1) {
|
||
|
||
if (is_this_empty_value(data_to_check)) {
|
||
|
||
res <- "Необходимо заполнить."
|
||
if(!is.null(res)) return(res)
|
||
|
||
}
|
||
|
||
}
|
||
|
||
if(is.null(res)) return(NA)
|
||
}
|
||
|
||
#' @export
|
||
get_table_with_data_validation_info <- function(schm, con) {
|
||
|
||
# итерациям по всем таблицам
|
||
purrr::map(
|
||
purrr::set_names(schm$all_tables_names),
|
||
.f = \(table_name) {
|
||
|
||
scheme <- schm$get_scheme(table_name)
|
||
data <- DBI::dbReadTable(con, table_name)
|
||
|
||
inputs_simple_list <- schm$get_id_type_list(table_name)
|
||
|
||
main_key <- schm$get_main_key_id
|
||
key <- schm$get_key_id(table_name)
|
||
|
||
# итерация по всем form_id в текущей таблице
|
||
ff <- purrr::map2(
|
||
.x = names(inputs_simple_list),
|
||
.y = unname(inputs_simple_list),
|
||
.f = \(x_input_id, y_form_type) {
|
||
|
||
this_id_scheme <- dplyr::filter(scheme, form_id == {{x_input_id}})
|
||
|
||
choices <- this_id_scheme$choices
|
||
val_required <- unique(this_id_scheme$required)
|
||
|
||
# extract data
|
||
data_to_check <- data[[x_input_id]]
|
||
main_keys <- data[[main_key]]
|
||
keys <- data[[key]]
|
||
iter <- purrr::set_names(data_to_check, keys)
|
||
|
||
# cli::cli_inform("~ input_id: {x_input_id} | type: {form_type} | value: {data_to_check}")
|
||
validation_info <- purrr::map(iter, validate_value_for_form, y_form_type, choices, val_required)
|
||
|
||
df_with_result_and_validation_for_id <- tibble::enframe(validation_info, name = key, value = "value") |>
|
||
tidyr::unnest(cols = c(value))
|
||
|
||
# если главный ключ и ключ для таблицы не одно и тоже, добавление главного ключа в таблицу
|
||
if (main_key != key) {
|
||
df_with_result_and_validation_for_id[main_key] <- main_keys
|
||
}
|
||
|
||
df_with_result_and_validation_for_id |>
|
||
dplyr::mutate(form_id = x_input_id)
|
||
|
||
}) |>
|
||
purrr::list_rbind()
|
||
|
||
ff |>
|
||
dplyr::distinct() |>
|
||
dplyr::filter(!is.na(value)) |>
|
||
# данные схемы для 'читабельности информации'
|
||
dplyr::left_join(
|
||
y = scheme |> dplyr::distinct(form_id, form_label) |> dplyr::mutate(nr = dplyr::row_number()),
|
||
by = dplyr::join_by(form_id),
|
||
) |>
|
||
# сортировка (main_key, затем id формы - по порядку в схеме)
|
||
dplyr::arrange(!!rlang::sym(main_key), !!rlang::sym(main_key), nr) |>
|
||
dplyr::select(
|
||
!!rlang::sym(main_key), !!rlang::sym(main_key),
|
||
form_id,
|
||
form_label,
|
||
value
|
||
)
|
||
|
||
}
|
||
)
|
||
|
||
}
|
||
|