madeliri/shiny_form
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: correct data loading

Browse Source
This commit is contained in:
madeliri
2026-04-13 19:30:27 +03:00
parent 4c3d339361
commit 2f62a94afa
8 changed files with 97 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
modules/data_manipulations.R
View File

@@ -4,7 +4,8 @@
#' not 'empty').
#'
#' Needed for proper data validation.
check_for_empty_data = function(value_to_check) {
#' @export
is_this_empty_value = function(value_to_check) {
# for any 0-length
if (length(value_to_check) == 0) return(TRUE)
@@ -19,7 +20,14 @@ check_for_empty_data = function(value_to_check) {
if (inherits(value_to_check, "Date") && length(value_to_check) != 0) return(FALSE)
# for empty strings (stands before checking non-empty data for avoid mistakes)
if (value_to_check == "") return(TRUE)
if (is.character(value_to_check)) {
if (is.na(value_to_check)) return(TRUE)
if (value_to_check == "") return(TRUE)
}
FALSE
if (is.double(value_to_check)) {
if (is.na(value_to_check)) return(TRUE)
}
return(FALSE)
}

12
modules/data_validation.R
View File

@@ -3,7 +3,7 @@
init_val = function(scheme, ns) {
options(box.path = here::here())
box::use(modules/data_manipulations[check_for_empty_data])
box::use(modules/data_manipulations[is_this_empty_value])
iv <- shinyvalidate::InputValidator$new()
@@ -15,7 +15,7 @@ init_val = function(scheme, ns) {
# формируем список id - тип
inputs_simple_list <- scheme |>
dplyr::filter(!form_type %in% c("nested_forms","description", "description_header")) |>
dplyr::filter(!form_type %in% c("nested_forms", "description", "description_header")) |>
dplyr::distinct(form_id, form_type) |>
tibble::deframe()
@@ -39,7 +39,7 @@ init_val = function(scheme, ns) {
iv$add_rule(x_input_id, function(x) {
# exit if empty
if (check_for_empty_data(x)) {
if (is_this_empty_value(x)) {
return(NULL)
}
# хак для пропуска значений
@@ -64,7 +64,7 @@ init_val = function(scheme, ns) {
function(x) {
# exit if empty
if (check_for_empty_data(x)) {
if (is_this_empty_value(x)) {
return(NULL)
}
@@ -85,11 +85,11 @@ init_val = function(scheme, ns) {
}
}
if (form_type %in% c("select_multiple", "select_one")) {
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
iv$add_rule(x_input_id, function(x) {
if (length(x) == 1) {
if (check_for_empty_data(x)) return(NULL)
if (is_this_empty_value(x)) return(NULL)
}
# проверка на соответствие вариантов схеме ---------

2
modules/db.R
View File

@@ -185,7 +185,7 @@ write_df_to_db = function(
con
) {
scheme <- schm$get_schema(table_name)
scheme <- schm$get_scheme(table_name)
main_key_id <- schm$get_main_key_id
nested_key_id <- schm$get_key_id(table_name)

6
modules/global_options.R
View File

@@ -30,7 +30,8 @@ check_and_init_scheme = function() {
cli::cli_inform(c("*" = "проверка схемы..."))
files_to_watch <- c(
"modules/scheme_generator.R"
"modules/scheme_generator.R",
"modules/utils.R"
)
scheme_names <- enabled_schemas
@@ -59,8 +60,9 @@ check_and_init_scheme = function() {
# если данные были изменены проводим реинициализацию таблицы и схемы
if (!all(exist_hash == saved_hash)) {
cli::cli_inform(c(">" = "Данные схемы были изменены..."))
cli::cli_inform(c(">" = "Данные схем были изменены..."))
init_scheme(scheme_file)
} else {
cli::cli_alert_success("изменений нет")
}

10
modules/scheme_generator.R
View File

@@ -1,14 +1,14 @@
#' @export
scheme_R6 <- R6::R6Class(
"schemes_f",
"schemes_generator",
public = list(
initialize = function(scheme_file_path = NULL) {
private$scheme_file_path <- scheme_file_path
# make list of schemas
# make list of schemes
private$schemes_list <- list()
private$schemes_list[["main"]] <- private$load_scheme_from_xlsx("main")
@@ -67,11 +67,11 @@ scheme_R6 <- R6::R6Class(
# возврат схемы ------------------------------------
## полностью -------
get_schema = function(table_name) {
get_scheme = function(table_name) {
private$schemes_list[[table_name]]
},
## с полями имеющие значение -------
get_schema_with_values_forms = function(table_name) {
get_scheme_with_values_forms = function(table_name) {
private$schemes_list[[table_name]] |>
dplyr::filter(!form_type %in% private$excluded_types)
},
@@ -144,7 +144,7 @@ scheme_R6 <- R6::R6Class(
# schm$get_forms_ids("main")
# schm$get_all_ids("main")
# schm$get_schema("main")
# schm$get_scheme("main")
# schm$get_id_type_list("allergo_anamnesis")

78
modules/utils.R
View File

@@ -264,6 +264,14 @@ update_forms_with_data = function(
ns
) {
box::use(modules/data_manipulations[is_this_empty_value])
# print("-----------------")
# cli::cli_inform("form_id: {form_id} | form_type: {form_type}")
# print(value)
# print(typeof(value))
# print(is_this_empty_value(value))
filterd_line <- scheme |>
dplyr::filter(form_id == {{form_id}})
@@ -294,50 +302,58 @@ update_forms_with_data = function(
new_choices <- unique(c(old_choices, value))
new_choices <- new_choices[!is.na(new_choices)]
shiny::updateSelectizeInput(inputId = form_id, selected = value, choices = new_choices)
# shiny::updateSelectizeInput(inputId = form_id, selected = value)
}
# select_multiple
# check if value is not NA and split by delimetr
if (form_type == "select_multiple" && !is.na(value)) {
vars <- stringr::str_split_1(value, local_delimeter)
if (form_type == "select_multiple") {
if (is_this_empty_value(value)) {
shiny::updateSelectizeInput(inputId = form_id, selected = as.character(0))
} else {
vars <- stringr::str_split_1(value, local_delimeter)
# update choices
old_choices <- filterd_line$choices
new_choices <- unique(c(old_choices, vars))
new_choices <- new_choices[!is.na(new_choices)]
shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
# shiny::updateSelectizeInput(inputId = form_id, selected = vars)
}
# in other case fill with `character(0)` to proper reseting form
if (form_type == "select_multiple" && is.na(value)) {
shiny::updateSelectizeInput(inputId = form_id, selected = character(0))
# update choices
old_choices <- filterd_line$choices
new_choices <- unique(c(old_choices, vars))
new_choices <- new_choices[!is.na(new_choices)]
shiny::updateSelectizeInput(inputId = form_id, selected = vars, choices = new_choices)
}
}
# radio buttons
if (form_type == "radio" && !is.na(value)) {
shiny::updateRadioButtons(inputId = form_id, selected = value)
}
if (form_type == "radio" && is.na(value)) {
shiny::updateRadioButtons(inputId = form_id, selected = character(0))
if (form_type == "radio") {
if (is_this_empty_value(value)) {
shiny::updateRadioButtons(inputId = form_id, selected = character(0))
} else {
# update choices
old_choices <- filterd_line$choices
new_choices <- unique(c(old_choices, value))
new_choices <- new_choices[!is.na(new_choices)]
shiny::updateRadioButtons(inputId = form_id, selected = value, choices = new_choices)
}
}
# checkboxes
if (form_type == "checkbox" && !is.na(value)) {
vars <- stringr::str_split_1(value, local_delimeter)
shiny::updateCheckboxGroupInput(inputId = form_id, selected = vars)
}
if (form_type == "checkbox" && is.na(value)) {
shiny::updateCheckboxGroupInput(inputId = form_id, selected = character(0))
if (form_type == "checkbox") {
if (is_this_empty_value(value)) {
shiny::updateCheckboxGroupInput(inputId = form_id, selected = character(0))
} else {
vars <- stringr::str_split_1(value, local_delimeter)
# update choices
old_choices <- filterd_line$choices
new_choices <- unique(c(old_choices, vars))
new_choices <- new_choices[!is.na(new_choices)]
shiny::updateCheckboxGroupInput(inputId = form_id, selected = vars, choices = new_choices)
}
}
# if (type == "inline_table") {
# message("EMPTY")
# }
}
#' @export
@@ -361,7 +377,7 @@ clean_forms = function(
form_id = x_id,
form_type = x_type,
value = get_empty_data(x_type),
scheme = schm$get_schema(table_name),
scheme = schm$get_scheme(table_name),
ns = ns
)
}