165 lines
5.3 KiB
R
165 lines
5.3 KiB
R
|
||
#' @export
|
||
scheme_R6 <- R6::R6Class(
|
||
"schemes_generator",
|
||
public = list(
|
||
|
||
initialize = function(scheme_file_path = NULL) {
|
||
|
||
private$scheme_file_path <- scheme_file_path
|
||
|
||
# make list of schemes
|
||
private$schemes_list <- list()
|
||
private$schemes_list[["main"]] <- private$load_scheme_from_xlsx("main")
|
||
|
||
# имена вложенных форм
|
||
private$nested_forms_names <- private$schemes_list[["main"]] |>
|
||
dplyr::filter(form_type == "nested_forms") |>
|
||
dplyr::distinct(form_id) |>
|
||
dplyr::pull(form_id)
|
||
|
||
# проверка на не пересечение с зарезервированными именами
|
||
check <- private$reserved_table_names %in% private$nested_forms_names
|
||
if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check])))
|
||
|
||
purrr::walk(
|
||
.x = purrr::set_names(private$nested_forms_names),
|
||
.f = \(nested_form_id) {
|
||
|
||
nested_form_scheme_sheet_name <- private$schemes_list[["main"]] |>
|
||
dplyr::filter(form_id == {{nested_form_id}}) |>
|
||
dplyr::distinct(form_id, .keep_all = TRUE) |>
|
||
dplyr::pull(choices)
|
||
|
||
# загрузка схемы для данной вложенной формы
|
||
private$schemes_list[[nested_form_id]] <<- private$load_scheme_from_xlsx(nested_form_scheme_sheet_name)
|
||
}
|
||
)
|
||
|
||
# extract main key
|
||
private$main_key_id <- self$get_key_id("main")
|
||
|
||
box::use(modules/utils)
|
||
private$bslib_rendered_ui <- bslib::navset_card_underline(
|
||
id = "main",
|
||
!!!utils$make_list_of_pages(private$schemes_list[["main"]], private$main_key_id),
|
||
header = NULL,
|
||
height = NULL
|
||
)
|
||
},
|
||
|
||
get_all_ids = function(table_name) {
|
||
|
||
private$schemes_list[[table_name]] |>
|
||
dplyr::filter(!form_type %in% private$excluded_types) |>
|
||
dplyr::distinct(form_id) |>
|
||
dplyr::pull(form_id)
|
||
|
||
},
|
||
get_key_id = function(table_name) {
|
||
|
||
ids <- self$get_all_ids(table_name)
|
||
ids[1]
|
||
|
||
},
|
||
get_forms_ids = function(table_name) {
|
||
|
||
ids <- self$get_all_ids(table_name)
|
||
ids[-1]
|
||
|
||
},
|
||
|
||
# возврат схемы ------------------------------------
|
||
## полностью -------
|
||
get_scheme = function(table_name) {
|
||
private$schemes_list[[table_name]]
|
||
},
|
||
## с полями имеющие значение -------
|
||
get_scheme_with_values_forms = function(table_name) {
|
||
private$schemes_list[[table_name]] |>
|
||
dplyr::filter(!form_type %in% private$excluded_types)
|
||
},
|
||
|
||
get_id_type_list = function(table_name) {
|
||
|
||
# wo main key
|
||
this_key_id <- self$get_key_id(table_name)
|
||
|
||
private$schemes_list[[table_name]] |>
|
||
dplyr::filter(!form_type %in% private$excluded_types) |>
|
||
dplyr::filter(form_id != {{this_key_id}}) |>
|
||
dplyr::distinct(form_id, form_type) |>
|
||
tibble::deframe()
|
||
}
|
||
),
|
||
active = list(
|
||
get_main_key_id = function() {
|
||
private$main_key_id
|
||
},
|
||
all_tables_names = function() {
|
||
c("main", private$nested_forms_names)
|
||
},
|
||
nested_tables_names = function() {
|
||
private$nested_forms_names
|
||
},
|
||
get_main_form_ui = function() {
|
||
private$bslib_rendered_ui
|
||
}
|
||
),
|
||
private = list(
|
||
scheme_file_path = NA,
|
||
schemes_list = NULL,
|
||
main_key_id = NA,
|
||
nested_forms_names = NA,
|
||
bslib_rendered_ui = NA,
|
||
excluded_types = c("nested_forms", "description", "description_header"),
|
||
reserved_table_names = c("meta", "log", "main"),
|
||
|
||
load_scheme_from_xlsx = function(sheet_name) {
|
||
|
||
colnames <- switch(sheet_name,
|
||
"main" = c("part", "subgroup", "form_id", "form_label", "form_type"),
|
||
c("subgroup", "form_id", "form_label", "form_type")
|
||
)
|
||
|
||
table <- readxl::read_xlsx(private$scheme_file_path, sheet = sheet_name) |>
|
||
# fill NA down
|
||
tidyr::fill(all_of(colnames), .direction = "down") |>
|
||
dplyr::group_by(form_id) |>
|
||
tidyr::fill(c(condition, required), .direction = "down") |>
|
||
dplyr::ungroup()
|
||
|
||
duplicate_ids <- table |>
|
||
dplyr::mutate(rleid = dplyr::consecutive_id(form_id)) |>
|
||
dplyr::distinct(form_id, rleid) |>
|
||
dplyr::count(form_id) |>
|
||
dplyr::filter(n > 1) |>
|
||
dplyr::pull(form_id)
|
||
|
||
if (length(duplicate_ids) > 0) {
|
||
cli::cli_abort(c("В схеме '{private$scheme_file_path}' для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids)))
|
||
}
|
||
|
||
# проверка на корректные id
|
||
input_names_with_dash <- unique(table$form_id)[grepl("-", unique(table$form_id))]
|
||
if (length(input_names_with_dash) > 0) {
|
||
cli::cli_abort(c("В схеме '{private$scheme_file_path}' в id форм содержатся `-`, может привести к некорректной последующей работой с базой данных", paste("-", input_names_with_dash)))
|
||
}
|
||
|
||
table
|
||
}
|
||
)
|
||
)
|
||
|
||
# object.size(schm)
|
||
# schm$get_key_id("main")
|
||
# schm$get_forms_ids("main")
|
||
# schm$get_all_ids("main")
|
||
|
||
# schm$get_scheme("main")
|
||
|
||
# schm$get_id_type_list("allergo_anamnesis")
|
||
|
||
# # active
|
||
# schm$get_main_key_id
|
||
# schm$all_tables_names |