From 7db49d0000dc80311e10a7a98c52f824119cae03 Mon Sep 17 00:00:00 2001 From: madeliri Date: Sun, 12 Apr 2026 19:46:26 +0300 Subject: [PATCH] =?UTF-8?q?fix:=20=D0=BB=D0=BE=D0=B3=D0=B8=D0=BD=D0=B3=20?= =?UTF-8?q?=D0=BE=D1=82=D0=BA=D0=BB=D1=8E=D1=87=D0=B5=D0=BD=20+=20=D1=84?= =?UTF-8?q?=D0=B8=D0=BA=D1=81=20=D0=B2=20=D1=84=D1=83=D0=BD=D0=BA=D1=86?= =?UTF-8?q?=D0=B8=D0=B8=20=D1=81=D1=80=D0=B0=D0=B2=D0=BD=D0=B5=D0=BD=D0=B8?= =?UTF-8?q?=D0=B8=20=D1=82=D0=B0=D0=B1=D0=BB=D0=B8=D1=86?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- app.R | 92 +++++++++++------------ modules/db.R | 1 + modules/global_options.R | 2 +- modules/scheme_generator.R | 146 +++++++++++++++++++++++++++++++++++++ 4 files changed, 192 insertions(+), 49 deletions(-) create mode 100644 modules/scheme_generator.R diff --git a/app.R b/app.R index f234cbe..de549ac 100644 --- a/app.R +++ b/app.R @@ -11,10 +11,6 @@ suppressPackageStartupMessages({ source("helpers/functions.R") - -# box::purge_cache() -# box::use(./helpers/db) - # SOURCE FILES ============================ box::purge_cache() box::use( @@ -22,7 +18,7 @@ box::use( modules/global_options, modules/db, modules/data_validation, - helpers/scheme_generator[scheme_R6] + modules/scheme_generator[scheme_R6] ) # SETTINGS ================================ @@ -1122,57 +1118,57 @@ server <- function(input, output, session) { } # КРАТКАЯ СВОДКА ПРО ЛОГГИНГ ------------------ - observe({ + # observe({ - output$display_log <- renderUI({ + # output$display_log <- renderUI({ - con <- db$make_db_connection("display_log") - on.exit(db$close_db_connection(con, "display_log"), add = TRUE) + # con <- db$make_db_connection("display_log") + # on.exit(db$close_db_connection(con, "display_log"), add = TRUE) - query <- if (!is.null(values$main_key)) { - sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key) - } else { - "SELECT * FROM log" - } + # query <- if (!is.null(values$main_key)) { + # sprintf("SELECT * FROM log WHERE key = '%s'", values$main_key) + # } else { + # "SELECT * FROM log" + # } - log_rows <- DBI::dbGetQuery(con, query) + # log_rows <- DBI::dbGetQuery(con, query) - if (nrow(log_rows) > 0) { + # if (nrow(log_rows) > 0) { - lines <- log_rows |> - mutate(date = as.POSIXct(date)) |> - mutate( - # date = date + lubridate::hours(3), # fix datetime - date_day = as.Date(date) - ) |> - mutate(cons_actions = dplyr::consecutive_id(action, user)) |> - mutate(n_actions = row_number(), .by = c(cons_actions, user, action, date_day)) |> - slice(which.max(n_actions), .by = c(user, action, date_day)) |> - mutate(string_to_print = sprintf( - "[%s %s]: %s - %s (%s)", - format(date, "%d.%m.%y"), - format(date, "%H:%M"), - user, - action, - n_actions - )) |> - pull(string_to_print) |> - paste(collapse = "
") + # lines <- log_rows |> + # mutate(date = as.POSIXct(date)) |> + # mutate( + # # date = date + lubridate::hours(3), # fix datetime + # date_day = as.Date(date) + # ) |> + # mutate(cons_actions = dplyr::consecutive_id(action, user)) |> + # mutate(n_actions = row_number(), .by = c(cons_actions, user, action, date_day)) |> + # slice(which.max(n_actions), .by = c(user, action, date_day)) |> + # mutate(string_to_print = sprintf( + # "[%s %s]: %s - %s (%s)", + # format(date, "%d.%m.%y"), + # format(date, "%H:%M"), + # user, + # action, + # n_actions + # )) |> + # pull(string_to_print) |> + # paste(collapse = "
") - } else { - lines <- "" - } + # } else { + # lines <- "" + # } - tagList( - paste0("ID: ", values$main_key), - br(), - p( - HTML(lines), - style = "font-size:10px;" - ) - ) - }) - }) + # tagList( + # paste0("ID: ", values$main_key), + # br(), + # p( + # HTML(lines), + # style = "font-size:10px;" + # ) + # ) + # }) + # }) } diff --git a/modules/db.R b/modules/db.R index 64c8955..dc42750 100644 --- a/modules/db.R +++ b/modules/db.R @@ -117,6 +117,7 @@ compare_existing_table_with_schema <- function( main_key <- schm$get_main_key_id key_id <- schm$get_key_id(table_name) forms_ids <- schm$get_forms_ids(table_name) + forms_id_type_list <- schm$get_id_type_list(table_name) if (table_name == "main") { all_ids_from_schema <- c(main_key, forms_ids) diff --git a/modules/global_options.R b/modules/global_options.R index 8492df8..94553f2 100644 --- a/modules/global_options.R +++ b/modules/global_options.R @@ -59,7 +59,7 @@ init_scheme <- function(scheme_file) { options(box.path = here::here()) box::use( modules/db, - helpers/scheme_generator[scheme_R6] + modules/scheme_generator[scheme_R6] ) con <- db$make_db_connection() diff --git a/modules/scheme_generator.R b/modules/scheme_generator.R new file mode 100644 index 0000000..965c607 --- /dev/null +++ b/modules/scheme_generator.R @@ -0,0 +1,146 @@ + +#' @export +scheme_R6 <- R6::R6Class( + "schemes_f", + public = list( + + initialize = function(scheme_file_path = NULL) { + + private$scheme_file_path <- scheme_file_path + + # make list of schemas + 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) + + 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$testest <- utils$make_list_of_pages(private$schemes_list[["main"]], private$main_key_id) + }, + + get_all_ids = function(table_name) { + + private$schemes_list[[table_name]] |> + dplyr::filter(!form_type %in% private$exluded_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] + + }, + + extract_forms_id_and_types_from_scheme2 = function(scheme) { + + form_id_and_types_list <- scheme |> + dplyr::filter(!form_type %in% private$exluded_types) |> + dplyr::distinct(form_id, form_type) |> + tibble::deframe() + + list( + key = form_id_and_types_list[1], + form = form_id_and_types_list[-1] + ) + }, + + # get_key_id = function(table_name) { + # self$extract_forms_id_and_types_from_scheme2(private$schemes_list[[table_name]]) + # }, + get_schema = function(table_name) { + private$schemes_list[[table_name]] + }, + 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$exluded_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$testest + } + ), + private = list( + scheme_file_path = NA, + schemes_list = NULL, + main_key_id = NA, + nested_forms_names = NA, + testest = NA, + exluded_types = c("inline_table", "nested_forms","description", "description_header"), + + 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") + ) + + 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() + + } + ) +) + +# schm <- scheme_R6$new(fs::path("configs/schemas", "schema.xlsx")) +# object.size(schm) +# schm$get_key_id("main") +# schm$get_forms_ids("main") +# schm$get_all_ids("main") + +# schm$get_schema("main") + +# schm$get_id_type_list("allergo_anamnesis") + +# # active +# schm$get_main_key_id +# schm$all_tables_names \ No newline at end of file