From 7dcf291217f1592709686994fa70e7ceecffc0d7 Mon Sep 17 00:00:00 2001 From: madeliri Date: Sun, 2 Mar 2025 22:37:56 +0300 Subject: [PATCH] 0.14.1 go --- .Rprofile | 1 + .gitignore | 8 + CHANGELOG.md | 68 ++ LICENSE | 17 + README.md | 34 + app.R | 1010 +++++++++++++++++++ configs/config.yml | 6 + configs/schemas/example_inline.xlsx | Bin 0 -> 9436 bytes configs/schemas/main.xlsx | Bin 0 -> 11451 bytes helpers/functions.R | 106 ++ helpers/init_login_db.r | 19 + references/reference.docx | Bin 0 -> 16815 bytes renv.lock | 1383 +++++++++++++++++++++++++++ 13 files changed, 2652 insertions(+) create mode 100644 .Rprofile create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 README.md create mode 100644 app.R create mode 100644 configs/config.yml create mode 100644 configs/schemas/example_inline.xlsx create mode 100644 configs/schemas/main.xlsx create mode 100644 helpers/functions.R create mode 100644 helpers/init_login_db.r create mode 100644 references/reference.docx create mode 100644 renv.lock diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000..81b960f --- /dev/null +++ b/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e3567fe --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +/renv + +.Renviron +.DS_Store +.lintr + +*.sqlite +*.tar \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..1610f37 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,68 @@ +### 0.??.? + +##### features +- added checkboxes input form; +- added button to reset data in forms; +- added option to export input data to `.docx` format (using `rmarkdown`), using `reference.docx` template; +- added new column in `main.xlsx` schema with `required` option: now you can set specifically which forms is required (1 - is required, NA - is not required) - this option now used in input validation (doesn't block saving data yet); +- checking on load if schema changed (comparing to existing db): + - if new input form added in schema - adding it also on database (with empty values); + - if input form deleted - stop app to prevent data loss; + - if input form was renamed - stop app to prevent data loss; + - in other cases - show warnings; + +##### fixes + +- fixed not erasing inputs while loading empty values (with checkboxes, radiobuttons); +- +number input validation + +##### changes + +- some code refactoring; +- replacing NumberImput to TextInput due to correct implement validation; + + + +### 0.14.1 2024-10-14 + +##### fixes + +- catching crash file due to bug in rhandsometable (fail to export tables with empty rows) + + + +### 0.14 2024-10-14 + +##### changes + +- code rafactoring +- add visual data validation + + + +### 0.13 2024-10-11 + +##### changes + +- moving script to init login db to separate file +- wider inline tables + + + +### 0.12 2024-09-29 + +##### fixes: + +- error while saving tables to db due to wrong data formats + +##### changes: + +- moving config.yml to configs folder +- moving schemas to configs folder + + +### 0.11 2024-09-23 + +##### fixes: +- error while loading table due to change PostrgreSQL driver +- error while export db as .xlsx due to misspelling in button name \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..c653b3c --- /dev/null +++ b/LICENSE @@ -0,0 +1,17 @@ +The MIT License (MIT) + +Copyright © 2025 @madeliri + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +==================================== + +Данная лицензия разрешает лицам, получившим копию данного программного обеспечения и сопутствующей документации (далее — Программное обеспечение), безвозмездно использовать Программное обеспечение без ограничений, включая неограниченное право на использование, копирование, изменение, слияние, публикацию, распространение, сублицензирование и/или продажу копий Программного обеспечения, а также лицам, которым предоставляется данное Программное обеспечение, при соблюдении следующих условий: + +Указанное выше уведомление об авторском праве и данные условия должны быть включены во все копии или значимые части данного Программного обеспечения. + +ДАННОЕ ПРОГРАММНОЕ ОБЕСПЕЧЕНИЕ ПРЕДОСТАВЛЯЕТСЯ «КАК ЕСТЬ», БЕЗ КАКИХ-ЛИБО ГАРАНТИЙ, ЯВНО ВЫРАЖЕННЫХ ИЛИ ПОДРАЗУМЕВАЕМЫХ, ВКЛЮЧАЯ ГАРАНТИИ ТОВАРНОЙ ПРИГОДНОСТИ, СООТВЕТСТВИЯ ПО ЕГО КОНКРЕТНОМУ НАЗНАЧЕНИЮ И ОТСУТСТВИЯ НАРУШЕНИЙ, НО НЕ ОГРАНИЧИВАЯСЬ ИМИ. НИ В КАКОМ СЛУЧАЕ АВТОРЫ ИЛИ ПРАВООБЛАДАТЕЛИ НЕ НЕСУТ ОТВЕТСТВЕННОСТИ ПО КАКИМ-ЛИБО ИСКАМ, ЗА УЩЕРБ ИЛИ ПО ИНЫМ ТРЕБОВАНИЯМ, В ТОМ ЧИСЛЕ, ПРИ ДЕЙСТВИИ КОНТРАКТА, ДЕЛИКТЕ ИЛИ ИНОЙ СИТУАЦИИ, ВОЗНИКШИМ ИЗ-ЗА ИСПОЛЬЗОВАНИЯ ПРОГРАММНОГО ОБЕСПЕЧЕНИЯ ИЛИ ИНЫХ ДЕЙСТВИЙ С ПРОГРАММНЫМ ОБЕСПЕЧЕНИЕМ. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..88613bf --- /dev/null +++ b/README.md @@ -0,0 +1,34 @@ +# not ready yet + +# О репозитории + +Данный проект представляет собой shiny-приложение (написанное на языке програмирования R), для заполнения каких-то данных и последующим экспортом в `.xlsx` формат. + +Структура формы (соответственно и базы) задается на осно + +Данные хранятся в базе данных `SQLite` (так же возможно использование `PostgreSQL`). + +# Зачем? + +... + + +# структура main.xlsx + +Файл, формирующий структуру всей форму, представляет собой таблицу в формате `.xlsx`, состоящий из следующих столбцов: + +- `part` - группировка первого уровня; +- `subgroup` - группировка второго уровня (наименование колонок); +- `form_id` - id; +- `form_label` - Название формы; +- `form_type` - тип формы, в настоящее время доступные следующие варианты: + - `text` - простой текст; + - `date` - дата; + - `select_one` - выбор одного варианта (выпадающий список); + - `select_multiple` - выбор нескольких вариантов (выпадающий список); + - `number` - число; + - `radio` - выбор одного варианта (radio buttons); + - `description` - описание (отображение текста, без формы выбора/ввода); + - `inline_table` - вложенная таблица (rhandsometables); +- `choices` - варианты выбора (если предполагаются типом формы ввода); +- `condition` - условие, при котором форма ввода будет отображаться; \ No newline at end of file diff --git a/app.R b/app.R new file mode 100644 index 0000000..6575419 --- /dev/null +++ b/app.R @@ -0,0 +1,1010 @@ +suppressPackageStartupMessages({ + library(DBI) + library(RSQLite) + library(tibble) + library(tidyr) + library(dplyr) + library(purrr) + library(magrittr) + library(shiny) + library(bslib) + library(rhandsontable) + library(shinymanager) +}) + +source("helpers/functions.R") + +# SOURCE FILES ============================ +config <- config::get(file = "configs/config.yml") + +folder_with_schemas <- fs::path("configs/schemas") +FILE_SCHEME <- fs::path(folder_with_schemas, "main.xlsx") +dbfile <- fs::path("data.sqlite") +DEBUG <- TRUE + +# TEMP ! NEED TO HANDLE +rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/") + + +# SCHEME_MAIN UNPACK ========================== +# load scheme +SCHEME_MAIN <- readxl::read_xlsx(FILE_SCHEME) %>% + # fill NA down + fill(c(part, subgroup, form_id, form_label, form_type), .direction = "down") %>% + group_by(form_id) %>% + fill(condition, .direction = "down") %>% + ungroup() + +# get list of simple inputs +inputs_simple_list <- SCHEME_MAIN %>% + filter(!form_type %in% c("inline_table", "description")) %>% + distinct(form_id, form_type) %>% + deframe + +# get list of inputs with inline tables +inputs_tables_list <- SCHEME_MAIN %>% + filter(form_type == "inline_table") %>% + distinct(form_id) %>% + deframe + + +# SETUP DB ========================== +con <- DBI::dbConnect( + drv = RSQLite::SQLite(), + dbname = dbfile, +) + +# Init DB (write dummy data to "main" table) +if (!"main" %in% dbListTables(con)) { + + dummy_df <- get_dummy_df() %>% + mutate(id = "dummy") + + # write dummy df into base, then delete dummy row + DBI::dbWriteTable(con, "main", dummy_df, append = TRUE) + DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'") + + rm(dummy_df) +} + +# checking if db structure in form compatible with alrady writed data (in case on changig form) +if (identical(colnames(DBI::dbReadTable(con, "main")), names(inputs_simple_list))) { + print("identical") +} else { + df_to_rewrite <- DBI::dbReadTable(con, "main") + form_base_difference <- setdiff(names(inputs_simple_list), colnames(df_to_rewrite)) + base_form_difference <- setdiff(colnames(df_to_rewrite), names(inputs_simple_list)) + + # if lenght are equal + if (length(names(inputs_simple_list)) == length(colnames(df_to_rewrite)) && + length(form_base_difference) == 0 && + length(base_form_difference) == 0) { + warning("changes in scheme file detected: pressuming here simply changed order") + } + + if (length(names(inputs_simple_list)) == length(colnames(df_to_rewrite)) && + length(form_base_difference) != 0 && + length(base_form_difference) != 0) { + stop("changes in scheme file detected: structure has been changed") + } + + if (length(names(inputs_simple_list)) > length(colnames(df_to_rewrite)) && length(form_base_difference) != 0) { + warning("changes in scheme file detected: new inputs form was added") + warning("trying to adapt database") + + for (i in form_base_difference) { + df_to_rewrite <- df_to_rewrite %>% + mutate(!!sym(i) := get_empty_data(inputs_simple_list[i])) + } + df_to_rewrite <- df_to_rewrite %>% + select(all_of(names(inputs_simple_list))) + + DBI::dbWriteTable(con, "main", df_to_rewrite, overwrite = TRUE) + DBI::dbExecute(con, "DELETE FROM main WHERE id = 'dummy'") + } + + if (length(names(inputs_simple_list)) < length(colnames(df_to_rewrite))) { + stop("changes in scheme file detected: some of inputs form was deleted! it may cause data loss!") + } + + rm(df_to_rewrite, form_base_difference) + +} + + +# write dummies (for test purposes) +# purrr::map( +# .x = 1:300, +# .f = \(x) { +# dummy_df <- purrr::map2( +# .x = purrr::set_names(names(inputs_simple_list)), +# .y = inputs_simple_list, +# .f = \(x_id, y_type) { +# if (y_type %in% c("text", "select_one", "select_multiple")) return("dummy") +# if (y_type %in% c("radio")) return("dummy") +# if (y_type %in% c("date")) return(as.Date("1990-01-01")) +# if (y_type %in% c("number")) return(as.double(999)) +# } +# ) %>% +# as_tibble() %>% +# mutate(id = glue::glue("test{x}")) +# dbWriteTable(con, "main", dummy_df, append = TRUE) +# dbExecute(con, "DELETE FROM main WHERE id = 'dummy'") +# } +# ) + + +# INLINE TABLES ===================== +# создаем для каждой таблицы объект +inline_tables <- map( + .x = purrr::set_names(inputs_tables_list), + .f = \(x_inline_table_name) { + + # получить имя файла со схемой + file_name <- SCHEME_MAIN %>% + filter(form_id == x_inline_table_name) %>% + pull(choices) + + # load scheme + schemaaa <- readxl::read_xlsx(fs::path(folder_with_schemas, file_name)) %>% + fill(everything(), .direction = "down") + + # список форм в схеме + inline_forms <- schemaaa %>% + distinct(form_id) %>% + pull + + # макет таблицы (пустой) + DF_gen <- as.list(setNames(rep(as.character(NA), length(inline_forms)), inline_forms)) |> + as.data.frame() + + # make 12 more empty rows + DF_gen <- rbind(DF_gen, DF_gen[rep(1, 12), ]) + rownames(DF_gen) <- NULL + + list(schema = schemaaa, df_empty = DF_gen) + } +) + + +# создание объектов для ввода +# функция +create_forms <- function(form_id, form_label, form_type) { + + # check if have condition + condition <- filter(SCHEME_MAIN, form_id == {{form_id}}) %>% distinct(condition) %>% pull + choices <- filter(SCHEME_MAIN, form_id == {{form_id}}) %>% pull(choices) + + # simple text input + if (form_type == "text") { + form <- shiny::textAreaInput( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + rows = 1 + ) + } + + # simple number input + if (form_type == "number") { + + form <- textAreaInput( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + rows = 1 + ) + } + + # simple date input + if (form_type == "date") { + # supress warning while trying keep data form empty by default + suppressWarnings({ + form <- dateInput( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + value = NA, # keep empty + format = "dd.mm.yyyy", + weekstart = 1, + language = "ru" + ) + }) + } + + # еденичный выбор + if (form_type == "select_one") { + form <- selectizeInput( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + choices = choices, + selected = NULL, + options = list( + # placeholder = "выберите из списка...", + create = FALSE, + onInitialize = I('function() { this.setValue(""); }') + ) + ) + } + + # множественный выбор + if (form_type == "select_multiple") { + form <- selectizeInput( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + choices = choices, + selected = NULL, + multiple = TRUE, + options = list( + # placeholder = "множественный выбор", + create = FALSE, + onInitialize = I('function() { this.setValue(""); }') + ) + ) + } + + # множественный выбор + if (form_type == "radio") { + form <- radioButtons( + inputId = form_id, + label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + choices = choices, + selected = character(0) + ) + } + + if (form_type == "checkbox") { + form <- checkboxGroupInput( + inputId = form_id, + # label = tags$span(style = "color: #444444; font-weight: 550;", form_label), + label = h6(form_label), + choices = choices, + selected = character(0) + ) + } + + # вложенная таблица + if (form_type == "inline_table") { + form <- rHandsontableOutput(outputId = form_id) + } + + # вложенная таблица + if (form_type == "description") { + form <- div(HTML(form_label), style = "color:Gray;font-size: 90%;") + } + + # если есть условие создать кондитионал панель + if (!is.na(condition)) { + form <- conditionalPanel( + condition = condition, + form + ) + } + + form +} + + + +# GENERATE UI ================================== +# functions for making cards +make_cards_fn <- function(sub_group) { + + subgroups_inputs <- df_forms %>% + filter(subgroup == {{sub_group}}) %>% + distinct(form_id, form_label, form_type) + + card( + card_header(sub_group, container = htmltools::h5), + full_screen = TRUE, + width = "4000px", + card_body( + fill = TRUE, + # передаем все аргументы в функцию для создания елементов + purrr::pmap(subgroups_inputs, create_forms) + ) + ) +} + +# get pages list +pages_list <- unique(SCHEME_MAIN$part) + +# TODO: replace with unique(SCHEME_MAIN$part) + +# get all forms df +df_forms <- SCHEME_MAIN %>% + distinct(part, subgroup, form_id, form_label, form_type) + +# generate nav panels +nav_panels_list <- purrr::map( + .x = pages_list, + .f = \(x_page) { + + # get info about inputs for current page + page_forms <- SCHEME_MAIN %>% + filter(part == {{x_page}}) %>% + distinct(subgroup, form_id, form_label, form_type) + + # get list of columns + cols_list <- unique(page_forms$subgroup) + + # making cards + cards <- purrr::map( + .x = cols_list, + .f = make_cards_fn + ) + + # make page wrap + page_wrap <- layout_column_wrap( + width = "350px", height = NULL, #was 800 + fixed_width = TRUE, + !!!cards # unpack list of cards + ) + + # add panel wrap to nav_panel + nav_panel(x_page, page_wrap) + } +) + + + +# MODALS ======================== +# окно для подвтерждения очищения данных +modal_clean_all <- modalDialog( + "Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.", + title = "Очистить форму?", + footer = tagList( + actionButton("cancel_button", "Отмена"), + actionButton("clean_all_action", "Очистить.", class = "btn btn-danger") + ), + easyClose = TRUE +) + +# окно для подвтерждения удаления +modal_overwrite <- modalDialog( + "Запись с данным id уже существует в базе", + title = "Перезаписать данные?", + footer = tagList( + actionButton("cancel_button", "Отмена"), + actionButton("data_save", "Перезаписать", class = "btn btn-danger") + ), + easyClose = TRUE +) + +# окно для подвтерждения удаления +modal_load_patients <- modalDialog( + "Загрузить данные пациента", + uiOutput("load_menu"), + title = "Загрузить имеющиеся данные", + footer = tagList( + actionButton("cancel_button", "Отмена", class = "btn btn-danger"), + actionButton("read_data", "Загрузить данные"), + ), + easyClose = TRUE +) + + + + +# UI ======================= +ui <- page_sidebar( + title = config$header, + theme = bs_theme(version = 5, preset = "bootstrap"), + sidebar = sidebar( + actionButton("save_data_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")), + actionButton("clean_data_button", "Очистить данные", icon("user-plus", lib = "font-awesome")), + textOutput("status_message"), + textOutput("status_message2"), + actionButton("load_data_button", "Загрузить данные", icon("pencil", lib = "font-awesome")), + downloadButton("downloadData", "Экспорт в .xlsx"), + downloadButton("downloadDocx", "get .docx (test only)") + ), + # list of rendered panels + navset_card_underline( + !!!nav_panels_list, + header = NULL + ) +) + +# init auth ======================= +ui <- shinymanager::secure_app(ui, enable_admin = TRUE) + + +# SERVER LOGIC ============================= +server <- function(input, output) { + + # AUTH SETUP ======================================== + # check_credentials directly on sqlite db + res_auth <- shinymanager::secure_server( + check_credentials = check_credentials( + db = "auth.sqlite", + passphrase = Sys.getenv("AUTH_DB_KEY") + ), + keep_token = TRUE + ) + + output$auth_output <- renderPrint({ + reactiveValuesToList(res_auth) + }) + + # REACTIVE VALUES ================================= + # Create a reactive values object to store the input data + values <- reactiveValues(data = NULL) + rhand_tables <- reactiveValues() + + # VALIDATIONS ============================ + # create new validataion + iv <- shinyvalidate::InputValidator$new() + + # 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 <- filter(SCHEME_MAIN, form_id == {{x_input_id}}) %>% pull(choices) + val_required <- filter(SCHEME_MAIN, form_id == {{x_input_id}}) %>% distinct(required) %>% 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, function(x) { + # exit if empty + if (check_for_empty_data(x)) return(NULL) + # check for numeric + if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом." + }) + + 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, + function(x) { + # exit if empty + if (check_for_empty_data(x)) return(NULL) + # check for currect value + if (between(as.integer(x), ranges[1], ranges[2])) { + NULL + } else { + glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.") + } + } + ) + } + } + } + + # 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 = "Необходимо заполнить.")) + } + } + ) + # enable validator + iv$enable() + + # STATUSES =============================== + # вывести отображение что что-то не так + output$status_message <- renderText({ + shiny::validate( + need(input$id, "⚠️ Необходимо указать id пациента!") + ) + paste0("ID: ", input$id) + }) + + output$status_message2 <- renderText({ + iv$is_valid() + # res_auth$admin + }) + + + # CREATE RHANDSOME TABLES ===================== + # записать массив пустых табличек в rhands_tables + purrr::walk( + .x = purrr::set_names(inputs_tables_list), + .f = \(x_inline_table) { + rhand_tables[[x_inline_table]] <- inline_tables[[x_inline_table]]$df_empty + } + ) + + # render tables + observe({ + # MESSAGE + purrr::walk( + .x = inputs_tables_list, + .f = \(x) { + + # вытаскиваем схемы из заготовленного ранее списка + schema <- inline_tables[[x]]$schema + + # убрать дубликаты + schema_comp <- schema %>% + distinct(form_id, form_label, form_type) + + # заголовки + headers <- pull(schema_comp, form_label) + + # fixes empty rows error + rownames(rhand_tables[[x]]) <- NULL + + # создать объект рандсонтебл + rh_tabel <- rhandsontable( + rhand_tables[[x]], + colHeaders = headers, + rowHeaders = NULL, + height = 400, + ) %>% + hot_cols(colWidths = 120, manualColumnResize = TRUE, columnSorting = TRUE) + + # циклом итерируемся по индексу; + for (i in seq(1, length(schema_comp$form_id))) { + + # получаем информацию о типе столбца + type <- filter(schema_comp, form_id == schema_comp$form_id[i]) %>% pull(form_type) + + # информация о воможных вариантнах выбора + choices <- filter(schema, form_id == schema_comp$form_id[i]) %>% pull(choices) + + ## проверки + # текстовое поле + if (type == "text") { + rh_tabel <- rh_tabel %>% + hot_col(col = headers[i], type = "autocomplete") + } + + # выбор из списка + if (type == "select_one") { + rh_tabel <- rh_tabel %>% + hot_col(col = headers[i], type = "dropdown", source = choices) + } + + # дата + if (type == "date") { + rh_tabel <- rh_tabel %>% + hot_col(col = headers[i], type = "date", dateFormat = "DD.MM.YYYY", language = "ru-RU") + } + } + + # передаем в оутпут полученный объект + output[[x]] <- renderRHandsontable({ + rh_tabel + }) + } + ) + }) + + # BUTTONS LOGIC ====================== + ## clear all inputs ================== + # show modal on click of button + observeEvent(input$clean_data_button, { + showModal(modal_clean_all) + }) + + # when action confirm - perform action + observeEvent(input$clean_all_action, { + + # rewrite all inputs with empty data + purrr::walk2( + .x = inputs_simple_list, + .y = names(inputs_simple_list), + .f = \(x_type, x_id) { + + # using function to update forms + update_forms_with_data( + id = x_id, + type = x_type, + value = get_empty_data(x_type) + ) + } + ) + + # inline tables + purrr::walk( + .x = inputs_tables_list, + .f = \(x_table_name) { + rhand_tables[[x_table_name]] <- inline_tables[[x_table_name]]$df_empty + } + ) + + removeModal() + showNotification("Данные очищены!", type = "warning") + }) + + ## saving inputs to db ======================== + # сохранить простые данные; + observeEvent(input$save_data_button, { + req(input$id) + + ## MAIN + # собрать все значения по введенным данным; + result_df <- purrr::map( + .x = names(inputs_simple_list), + .f = \(x) { + type <- inputs_simple_list[[x]] + input_d <- input[[x]] + + # return empty if 0 element + if (length(input_d) == 0) return(get_empty_data(type)) + # return element if there one + if (length(input_d) == 1) return(input_d) + # если елементов больше одного - объединять через ";" + if (length(input_d) > 1) paste(input_d, collapse = "; ") + } + ) + + # make dataframe from that; + values$data <- setNames(result_df, names(inputs_simple_list)) %>% + as_tibble() + + if (length(dbListTables(con)) == 0) { + # если база пустая, то просто записываем данные + write_all_to_db() + } else if ("main" %in% dbListTables(con)) { + # если главная таблица существует, то проверяем существование id + + # GET DATA files + query <- glue::glue_sql(" + SELECT DISTINCT id + FROM main + WHERE id = {input$id} + ", .con = con) + + # получаем список записей с данным id + exist_main_df <- dbGetQuery(con, query) + + # проверка по наличию записей с данным ID в базе; + if (nrow(exist_main_df) == 0) { + # если данных нет - просто записать данные + log_action_to_db("save", input$id, con) + write_all_to_db() + } else { + # если есть выдать окно с подтверждением перезаписи + showModal(modal_overwrite) + } + } + }) + + + ## get list of id's from db ===================== + observeEvent(input$load_data_button, { + + if (length(dbListTables(con)) != 0 && "main" %in% dbListTables(con)) { + # GET DATA files + ids <- dbGetQuery(con, "SELECT DISTINCT id FROM main") %>% + pull + + output$load_menu <- renderUI({ + selectizeInput( + inputId = "read_id_selector", + label = NULL, + choices = ids, + selected = NULL, + options = list( + placeholder = "id пациента", + onInitialize = I('function() { this.setValue(""); }') + ) + ) + }) + } else { + output$load_menu <- renderUI({ + h5("База данных не содержит записей") + }) + } + + shiny::showModal(modal_load_patients) + }) + + ## load data to input forms ================================== + observeEvent(input$read_data, { + + # main df read + test_read_df <- read_df_from_db_by_id("main", con) + + # transform df to list + test_read_df <- as.list(test_read_df) + + # rewrite input forms + purrr::walk2( + .x = inputs_simple_list, + .y = names(inputs_simple_list), + .f = \(x_type, x_id) { + + if (DEBUG) { + values_load <- test_read_df[[x_id]] + print(paste(x_type, x_id, values_load, sep = " || ")) + print(is.na(values_load)) + } + + # using function to update forms + update_forms_with_data( + id = x_id, + type = x_type, + value = test_read_df[[x_id]] + ) + } + ) + + # inline tables + purrr::walk( + .x = inputs_tables_list, + .f = \(x_table_name) { + test_read_df <- read_df_from_db_by_id(x_table_name, con) + + # если табличечки не пустые загружаем их + if (!is.null(test_read_df) && nrow(test_read_df) != 0) { + rhand_tables[[x_table_name]] <- subset(test_read_df, select = c(-id)) + } else { + rhand_tables[[x_table_name]] <- inline_tables[[x_table_name]]$df_empty + } + } + ) + removeModal() + showNotification("Данные загружены!", type = "warning") + message("load data") + log_action_to_db("load", input$read_id_selector, con = con) + + }) + + ## export to .xlsx ==== + output$downloadData <- downloadHandler( + filename = paste0("d2tra_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx"), + content = function(file) { + # get all data + list_of_df <- purrr::map( + .x = purrr::set_names(c("main", inputs_tables_list)), + .f = \(x) { + df <- read_df_from_db_all(x, con) %>% + tibble::as_tibble() + + # handle with data + if (nrow(df) >= 1 && x == "main") { + df <- df %>% + mutate(across(contains("date"), as.Date)) %>% + print() + } + df + } + ) + # set date params + options("openxlsx2.dateFormat" = "dd.mm.yyyy") + + print("DATA EXPORTED") + log_action_to_db("export db", con = con) + + # pass tables to export + openxlsx2::write_xlsx( + purrr::compact(list_of_df), + file, + na.strings = "", + as_table = TRUE, + col_widths = 15 + ) + } + ) + + ## export to .docx ==== + output$downloadDocx <- downloadHandler( + filename = function() { + paste0(input$id, "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".docx") + }, + content = function(file) { + + # prepare YAML sections + empty_vec <- c( + "---", + "output:", + " word_document:", + " reference_docx: reference.docx", + "---", + "\n" + ) + + # iterate by scheme parts + purrr::walk( + .x = unique(SCHEME_MAIN$part), + .f = \(x_iter1) { + + # write level 1 header + HEADER_1 <- paste("#", x_iter1, "\n") + empty_vec <<- c(empty_vec, HEADER_1) + + # iterate by level2 headers (subgroups) + purrr::walk( + .x = pull(unique(subset(SCHEME_MAIN, part == x_iter1, "subgroup"))), + .f = \(x_iter2) { + + # get header 2 name + HEADER_2 <- paste("##", x_iter2, "\n") + + # for some reason set litle scheme... + litle_scheme <- subset( + x = SCHEME_MAIN, + subset = part == x_iter1 & subgroup == x_iter2, + select = c("form_id", "form_label", "form_type") + ) |> + unique() + + # iterate by id in subgroups + VALUES <- purrr::map_chr( + .x = litle_scheme$form_id, + .f = \(x_id) { + + docx_type <- subset(litle_scheme, form_id == x_id, "form_type") + docx_label <- subset(litle_scheme, form_id == x_id, "form_label") + + # logic for render documemts + if (docx_type %in% c("text", "number", "date", "select_one", "select_multiple", "radio", "checkbox")) { + docx_value <- input[[x_id]] + + # if more than two objects: collapse + if (length(docx_value) > 1) docx_value <- paste(docx_value, collapse = ", ") + + # if non empty data - add string + if (!check_for_empty_data(docx_value)) paste0("**", docx_label, "**: ", docx_value, "\n") else NA + + } else if (docx_type == "description") { + # treat description label as citation text + paste0(">", docx_label, "\n") + } else { + paste0(docx_label, ": ", "NOT IMPLEMENTED YET", "\n") + } + } + ) + # append to vector parsed data + empty_vec <<- (c(empty_vec, HEADER_2, VALUES)) + } + ) + } + ) + + # set temp folder and names + temp_folder <- tempdir() + temp_report <- file.path(temp_folder, "rmarkdown_output.Rmd") + temp_template <- file.path(temp_folder, "reference.docx") + + # clean from NA strings + empty_vec <- empty_vec[!is.na(empty_vec)] + + # write vector to temp .Rmd file + writeLines(empty_vec, temp_report, sep = "\n") + # copy template .docx file + file.copy("references/reference.docx", temp_template, overwrite = TRUE) + + # render file via pandoc + rmarkdown::render( + temp_report, + output_file = file, + output_format = "word_document", + envir = new.env(parent = globalenv()) + ) + } + ) + + ## trigger saving function ============= + observeEvent(input$data_save, { + # убираем плашку + removeModal() + + # записываем данные + write_all_to_db() + log_action_to_db("overwrite", input$id, con = con) + }) + + ## cancel ========================== + observeEvent(input$cancel_button, { + # убираем плашку + removeModal() + }) + + # FUNCTIONS ============================== + ## write all inputs to db ================ + write_all_to_db <- function() { + + # write main + write_df_to_db(values$data, "main", con) + + # write inline tables + for (i in inputs_tables_list) { + + df <- tryCatch( + # проверка выражения + expr = { + hot_to_r(input[[i]]) + }, + # действия в случае ошибки + error = function(e) { + message(e$message) + showNotification( + glue::glue("Невозможно сохранить таблицу `{i}`! Данная ошибка может возникать в случае, если в таблице находятся пустые строки. Попробуйте удалить пустые строки и повторить сохранение."), # nolint + duration = NULL, + closeButton = FALSE, + id = paste0(i, "error_inline_tables"), + type = "error" + ) + tibble() + } + ) + + df <- df %>% + as_tibble() %>% + janitor::remove_empty(which = c("rows")) %>% + # adding id to dbs + mutate(id = input$id, .before = 1) + + # если таблица содержит хоть одну строку - сохранить таблицу в базу данных + if (nrow(df) != 0) { + write_df_to_db(df, i, con) + removeNotification(paste0(i, "error_inline_tables")) + } + } + + showNotification( + glue::glue("Данные пациента {input$id} сохранены!"), + type = "warning" + ) + } + + ## helper function writing dbs ======== + write_df_to_db <- function(df, table_name, con) { + + # delete exists data for this id + if (table_name %in% dbListTables(con)) { + + del_query <- glue::glue("DELETE FROM {table_name} WHERE id = '{input$id}'") + DBI::dbExecute(con, del_query) + } + # записать данные + DBI::dbWriteTable(con, table_name, df, append = TRUE) + } + + ## reading tables from db by name and id ======== + read_df_from_db_by_id <- function(table_name, con) { + # check if this table exist + if (table_name %in% dbListTables(con)) { + # prepare query + query <- glue::glue(" + SELECT * FROM {table_name} + WHERE id = '{input$read_id_selector}' + ") + + # get table as df + DBI::dbGetQuery(con, query) + } + } + + ## reading tables from db all ======== + read_df_from_db_all <- function(table_name, con) { + # check if this table exist + if (table_name %in% dbListTables(con)) { + # prepare query + query <- glue::glue(" + SELECT * FROM {table_name} + ") + + # get table as df + DBI::dbGetQuery(con, query) + } + } + + ## LOGGING ACTIONS + log_action_to_db <- function(action, pat_id = as.character(NA), con) { + action_row <- tibble( + user = res_auth$user, + action = action, + id = pat_id, + date = Sys.time() + ) + DBI::dbWriteTable(con, "log", action_row, append = TRUE) + } + +} + +options(shiny.port = config$shiny_port) +options(shiny.host = config$shiny_host) + +app <- shinyApp(ui = ui, server = server) + +runApp(app, launch.browser = TRUE) \ No newline at end of file diff --git a/configs/config.yml b/configs/config.yml new file mode 100644 index 0000000..f4e0414 --- /dev/null +++ b/configs/config.yml @@ -0,0 +1,6 @@ +default: + header: "TEST" + version: "0.14.1" + # shiny serve option + shiny_host: "127.0.0.1" + shiny_port: 1337 \ No newline at end of file diff --git a/configs/schemas/example_inline.xlsx b/configs/schemas/example_inline.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..18ec74183f2b7e58ac71cd9c79815a4038b79625 GIT binary patch literal 9436 zcmeHN1y>x|*6rXL8V&B&!QI{6gG=z>?(V@QIKd?l+}$-0AV?s%ySwxC~l`-Q;IT>P#6Fh02}}SAORR2eKgm50RY580RZR#I0$VKTN@`6 z8z+5LcRLeDU3xcbE8<)z2^fOUKKjgE~6mLh-Jd9n)N& zPCHZ3pCn*n7NBSuQHxc^Y%}KFD}b3NJABejym(KsijLpAjAz`O853(Pk4Bq$%oLv>*>W8n%;X?JRuwwTwS8$ad9 z3@ww1Po9ca0mtaoapBPm@I$cpQvJ31A+3uu5WDBc`lmXf&S=4C!aB>Ov;LO z!#pN2K#_gvt5wT-I{eYSmjk}%^We!)Km^gJC2)rNJ4xPpx$;>(z?+6u&X+DL8wX?%|fHWL9~w zO$*R(hZI?skvoe^>rECvNoqeX9&Bfga_E#EbLm?G6dP39VyjP4EhYor&*EB37_X(GO+2x{w#uE#uaUJaGQE?p&OBp^_$Qawr9 zK10g>7JZ@gFe{4PA>DPw30p++LvkFp(8A4tVu7RD0Y&481)JR$8#%DnqwFTOl_Qr6 z)+ULcXG~Md)@5Q^awxq4$u}J@oBl!Q^(;I!J`xB?>%f7TH^Z!KzOcbwtR2f$lCkz2-ix#qv`5Da@ZhDTLrF?savNsW z^h@c_bog=jDEy-Y&_7G?S4*iDxy(e;T-LA@}|Z!2h%I69CP{; z?rI0wY?{!RZ8HV}QVq@1yJjX1{F9DyP?G>)P zS5PVl`>KhB>7k`&PP(&U>#$G|?)n_5{Pf@r~IIqE&c@_xNS^Vp#SA}~?^ zPGx`o56S1?GtJ<9hYNsv0jBc5Qr@2l{qOYm0$h!P1HymzR;nx~)5{2KLwpKlbWL}` zME&8!Kzg9Ij{-MT3!0}SVez?G#(UkYtMOfi0n#?a{rKyE%Qf4}HAwW!E}Bo_Xiy&L zR>wThwqMV`Lc$pymJtR>K%=7_?CpO(M0}a%h~C5>KS-O2!MSxqO@R}dS4b*)(KHdl zYB9>_%xvK}PVfaB{)cNf{O*EO4$1;*8ybkyK&G3|O(OGGFj)caMBmPF;H7wx-2vZr zrbuXRy2P&F&RQQ#<=jUtyYlXkHt|2p5SFmiAaDpdhWmqd4-pp zm7T24(OSBAla1O`qB$6*Lv@aN>tx!h*c!RA`V~m3=ajQB{Cx;g&=ha?xEci~M%pnZ ztBoIa?8w`PdaSax2@GGTqLd$p+F6#~bP zMJ7}-6SRG4yRF{fygaTS+3*(2fzCI4V%q#YY*A47VZnV#OqP(9W$0%n$|YxctxUv9 zd~GZdoZyehGia$d7aw+_30?4ckgHGz8FA#^4_tqL=j_}B2MeF{DS5@MRnjz%IJ)2d z#+Sr&0nxq{j;h9&>l=T6$4?jeIebXaei;CMO=%Er2FSSI5Er~3k7BKRuWwE(wAiLX zYG8H~OEj^7pO!EzcK6w_jlE6j%-)kSCJjF6re&8mqa=WWK?z%1cWKUjzq#FXm)=Nv z&My;^r~O4!sFPyxMqvDc&-)NGQc5l94W=BB(g+mnz9!#%HsNeqm*X1&VrOamIBp8& ze124X?pwC694RpD?3j%v;Tf^7DXt`)Nh@DltsL_~VHM|&EtV30s!bxLaL{cs#*tHX zYU<*z>>|X)-d4Ad*-Gngf6)ENp!DOWEg4 zgDEFUjr7<;1im(vw+oNg{H&mq(C3*9Df;x3(F)#<;2@BjXj5Zp7*|}GMnKHxazM{5UF1?*WP_Tin|Em3 zvPc92T<(E<8~UPPGVI#Qw{pjC(e>YJ%|?XPh*bObTQ*nh+`Et=xyBNl+PC(G^2BHhIzc? z(cIWKN&69O`bv3GZ;&qfOY!e~+VG9i+^D;lKD9k8ZtBxN`?&iP$`v`uwtCV$dc%Aq zm);9uLLboL(S(1zn%_=-mAtIe-q?C`#nSi$^YlD2C@&8|N0MAU48`47x+ye+?!!*L z{Y3;x1{y^x)Ap(LtgXeQH65O*POP4ogV8rthmw&CUM|a!UCVXvx<{N%W1j<1$Zr1_ z@>F(-10alfy8%kh9nF4ojrTT$&Tm2{^k_?7vFa51F%fxGsAdWNbCM6F^rbq-0H^tt zCmW)zAgI0G-}e4(k!IBi%!jpoyc>&-HuNjH))!)tlvL?Eck+2kW8;>CA8PohS~V-~ zdD@UN^N4Z3e=BTBITO|8xH5c*jCcWOE);?(7ppZogb_nBKJVB^v8Tjk=C+%|CEpli zDu4t5*H=PR?%NOPmb?;By9Gb8A)c@mx}h=NWZ{k?_*vbr_3myzc}&06>uDxA%lGN* zHfx;!qu6UTlcB>^<2N7fkFEutuPX#Zp6||W+wb>Y*|gHG=|7)F%=q39To;EHC#SDX zGcf3NG`d}WW_Z30t-zm~hlmM3A&Gh~8oGhRx5b1sp3=RgAiidb)&r*^10j(;pVM4H zis;tZI}*GPoDWifHYRv=^0b!Pcgcx{C`Q015NU|$*2%SRx60ZnvZ&tG-6O{A=t_?z zwqO*gpzG~wZ^+fyks@+eK%cl6rokG6Esv2I7et+(b&4*GpLZXmJX{XzMBBKb63n0T zDX@5wT!gzC0`zJwkLku_mlUqN-pcU=!Wn9Rk#j$OtPU)?_~jm!Wi88Cjk=WW@AElY}>9~6ee=+qIr~A=K46{Z|KRR-Xrd) zKh~)h;RYP3%+f@~4hGJkgfa5S%5_d4ZN`A!C_bG-Z(IcmdL6FQ(Yw$k?Zl+r{dTAj zS5G#*yAN+0ja6iIGz;krX+S;lc?%c z3e`xpM9(OYiiXeF9$ac~LB6P>wEg#l51 z_K+nuwe49MQ4K1Fz9*5nG!D-j8S$%v9|-X$X)HK`c|U5H@lyA_yWOFZJ-o(qg45xx zjAK{!s8q!UP&0dclnh+B%$Qa963j;_tjJPLYoKMyci7XFB5wQ?CJq&AmN$wh6E!vu zeURC6CtPNml|jwz32YWVGz7mDV4ErH znaqy2y$;-4JPM|ob=e?-_eiojDYUi?K$P7OJ#v)0`$El`MdEt~nVP_^id>hBu zPH;NJ++xfu$67q*tdv%GHeejSv(dU4T>gcLM`yI;MG|0cs*|zjd%&p07}ivTE@hhh zY@MA}zh1Gr^=e)39<~deRXwh5?ey(lukOrIq1j=j(-b8#o=n$tA?E5iz(2=H9>sHV z0nvR+$0U(mCnq?Y?zqUOO!qLP&SuDV>aM_|U@sZB&ZS_geEPLe2i8rS{0(SaMG1du zB8CFSj=MMM2Nimu_j=8HH)nv0*~mIGhrY;%sOzt0=tAb+>~TJH{vmgHa47ijwcS37 z$n$R-rVgPmmDvuaWuiVxw@e}Lw^brXxOk60O^Fo2;5&J=b!B5E?df)^J-U=l9jP`K zc;qd^!wPlGoxjMS6WBh%%5$_aMQmhkJ$n3EpZr=A9B0f@K7-%p2Eb>L|5Xz>I=Ne! zIQ~|X*Q$Muo@4~JlbyayI{xuc3$jjxQfiKi1&|z)+B>5c)tx99x5yx@jrhB+5O6xI z5V$Od*~iywRt+nlCVwZ45%6VM9wB#MfQv5w#4bC85o-2ATotRt*x}>aOmY)P-=GGm zOm|{FXh|uM$P9&uy#I)^ZC23&RZucvEvoKv;aaXLCm@AIO$DARaUwutcCXIXLQd-4 z0!7y&H5_F-vFzH*xAfrxFHl807QgG|h|1AwGmRdU_jOBRoSRt|vufIB&jlGNXH#bE zz_EEeOIkke5_BPyMV1`ktlX89XbAZh@|>ITgQ6wE7wN>}FN~i|~Qgr(yVT98}(MrOmB7PJ@6XJ=X zs#Ak$BiH)udX!HZaH{M2U3Up+oek7#rN-tdsz>qwbO~aZT@Z9dnYK5U9@xyf{A z_<_H42db3aCd?^zRC|awAG&Ev`t&k+zk(ynmS5Mm zQf{YOnDco#=J5$Gwc13uRZ|-;e&J1{kC03~CeY~kGF%rlFPsnlwP)?%bkR+RLgFk|@D}fWK)e9qN$xXO$$%#3Jt<4IbOr zj?#10P&<>dAe1`Y1NP0cFbjFR7N;p_XsKKucqXubUvy`;onIOM81F>-QY8}hItzR zTV$^#m>#B*XIN=HD-6T*(tDFVL2{wTfb^U+aFxW&!g(MwU|9d7Xe=zjK`#eBV+LMrRIt)yY-^o%2|2esRhtM+O)%ed`6Sm-3Y{Cn%cDFHjL{^k5X-J% z;{#NOEn!wmi4V!VuDzfpDd#3`iW;{kUFyl3l96eWt~~dao_L%V`~4+M;v+wgRf5^u41F@cv1<+6rKOpAPmxLa=-V{Id_fwX^%53xa*`_bnq{&Sstw z7<>)w0qcLC;-Cc;EW|{efu+g%=>^XZh2l6dRZ@5d(%HqjdBU7myG(0%Cgdd13&zun z54^3nocPX7mg%KEDW$H#DPs%|2KN%=&{XjvN{BFV z({tbHPfny~GAvqO`TN)1VGA1}13Q$LHPF4!FikiNO3AYJ4kkwp@-|cpQyinV__gNt zb%x%Re22l+IfK&`N>Ciy4rmtNnQ4H)OL#*-$IZH7lyrcix6(A&F4Rp}3M3FkjK;1^ zjv4}TkSI-|_!2%5`VjgM_|OamRB;BW9J1CQUwQ%U>|P%rivw*kNNs4@Qrh3pgk2z< zdP(y#Mz$73uFrzjPAmwoVjd?NUMytd4eUfXFHc&}-p~+x&F#EXDzgmJIHSVn@S*)= zsb^~Ckzj&s6S0}FWs=ts)N;CT`CypTF??%D#YT~ZqAdUpoBz^cUqH}-)73wJNAm9n z`0xEcd{v?-^H&3Z?Rfti_}e}i%#uI#zkdb(+6DXr+6r#1|I!ou75vw}!yixpAQa&z z`2Xob{A%Y{G5QZn%}D>5#NVXpU#XdpO-{RaKDCi&IEUo-0;cmUuO9{~7Up8Xa6*P!@kxHGtC^dI=|AyQEW8vJwt Q00i*Q5A2iTq`w{gAF!!)h5!Hn literal 0 HcmV?d00001 diff --git a/configs/schemas/main.xlsx b/configs/schemas/main.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..4c83c5b8cdd524877d5d4cd91c36c6afa7aa68cc GIT binary patch literal 11451 zcmeHt1#?|V&h|CiF=Nck%*-4!Q_LJQGsn!#%uF%G%*+roGgHj;dS-XOnaRxe3wHZf zovvHeQk~N+J&#(FoFoV+3IH4c2><{H0QzScrrJONKr|=-fDC{H{w!o|tbnvp9>01o(%wgU;n@HU%Uh5@gp)l^avt%;?F`mG!iSd{E#fCegjC9^1PkB zas8zRpEJLFdCLrWLJ-VBHDjwmnpkmXyc{#FwX$sR3+``GfC=**>{QmqVx#LDI3ely zh!Jb2p?;o?g2m5(p`#OFoCZj?ZR}BC7Ty$)D91EKMdS6^&R7~yL0s?u4pXX8%rUs! zwIQRjhR8l#GJ~)^g*6K!00x()$w)kmUcE=X=cpYlF*-}8vW7cR2?3g9&R1vkzqgO9-CQFO?7BKXY%_J z_)RYW5v3u9C44X5fq77xx2`#BN3I;NTWjWX= z{k)0>hnm0r3_BB`=>(EAaIZdBj+&9c0)DN|;|k#JtEIht`Qi zXD)?n5GH6(!A#r3lCxWf;ps4 zrc+P{?e$F-D?J7+2yPxQl@(1nzEtaH+Hn%P>KIydUJIvnAisFf$fOS{5Hcg(Gfs#N zkYwL@Yt%7cj%2v@vO)Ef4PFfSh2a&iy))F`o#cxoA8{%O0I>c}W$^Di<6=SQY;9+* zZ*6V<8*h~>YguixB6!hFazVPOioYx&5z z(9R!NXp;}B-6cL2*)%pE%omU3^r7HmTNxct6J*wn=^2C&tVr)7UmZ@${dvAFh6_P}iqO|fwYC9k^5_JmDK&Vm znT1ii5nww(Ns8w#r&acCLx0gm;Ec+~-Mo28rE|M$y?0WrN2c1LPI-*6i%WZu$w!oH zTI@9qJ!P*9!6M4Q1~c|6sHZMv5QIv%I}z2n&o0l`l>4A5sc4m|1c2Y2DDz$C*fiNb zSlPjtOf%+}<-2^9lv0NZ!i@A?scG(6G5Q^>M>E0lWz#WAHI|wHPaJ7DyLL1U8R*)| z9bkX%&Yf-MOQRirPOu z$XgIIk+HJxJ$T{Pmi%F^)a+N2ut9^S; z=|^6BgPHT5ficfY=sB8f(Q}yL2@{2_Kcz9ZYd_?1^SEq3EV5Ro9g%AsfGZYX9(xg7 ztOcz^Yrs*)?p8<_d>P70ZQu*l>ba60xF8&0@)*FuhzT-S$0PF!7vuT((@)B~8n~o= zKD8aa{rP71yvp0-WyW7fGo!`R-%%RW49hkq%@aI`j!D5N+k5UNkXK1e2it*)j*EjM z2seMgC+BeE5b`O~*QCLm-C&)uKhhGTCQgmXnOV{}rYtt^EO6tEo#5#MWT2#24RuH~ zv_LJYrn0?;a6SmjDK>B>-H_-RdpE0`g8~x^_RN4NifiO1X~}8iC~@ZZLnifIugm`H zFX4|>6fx$-TFMPC>~faPSv*o`Eg_zz+Nj#}vP#CcI&W#45Et#aWSB*4WSITuRcNYY zOWNaT&W(p9{WE3cDVbJ$852cWXy0^#XeOOOLLdFh8j>h54H+LG{>hDfdE=9=-`%(Q zo$D|GkU;Nl{4cuuvorsP`heae(RVQT?;hm}(vrRO2yM`>LG;dPPN;~B4s?Vk%E$1K zLv<9(qy$V}Ki9D+o3+$_NYa5=2fCh*4LIGgz-@sb-*izGha!QxAzPetfmx4TkAXny zpH|@diGd*_og5vPokGK<+9QAGjUA-UL}A~%Cnv!O$}1!k{`q}6klAdU-jUJFeiCQ+ z9r{P=c6=WF6;CSs>KYsIQz?vh-@Xei--2iPx#CS-V?cf4hIIu@9n2C?-FJ!HLSD5# z8%w*6n|I|s!t7#~N#d5W@OT6|;0Fzg;dxWU+VAG3v?!l%ItV@uQ*AxdCSD<6)<9pzwh64bgzpwZ=^4psl89CU~{XQ}LMgi$@%aKd;2!ZERH#mgr zaYQDFD$qcu5^ZXZ?oF)YpwwIJ^w6WvmvuSHGLq^75^&i=J@?l|Q!=IX+Cb>=Pzf?a!^v*wps5x7 za;GDhlpc!WB*k4FW*7$=Kw}x=@dDU^tNe1>F@f|-cl3txHsC3SSU?G1@IOeHO?GHs zYGj%Et$syTs$g>r`y@}K-z8}U2PeVZ6*w^>LD@`RbLKf)IJ!*r+B|Tlkc}D{&dbL#z+)8;aw2`8`ge2f`1Y9*dS)o1W|V z)|*<3M3L)iRGHdOREG_={kZ$5Kd94!HVqjMrA^}a47rCnGOH_w73K1G7%+MJK#;=4 ztbDv|77oKqCMNr+;yYnRO;1e%{UsdbwygySyzv8xx6m$klhTiLqgSjIeoRxeJGqw;W!S7Zr9?hgD-~0;b0avg)%ZPqgPP}TR(9=2*r0g1+eKtSp&djA8 zissXEGW9xXTvQ@AiVs^3gmfqq(`UEGZZBpNI{Q6m*V_|E_BzS>j!&Lm9S?8XSz&WJ zikWm(d~fyh%e#-S^>mqD3tQDKpa-8j&%%=QcemN_UU<1rf2;?sJ_-isi6%$*Gb3&_ zrizCrM6-4gB4&^R!F@#B3prJkjOC39iHVL2oMjqWl4L(LWpaR7@T@T^QAc3}5+EST z-=mK9O49|(;2f(>z-$UG4rO^6d}->1@CQvBATb4Y(h1&?Jn(}=q*R^+Pu<0cje<;k zZUT*?V~T}W6UTKci$I9sK3MvKb|0W6T)i_ulI)QX-C>L?MrPcHY;c`S-~q5@;?U1mU5Eo?Bse`NLvsH5B>uO+9|A(>^tC|rZlEwK)XkVGe-$NUru0fDK9Mw00g-;aT| zjBc#ZGay++7)dySxz5BDx9tRi?uH&jtJmw$S(3KFu)!TkKgv?5EHQ;W!?aXo#vSCp z$ufJe2!*Tl)vokNP2y1_6VN+n8h8J zVvHB-S4hfDsYd_J4yk~>gpDZ^{lHhtR+FnZRbM0;J+vp{cLesQf96eE@XUm*Eyad! zc(hXAg4umBY@WUa zm05ALeVICx*?u8ywgkPpw%4=)NL){=f2_!*yIMDcUVqW@gW!`T9W>=4!-JCjYJXF^ zZ}&W7_EtWp8IH~%&^gx9$;2bHfsAO0bcS;sm(MBW^2GCCBxz)fev~$6{Dptt02qXW z74(uxzZ8UTQjv?I<{qTV4JN!q;}#R0$T&3pnUuol$MyEL_aE+S5!EHr!w)0u-FF2s zsZxL<$C^Y)45wM#>pA3x9Cqqvi=F-A#+qQay~mcw!z4|{QC(x0l_?^-7H$u}ouuI4 zvcQeYdc6F!`URTW&QJPMwm$OK7y`m6ElZAtTqG3%65*m%$sJZ z@IF(!?KWLZ9HnAy?F2FYNiRiuSb3GeBRC};4Ra7;I;8w2ANQ7QXg&}~OD z;>kyjNuHI@*-=ecng^>}?j~$j#EsHp>`mINeyQ6&0B>r-7QgoP{UY>tz68w-4&Htb zzJv*X%kursmky>zmPT~HKYypn6OC0XtnaApbd%2bd)iZ@2LrK)Mmg&)$jc1+Bz@Wn zNCkSM7$1m@K9i%V8CKmIhXF6=vVkqF{mdmd%cf{1Z$6-M$s*wQb9zGH*$HPB3R_xu z5NHgjfS#~vx4*wk@9AOMS$R3&Ha>`l{Ny@)<;T??B+j^poI0wp7Ppx_dl9X~o}$~2 zJbjfY?1s1cbQyKFrG*-kj2|t#Lu=(4qj0@yryiMuF~a2`gXF@xOW6Oxs;`_I@gC-9 ze>wJ}R~xoLstb7+Lvh>l>aGs$o0qFEu5^)uRI5AHizj#nvBXgz1M+|dmpatT?ec!o z$E0=5_NLbRTc)O0@YlD|K^Ylf8iJ(S5m3&)@?C*>WG`0Y{b3;(NicYgOzYRytF{)S z)-))FdXWZvHhS+AO;UOeDCsPHRt@K)yB<*%wPQ9wA*=06;A_PV1^_ooZ-*i&cRX9= z4ofeP#%EeG=xk3$uI3W#B>{F^;M*EhS)vz+#EmN30K4g}I}5ZmKSg_kul18&k$TMq zc>LBe*1cIr8}cnpE09PyDOuXVqfDOs#H9IP{5Kx5R`seUt~Qv=JbcU_Q-v+bSHfCs zxBAcFVL*_k0)eQ~(Hi4JC{YBH%l3UFNAesdE{8cBGEM%*d@#U}eWiGn-u)mhNgIB3 zdr+f0qH%jcJ8F~P&0OL6%T#?@A0LmCCUjaoUgwjtykD;#vL<;mL@1SwhE6vPRpOt{ z?)cvBs`!N799SwNh{Cyj_OPdp`}_l?0U}rESg8(P?)yx!jb|y*&g~VJ|HM zM}=MxM1%+j?ZEKtF~CeFckjuHZW$x>Kq^WCi)An8G*=NqyEOHV1{@9!(d-7Kpsf2K#ZrV`{;LR!iS~5c{#90eW@o_1S;oj(w z5VEqt!u|rqk=;I`Sxm-~SPFU+dnd?W-MBUChric*^Dg*5t9 zEe&9fqGBct-vr&W5CSJI{1JZc7(jf5%lgbZ@rf@Ozw882RhOsJsr=~4U))bB<68>h zT}hqbZSv?n8ZX2MRftJQ9D0~#DtyKWKL4Oxp%-tAJoPdop z>lrr`J@eD)yJ?&%Nxg@2PJ5WW-EV2*lFY%f17~5U;+iS@FPGhQBrHhxJJ!FnfZhcjO_YDz6#~sg9 z0)tCMQuMZ9@k8uIDia2O-r_e#tdwKVZdcGGH;>7jfHWuz!|078G9{4##LONqd0i(C z6GlazIMZ6)2k9<5ou=O%9a{Dq_Cfko^h?XKvCLQW%;ZT5onmG-h@%(f>lww- zw=;reg>Rg)hmCKwKi`3^NPDi1YMD*V6snB{ruWNi3*BpwB~X3$CFzsuLUI7N=l1`! zpTm&Z*h+Ci)MLaQv=Q^D1@jFfeLg%v+~j#VKk<8XX^>I8#)@IaEFXiiFuv$^V$nbc z97JL=acr!4_v}kfEcA{4Q%(#>)v`9}3)8NybE1^r97*j zuyKhgnisEXl69Le$M`fNze247~fy3bgB|=ph!BG-sy;H$#=sCn~qR?#NC()vVf^4Ym66-Z{TAdBs?}$UALDU?6O|t>?zod0?WyqWJHEU z%Pj11TQzK$ljr2?tWXg+wu4(+S2kMWkyfYji&MqynNo9sTi!Ypgh0pAHBdSY-~I(! zp1qYZbQ5#y*~>qsT?h$xYPjF4el>6a0PMeF0(%En3nTmAF3z*6V^+)T2<>#$=lBPe z2Rbn@BO=d4`23A(`0Bb}$#PfTUXdeS^iAUeQjT07|Q-I!!}YiP=n1#B#!xutm^6 zg{C`ucmk*-+NGnkB3+dw)=-8#1}nk{Q<=9(o1S(u9eA!DD|oHUT7P)L+%}%-5~VF3`cJ3R&o-c)q(4O!nV& zU$Zf%#|pZh>F2&EQSX(c97b)EC%duN<||iC&1cp`}IE1-ja1hw@;9%pBu42a)30&-L-IjliVj zuM^56=qmu-{ZOk`>OEv$U`9&;UUC#!$dUdHAf3t6L@cwW72< zc3zi6t~3;KnKZe`yurm%Z1ZkPyB0Ve0ynH0XXTYh2|AM`2)e2;eWwrQX32Yps z93a)ev$d#ut}=%mCRL;l=GG2*uGv0;Y`Y?ZUv6Dw%>wM^E-c~-;9(X<+) zZFa-iycnk}&Q7JJ)uK`R(5_)&BetY%16qNXZ=ljmJzQTK6DAn#ROoxL#n9|*xnt9> zoO05u@yOY3pde6u%=4*Y7}^T7%b6}$ae+kvB+_?8SS= zlySz1&kTk6^!M4?t19;9hp><#*Pn%Cai^jl1 z#405tHQdBjSpO93;>mX3Lb&~bbo*Mt@%Z7Nt{zFzK{7n=FjM`GF)06r8B;wwBSS?8 zyDwHIzoSi^s-*R@C_?+k1Mh_^-F$wc(ht)?H;|#MU?1xEed_qFfkiBd2~mck%lOYI zoP6##@ZtP$p?4;Qsv68$>WnD7^&X-g$EK-i&Zf~qZ}DyGxmF&G_tJtm?~IYNcy?{K z0tDtC>!#|^;a6-9!15|@W}?>DUc2=}Z2WSzgMiL8xVUT1Zg`)wSMd)u39 zmt|HMve-Wng}eB~iRp3Mf_n86afRrg!Nf7_>u)Vr7+*8FZ@KvPt=M1&SKjPug-L^) z55;?DSbMD1x@GhpI||d;=}*;&R2j^idqka`J&pT3^&{6HUmkT$A}(dJl}nJU>{lN2 z%pQes!SN)K%~^JtU^eS=Vq7#)KCH5_43jGAxWrVM!+gylL-?2%0e&*mMGjXaue<{7 zLAT+#3FClM!}L>dOqtu(fR3>wv17=!fh=l=f>-kUDBO-FTl~=76}dZsB1aHpZyDhj ztNE&>iu3u~^Bg>Ud&gUK^MuJb=<8vc2hFd3Xl$B6{)u6^0>`f8I% zK4o{M&Z@*R#sCLbWhXg^ZtN8n^a9bu(-G$71ZXW+z4(wM$Ho{$&<42A*09TeV3P-5!;icIwHYV35u+s3 z)o3VEcNCQGe>f7I>INlR4C^_r&Bu%ai|=Na02F8&^)lq98`B--#hIIqJ{zih?A&BY zaZWf0Ee-vigxK2syabuc-4X?nQ|PhUoOa)3g(%6Ni&8p~0J657;^o0}%4!5!xn4v} z%2}$!J4stvzs(}&%cMI(JJrf68QOegx@xeB8c+Vw$M-4Pv05XcF1~bGg0@zuUU$(x zVMEDg`XpfwES3kN*qPE%$829x+4TbfLY7)b(icB4*;OP@ohcEzyD24Rn62_t6A=c#bn2N9hP2XzfnTHr1Zm1cCJi4XEs#w9D7sPtwIJGq_pjVqJ z+81Dx4t5^jfQv3(i>BhNqZ{x8j+)VpYkQg(`ef**#d^FsJ=ACGr53J4+_9}Agws?& z!k4&s3oY1w_PDrjaGhdkH>RBT60J3edwE{uu%=N~pU)oT1u_X)Gr1C~&Cde-@t^&=PDa4olamIl86e$O#xS@93Q~yN{>Bd=G`HW!;vj+ash{r-Z$R zMWiFgu^ZKBd!CymQL>lofeOUqp2C-W8d<(V16JI>f{}|KRaQ-Bk#J;vwY~Z0#))H6 z*IViL0+GpkF$wX#m}F>eAZKT7V^3#bZD;gbWb@uW@xL0d1bjN9kLaeum3G zmm5wV2Up7-$z*0geCus2Y%>rx{q%X@_LQcYU?e=MZU5)Iy;Umpo#XB)f11J&N({a* zu6U&|MHoukp1HR#w?PU@xdM`c1K?}o;*D}Q)^I|gNd@L)1L!tKEOR^?#gfLdTsZ8y z;F#0~_H+nVfw}Rj{KqD}=P*>CJo?ry7B$jjqb88YF>ztB{0*YohabxD2-rekEaK+$ zP>`=T8k6-8*Me12>5gCEBaR)yxs0HBgY(?2ho=@AEGNew(P{a*@MNRtJe51*S1Z}G zsS(rdU`Hu4+LWbSsFYF7k~W4~m-YI>J?)Oy;_=Vm_kTz(%0D52VEXUtPv!J}a?Ro? zzhW8Ar4N0%7$>vE4T$e`kl}5apEz@72omrdz2LJw3u59U=1`w>kr_JmcL6qpYQM)^ z{H^QY@7cCJKjx6McN@fg?@d7XvkmIm*!<4~-?!}FBRy97y>fyOa0liF;ro_b+aBlUPyY+z`+wr@3T6s@$ zxpP4Bgk4MyQ+u7&=iueB{crGulAx9T{an<&xN%Lh*6YQ}KY@tUr7%7>DFvsJQ|C(+ z_M=UQFGq4EMA0A=*;08btAABpTWLHH&)k0q=*7vQs^Nwf6Jp?`<$TncnNG{3TeZCP z^{szI7c_uH=ulW!L-xEvHDc2(C(1fHnHks3+fgb^wvX83)mS>#9QsoF0~}NH3Q|iT zPHt%5uUYh9z7ZHJP6daClX=G=@dRFbob-M_f+^EO9x-%E6jt{uE?<2yr_%KwT&&@;*4Oe!gk~K zjPg4CTP{~_p7j$uMjp(`SV*$qKl8oA=D!RY2$<$QUi;@Z(f=Iaf98K^8kLj$tAf8a zwEai$w>jzEOa9c}_N(BpO+J5!w!RmDe`)#oRrs&11%HSF0AJsO)&GB^!LNFLtvCOn zsR8Eyy~N+D&%bKXh0LGjPxN@RZ$|2IU+NrJtfE&%Z1{pa&;lO&YC G{rf*P0*i?N literal 0 HcmV?d00001 diff --git a/helpers/functions.R b/helpers/functions.R new file mode 100644 index 0000000..617366f --- /dev/null +++ b/helpers/functions.R @@ -0,0 +1,106 @@ + +get_dummy_data <- function(type) { + if (type %in% c("text", "select_one", "select_multiple")) return("dummy") + if (type %in% c("radio", "checkbox")) return("dummy") + if (type %in% c("date")) return(as.Date("1990-01-01")) + if (type %in% c("number")) return(as.double(999)) +} + +get_empty_data <- function(type) { + if (type %in% c("text", "select_one", "select_multiple")) return(as.character(NA)) + if (type %in% c("radio", "checkbox")) return(as.character(NA)) + if (type %in% c("date")) return(as.Date(NA)) + if (type %in% c("number")) return(as.character(NA)) +} + +get_dummy_df <- function() { + purrr::map( + .x = inputs_simple_list, + .f = get_empty_data + ) %>% + as_tibble() +} + + +#' @description Function check if variable contains some sort of empty data +#' (NULL, NA, "", other 0-length data) and return `TRUE` (`FALSE` if data is +#' not 'empty'). +#' +#' Needed for proper data validation. +check_for_empty_data <- function(value_to_check) { + # for any 0-length + if (length(value_to_check) == 0) return(TRUE) + + # for NA + if (is.logical(value_to_check) && is.na(value_to_check)) return(TRUE) + + # for NULL + if (is.null(value_to_check)) return(TRUE) + + # for non-empty Date (RETURN FALSE) + 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) + + FALSE +} + + +#' @description Function update input forms. +#' @param id - input form id; +#' @param type - type of form; +#' @param value - value to update; +update_forms_with_data <- function(id, type, value) { + if (type == "text") { + shiny::updateTextAreaInput(inputId = id, value = value) + } + + if (type == "number") { + shiny::updateTextAreaInput(inputId = id, value = value) + } + + # supress warnings when applying NA or NULL to date input form + if (type == "date") { + suppressWarnings( + shiny::updateDateInput(inputId = id, value = value) + ) + } + + # select_one + if (type == "select_one") { + shiny::updateSelectizeInput(inputId = id, selected = value) + } + + # select_multiple + # check if value is not NA and split by delimetr + if (type == "select_multiple" && !is.na(value)) { + vars <- stringr::str_split_1(value, "; ") + shiny::updateSelectizeInput(inputId = id, selected = vars) + } + # in other case fill with `character(0)` to proper reseting form + if (type == "select_multiple" && is.na(value)) { + shiny::updateSelectizeInput(inputId = id, selected = character(0)) + } + + # radio buttons + if (type == "radio" && !is.na(value)) { + shiny::updateRadioButtons(inputId = id, selected = value) + } + if (type == "radio" && is.na(value)) { + shiny::updateRadioButtons(inputId = id, selected = character(0)) + } + + # checkboxes + if (type == "checkbox" && !is.na(value)) { + vars <- stringr::str_split_1(value, "; ") + shiny::updateCheckboxGroupInput(inputId = id, selected = vars) + } + if (type == "checkbox" && is.na(value)) { + shiny::updateCheckboxGroupInput(inputId = id, selected = character(0)) + } + + if (type == "inline_table") { + message("EMPTY") + } +} \ No newline at end of file diff --git a/helpers/init_login_db.r b/helpers/init_login_db.r new file mode 100644 index 0000000..3031bfa --- /dev/null +++ b/helpers/init_login_db.r @@ -0,0 +1,19 @@ +# script to setup authentification database (using shinymanager) + +# SETUP AUTH ============================= +# Init DB using credentials data +credentials <- data.frame( + user = c("admin", "user"), + password = c("admin", "user"), + # password will automatically be hashed + admin = c(TRUE, FALSE), + stringsAsFactors = FALSE +) + +# Init the database +shinymanager::create_db( + credentials_data = credentials, + sqlite_path = "auth.sqlite", # will be created + passphrase = Sys.getenv("AUTH_DB_KEY") + # passphrase = "passphrase_wihtout_keyring" +) diff --git a/references/reference.docx b/references/reference.docx new file mode 100644 index 0000000000000000000000000000000000000000..394e6a25338d4b42ba9793a3856f9279a332e48c GIT binary patch literal 16815 zcmeIZgV;uB&VonK zX_W3o(<<{K@N9^fru?{BvTVLW#ZcMEY@jR**ybOn#6@E}>QgCk?1L=^YB@6P zmuUfdh!D?PU9tO2qSIgq5_0oVE74Pq7`ket!Bdkc6WoAlX>2=w~hF_MD=5uFo-$jA=#-2*u5t#eOd3Xyk!IG6YR(1#aY z%D!wDkTf8%liGyOb2=WPf$9P*grHYu7#Ykf^oL9_;3iy9BXWU1^337t1}M6C+R9OI z-W%z)_0~8*<9jOODQUi-z%gf1)lBz0wMy+E-sGt}q3jRasEG5{a>t~fBWfG$$i!X%!tAlAL{nMEK)Ls71i z`pR9VKU@AsmZfEDDP13!3IU1kaH95UJb!p|p}Gtvo}Zs_rC znVBd-NhVeB_?Mk?-@S`^%7&uC=-~?BqL?0i&GpcAUXG#<@q{=pNVOXccN_>n`XX0v zhU-7|qi^}%qy+{5Fr@(i(B2-3hl8^zlc@vH&F;;v{bA4+b=K_nTG9R98NG;H`g}lW z!p}i$)LH;L1Q&Vlan8mt*NiHSNzFUq`<%FFVi#{V0`~CGmn^kpyi`tGFZKBN&Ow{D zi$sNryGQ>M*SM&tSLhza)>p=tM@;_)92IF};sMN~Z|*VLr;9^oc#1iYfyO)=q{%3HOwcE?3Tbz1NVrAK#)hwq zU%)3MkZ`)D#A4ul&H4$IGKz>OFuRDD7aK$n*OJay65YX28l(ucDRS$LI0j`I7 zrLY%VAgZzu;AZa6;8+e8>x3c>T99iwhXYfCTSfX>Vg$xAnx0xTax1&5_D^K#g66#j z>URk7y5<^-d%g2c=M$Ui z+3F&;nmspQTDj*|KV2g$Aode2Tjv<5P81LA^@uI|m=@$a=c(MZ+X3q!}zt27Knc_9b)54 z;i4_IgPd+R?mD9D@!OudUtI~Q8eu!1! zM|JWlzMxsKzXxB_0lNwFz0%`gKaH&+u;iW)`G`68_dXO{eAM{6oY$)iDp zOM5v5@U8xSh*u$WzT#SQ8-5s8ioI@F(bZALCpTT2kDgi71Mj-oWLtBLQ}2*h-~%|O zKXhZdB;-=-NxyfKhKv2i^JRss!FCoL)%upi+jXEJB(3LRG#sX%Kz;);gv0K6> zHqWd4QA#^*^6QRlS-+D@=8t0xk?x2ms$#+B*AF)p#kXfdh;`$8?twZHQH}Ljh7i5S z7(m+g>PI4M!6Ushb{PJ4XhPU>FG9;Q9?NIu!`?*!jU$vJSFs=bIF?`2xB+E6v%`N* z2wWg+^v{fhm{Q@$cUfqM+s!P10HI*)BO*gjtYgCXy5T#L6dyX}=N;zX3_!xf!|`uy z6JHDm*;R`M3>EF+6XL$H8u^pe+q<`GB_UK)62wP7Aj4Fg@C2DdY3>>+k;^$5#qyx4 zTyZliy39TpPX?Jq1ld3i=)ra|U)!=M`*mvJ3NM9-b%I1<-Li09#=quHK#ki7L5>4jCQTZjn&3W2OIGsqiq;b2(rx-L!fgnl&&D-7?kR(&xH;9YNB|Wa9Lngt=BL_ww>~ph3Yz(~NTO?O(-KHK>C|G(n>*)x} z>qnQr`^~A@K+TTMmGhr#`q)a(Vm*q>@kfoj&;bNTTE*1r?S| ze6s9y(o3NxosvfBXWADp4ght-$xaYF5D%K|qX&S_~ zVVb*hi}Z?YdfocZX`Y0jMSUTE_7OF=fnQ6z7LL4JSbR&x0!e7OHd=Icj{II`G3RWp zT}FM_CMpg2@|oNff|F@znL9>oB^5Qst=l?Bv8PKEimft=k*0nw@WDUKB|OtL(A2T1 z<%bL!Itn^ZfYF}piIu_)fhUixDM*D`4rLnMes$H;ax@Pu?gH-ozK8B z6n4OlkkT)F9A9YgG>I|yk?;m2(%RwF-P2j!<3gS2Pr!R=OtMbX@(StZl2d;BJ2n30 zA_;B=Z5tw$AK zHkfWYoSthkPp_2J?BmnY#77*mWyJzBGMPueQtGtJWwe*rmNKrO4MB~@25CtgSxn%3 z!gNZZ8()Vy4Q9lIQubpik%gZfmzP5tW%^jBgONbAGWry_ogHv0B>e47V2f7%8+|)dgleQ*MK5Z&UbWRq-9pfkaV2L6uj5y(EK4#Z( z-2OPl(BK?f_1)XvOFM+Pd5(xA+|4e5?9>rKPDt#fJYSd3Xv(^M%=vx-*fWzyo?nh} z>0d{K@-v1>umwp0s_g7?1**fSHP1CM1@92M*rA;cFm@q!R}2Z*P)CH%eS=Z&kda5a zpU^FcLipRG=idLL2s&L7Yd*dOVabR90Q%dEKSj{o!NJwu!PU&=4^OiyeZzT!1U3AE zZ^2{M@q%P59wlq_Bc}py+X=-n1ZpUQ{Gc)5{_S$(8c4JT`U9Jj4+?Q24TAuW5c^SN~vP65cC{Kl@jm49=nV0dAL@b~B=fs3` zs>X<8i5!EiL>tW_FvweRo#Svkze0sU2-o&Ae=8iuDJoqp{~kycBAj0#)=n(R+t7N< ztg=cu6`nM#KktiM?gH|>3zQv#bhR%&9PBUqYNBwhTO$e37%cs4mA+2S{A?9RTJA}Z z4_k!~{%!;Z!#r~$(`>J`bd++uDU$Y48F*3rp~UaTnqF(!K_}BbXsyqDc)7Vf;X>xB zshG#2AKPFc%WV4tja+gC72jn6`!_l3(Q`JKQ%{YAjmmtBPtSBs)f0ByV2`7pZ{saW ze$GS%Z2`H63hTa+?>vK=(2?K&V*f$1(g-5BmJ{S4IR%ua-gMGi4|kdvc}LriNc)7V zPtkY`InAd4Lvnd8i!!lErkO-T_jDqBc&@M~200ZN2bO$7a~SF3>)z#JtEIoYAXr0d6s=_p?-*Gs+TPp%jG>*13DUqDrkAI@3hNi6riPv19 z;aj|Tc6w$)ezFX+nZ>SN+LPP)%;K*@wv`ux@bp+}HN{CWV_P{g*F=|9{^L6|j-66P zVU<~Knp{b3`Djec_I;7>YwUw#d*CRO2U-z?L4nq-@os~c~6CB%|pHcMHV zXMSaA{7L*>qNmrS1{C)^C|!-x@PP17t2HQp7{2LERhr(Y{}Yp$*_-~4rVOT!*>5nT z3SU4ypah>IQ?C6WTSbQFqj9Fox`n`vZVrt^kQ%Rl?G~%H--k|i{)9p%?@Vm5gV^TJ z-LS}`T!PWZRTFU3hI}9{4ku*)WveHbN_J%q`U3a)7~}~5pABL6!C;F9hI_?JClzL7d=8ulzKcYT50>b1>U^|SS)VT3a63hYUmkM$dtu8ZXaHA;spIOCGZGeUB6&IPVN+GNL>hH!hh8%H_@{e{18`Y=+*=pH38aF@m zX}WPJfT`L2Hd1q#Pt>jP7;9=UoaxXhPDng{`+*p;CvI)mKBenDG8^59VhE>2{#bnJ z=~)4C*ImSOjggXt3Ge|I+BW^$kSzoW&QobF&$&Zo(2zvEpxN9Ei771&MDg|0W>B$( z&Ju`~Ha(>={>Epy_ikJdtk4#fEOXg=bvW9v&egQg6SpQFt-gMB8~23DiarUM?XtU1 ze>JV=;D?L!jee9|^IPQAc+}i^cw4|0s7`t0);F7{dPq5pUcpGdbCrY;W~e#~t1=a2 z>l6*U%0$S!fvNA!IBZvC_kNsEx9N-Bqk_xNSv?9z_B1VH@>B$|+d;)AlN`uCZOfxv zxBuPQ0SL+F9LTn9dP%OGOlJ*{LNtk=Fv-B1$SFlByvX zu^p95y+-{a^KLyg8!d%$XOSP(v2A8JXkRG!=@?@&?l`@<tY=^GX2obqD6vy|yVXh3!kvENQsx`IFVAh$>Kb|3|{zJ^U{f15EujH5EniqSU zZ7!rvXtRW=O%8?jJ!PY94r(7n_e;N(cdi7`1|jt$%gEh4=Pl25K`Z%@+op9f_Dy^_ z8u4F+4^#D;`a7!AH;4}|!PS{0G^z3;E3{&E1jeb*^K%fO6auwMERoC5R}`TRj6%I+ zw#UI}Sx*AhUSH8v7*PZ{0Jaw$VlOiCSjDlPDvbqq{Tz< zrYD2&146+yZbOeY?&(u4gdzQU`I#&7i`hgrh@tmH*%p98O$jkxWz$}BNULl7G4yt9 ztvJ;lxpK5sVf&BWZrvpq%pEJLjP-u20nkv8kqPeQdRkLi164DVrKd|gau5N|29{x#I>L)HhID7p*Z z!^}jnIx@?=lfsCJE}`sEh0R&fY`RkR9Kz{8z;X__JS+O=Te4ID(S=(`oX_=A7}^e%`g%e3izgbNK5MT)rk+kD zQp=ksTWU!)uH?*+7HGON(zjz{6P0u)hrNtCe z)WloRYj)5!&~y@br$|5{vtyo29cD~{l5lqJa_iROST3UY(Ii8%YnxMo+V60_m07cdgX?f{QQ+=&Osp zsV9(9alCqJ*4fjQsX6KPOJ6WFdtY=>tP%9-b7UpQ0$c;?G8 zQs6vqlh;0jqXJPyb(`xh;v1c!4W^LwygzLP16q`nQd zJ&$^-Q`ETE_1WyXIuta>SkEYBuTj;9S!t^Ece%Jk#+UEhkzn{aOH_z`jZlE14p_y`m!)Wz+tgzx<9pyh+1?|MLCURvu?c zZpHAstLvl<6T8{2fPajNnmqPY5+MNqaHPMvdM;+Ju2%LIe+EUxnz}B#oS6O>a<343 zN9eYU!?TopVEt4%iBp5pkMtYh>~llpW2nswuV2a6`cYRIYz>25yIllxvg1LDd0TjP zRds6Omq|E!_XZGGYNnw~AHJSURN;9cm7vX_Vi6{EGH84~Ix!5mZ^Wam;`me!t>nmI zdOWIYm4l+okXFMi_FZN_6QUJ0nG{L4&6b5?E4uR|d^)*2x@gqb=JoD(-dJ(CUSazK z(S>7Dv|;E7c5>k+btE)3{-7}aqc8KOwDZBnHD^%_Q8d3uT6L22csOqxYymZdV-Fuh zs_@*rvwMZezr-c3P45!k#fmUWM5hIVvwSC{=oD=A5pU#sgrBYvZB#QN{^j0u;dQ|p ze2XTMxqCOkT^L;imHx<2(GmOp%a26fI+0&4)2C>rLlT&0@mB*+xK{#&Fe8pS1(0Tz`> z<~rP36*L;bkl`|J?*xsiRQkMFTchEQ!IQJupfq}d6^tgR*r~Xaj71KXGj_43{GtnB zY^{h)=zC9rHkkdn`}5Cl3NJOoF+cjzGK1LtE0%?i3wA+5TcuvBt)h~ zR*O*)hxsQ_`(?*)FrIwefuj8c&1Awoj8(GbPK9o_y~>nq>LHr!Fbfko%p)W6EtPMl z?q{Bsb@GdF+9yz<-4su?ox{$}7v2~#zYmY^){o(7Q$)!s_TD>&VlG;(@yl)Zr83XR z#)P3}A;jhFzaS${QrJRA$fT_jFF#nuc)2&;_qtHKvBQKPxEOri{khP4&6h@?wlHb+5$)EINRv_VxWU^a?sj)nr9?e&&|^&I(OPj%E2 z{kEt!x*<9qX(}R)#-)w5p{Y+M2F@gk;u8y3o*+X}(r63I4zeP1C!FWIsF=Z^DRVe# z=muBlA?Ls|X7h_#Os3PU=_I}7&a`lTnlQ8cRXj=YBg`={r5D=Fi={48SVOLN> zdCb%)>K67c?axG@X1Z%irsQ%^aouM5S55c9mQ*3G4sG-}XwvGenE5|=8QfacBT5o; z5T_2HyW{y{Y{=K!YHDqmoS`=mq-JRecjzqEH>aE(yMd}yC)yR3tIY)7pDfkSj)^`B z+wGKxXQ1<&J!p?4>mkG+?#|uubLi`NEX*?rq4<Ggm z^tIyB=6PPmNx(nu9vVV1f3>$it+J@9eE=|^!0#xg*%W?{L=aTRtEdGk?ietSpe>$&jgi}qI~d6v zqNEB;--Cyh+!NH?sLuV3w8xVlFV@GrGQeCQEw^^tjCk9H!&bLfi=x-mvUqR-1Y*s+ zUt0AS(Gyw;DKjWzE&T@86w#=-?rBIdlLi{L;9Jo{>Pz3x_nOj4XeEJHa92bc_7M}v z3zltzK8~Edux3!{S%mS3uePJ$oB0Q*n3I5@{@!S)1wgp7))mQ;TRv3gWL z=8RfPw%VH`NsAg2LupEA-;_aQ%ZBvzi@F0bYJrREXLJE3<WK$C!RqR0>NDt8E(xMD#XJbP%2zvtht(l#A)<>(%l_+tnkN9#rc7`e|M6hnMB zsc_h_-d*#lTS{5;gU&tg`oIs*&FqY6ys8>*MHIxFc2j@s)?n2Pv*Uqugs2rv)?gKv zd>xQE)FhKF?*eB|%r7R(yCM%RcP_)Cn71%1c6H3{?3CAEyL(fHYsqiC({(u}OH%Q6ko z>vfOct|BPvUtBGqWh@`GI65rWbw1n3M4j8c+cBsUQ`masXz)w5<=y)pVM`XWU(>{i z3UDn;Q=+24Eh^F;i&GHOZkwB*RMau*wlf$!>}axI{RH=12L1XIKiNnw3`O_a7q9QY z?3Xfo#U52=0eNRtE2I;<*azLojHS9$jK}PF=2(kwT6zXB`#d@aUqP%1OrOc& zKb#QG=N6E+b;gHr=^Vujfp`sHV2H*nb4L0ac|S1OA1H(^JY~_Xb7?lVoi23R=Yp5A zNq1%sqCDN!dpVVF$l1}`XWDHToVWD+qheB6#pWO*0|3u~007Fr!fO{-FWdi0weIV$ zC2zE1`6;Tu1eJK`R(EZ1oRu4VsjIY205-ABpu#nAPf3uL8yq?jUqN`u9N>V=tW^{! zxAO0cjP|HdF&QDf_NCiwqX6e%jx%792*E!!4TVC3Tq05y6N(lTE{>H)`jQBI{9Rqv z?;ZVa_FMOg@uK-L2hjx2_;(wxZmzao4l5rmtZs3)7fAui5A?2zd@=O8f+y~(9zkNM zf^iw#WFN1%;glsAQ?l(NlQ))rMiE5Frrxs&T{eu^zkaj)g2o($EW@Ao$k-jbsUBGr zyXJvGh&sqEgY&{VHFxedd%icQOH~)Mkm|~d$ZZh$^eONdi86oIBZWKeXiaqeKN)&tjE^qB6_#;yn@A>XPbFB70quc)`qzf ziuw7`@RJu*@}PbxL%iQ__Na(Oz|<%t(d{ zk$a~q7?Y&OA3)U6vYKs9vDfG#t}BHu)ajk^%SqI{g4Hfs?6u^=i@PE<2D>|=M}Pa9 zSacWb^PQ$`JsO;SXY}Y@pXsC)vdYC!NKA(7cd|CLLcsu8B=Dmw>xlK@v~_QG<0fTw z#nvvk*aB`+Oa`jAf&Vs;aWmDyhdKMG zIQ!mGAYHc$lUdVmU+1te>+%APnq7x`ZI5Gv*5>gb8cNup&1Ee@WMO8GR;NxkO=uIF z*)@Y2J&K}O2^pnHQu%d)ebKfFFwN3uzf%4Hg}*q3g3Bf@EYTy-GdA;p7?OL2*lgsB zv^Y1+WZmdXH}OuI0vbj^$KZ3DwbcjTeCwJ}yS$n(y+Z^7unyIE?cz45*S8GRzMNc- zTWv>iWEt@2cZ$fi$)cX2_(vn{Kpu0UuD>&(&vv8@a#cl5|^e#%_6ihZa&A>Kz1sCbQK^w*zzn2 z^$k$KsG$$xh!m!^fk;u;jHMB!J^`&4RU?Q$wC-M(IMm+d+Qed4qHY4UiYachx;Ru} z^EXVB{SV$Sb(5ufFwMfs1j)KX6v^ws|2O16F2f5R_2+%9%Tx}+*V05T*OtequK-lU z^sCyTxAEcYn(?Ge?C7e{E7Or$(e?em-XFiq^(5(n2cv?w(g2plQfAB+xu*<)^a8r~nU1n)%U?u-`1uQn3b0g*SVM}~kZ za0LvkRU~qYuyzwS@S-z2MKav64t?qZ1;_m|ggsHrb7G$$Z?j=Xve+xognem^w+AZ< zdJ!uNCO?^P^z$h*kPDZmqvfkjz)GsgG9Ri5H_6`y0{y z#pM5oSm8GS66fHk5JA+OG>)l_COr+;V+oa?#u5v$EH|;kWl%>&ETa5a33AbDRHKxS z%b&=_7s-(10FP9pLTMQCf(j`wu?*b_0K`}*Mpo9QvPm_iB1EIvMdCgOdH zi$TSYuG59-rgyuGUNILrcTSO+@75|;oRKf&Ua;A1HqyUho?S?v8E&t${KO+8ehh!e zJs``)--)P_8XsZYAy+(!YD|vi|1gQ;or}g~w`J1lD{F0Pbsemfpz5yPJtHu1#ZCH5 z7`sNduzPb3oJ;gfOS;`z@eol?am@Y%ObMOR+@AAr`YBqh{Pa`bBg@60^W=P9y5!TI zH8&nxUv0l_KPfVBLH?s$o-juK6+_*G9r-}LFU1uW%VJLgHGxwUb1EawP?nMD1xtd!7cWhZkay?RemxeuYCNG z%XHdf`t{=_iUTpTS=MW~9L53}83)kYcT^6gQjRXlT;{b3!q-*w)pkBN$v&;v@bS7O zU>cXF6r`96iV=Whn|^O7c+{qQ$I~i=Gch8QKE&D=d*B=9szmRwmv;Qn5P$Fz`Z8yH z?_7qp9+hmiBgvMo*e#y!^5NX&di`igAJs&Ep3VC6x>mA>`QXef&&6A&t}%~xdGKY5 zb9u3P@*Ag>F2cc7=(@vf`C>6cnJu=X;8=zxn)*W5F9H6q!WSY^+53juB%UFj$DZYk z_}e^0PDeif=A*Q&7+Mh3cx3zg&FmTk*BWZ;5Sb&M8bH2ss!hqjX* z`sye8mc9_MU~tHnn&Egje203j*5yiB&n#_q6Z&|8(!%f-Xi{>9eVmLjtB1B&$1;-t&V zQ>jeFs)$O8^&Z|BCokrV5^^;4kZ=mQ#{-?>_d2SlF1Ok!+}a?VJ~B(=5B8Q%G4DpR zPsmj9Pgu_oi>tL;B)dAqSybAhy+>Cj z)28v%oyjn|3!k~C#u?jrr5qnzybL%<=DeAlkDZ3{4I_(^+UL!OlC!7uS^9Q=qdd@^ zmL6k~U8Ib=A_?p+Z9Y{jp>xYwt@jQS_)^)Hz}qmU?&GM!gM5ILiP)5h*Z)x&x}yh^E$*QoSI z#qD#PX+EW{fEo-iDSw0={>aUZ^fG6LnYz?zNP!>kkh}*b5bQtsZ)+kfA7g1U`K-#m zTbkEQ)k3@dl4j`iVQJ5+<{|6qz2tRvQk)%$8IH|xR?8$5N#?Z0U1Jhwt-DoXF$=%S!{tAyPxJO7k3MB7aMdzRT3vkm zwI}KF!2j&$JENz8N$%Z6)VLNh!+J&9y(_F# zQ_%9Yz<@&gP8;KLO1r$Ny}gBrel#k#Uetd%mVE$%F@u zk3EoWCd~5QJmD8#jh8*JM=y=KSuvws-WRKozzjpXR1$;X%lT8bI+@}onU|(<6VcvI z&OmM_(v$0+=clrpgcC)f*V-4$ zOH^NkqISDy2nBQMs{sTR18cY3${sxyRPh=N0z5OjjG+ zgQ{i_M=B5#IQtyy>Ig{QML*_P9?fz~tGRwr=v$Q#elrMg+3DPeX(S+^m5ef=;9PZr z+B{;Cm{nce555?hjk%+v9r6`ebe+#qM+Di@`X?!}84ih{ZUG$-;^HiT_{3sMu!49A z2~-)`kTcmfdRQt4F~gECR}RNlum2c28j~>xD!ozK-tsz_{|X&F%uH1OmX!uA7%KKN zqXI5HFnR{&J*e|h>uZ0Quy^BP+(4w>4&!fpoyUgR`g#Hh+6lX_|GK=%}W3=!i)NGrA_N*D|(KCRMK^wc!Q3lslsTKmVnbE;P!|rSUA(Bb4keFmNLR%VC zCD7J+I;5&Ent2$SP+sF(b>#K;mM`$HZ8nnVcI1U$EsOSoW~fr2_*h@?p(r$U@38E0R9!oi2k&OsdEu;Y^&bmwb@~63RWpBUHB&P-u{HZ6tG1uo7r)N@Rw|YD zfUJBj3j$~h6KLqWCwU(itP2J@5t?u`lP8c~-V*TzO~ETke};;Zdl~c1y2m>@z9*?P znn8lCu4g7rV&0BE*860K{o-vXG}#ZJSLdm2+|~BnM-^o1@%OUE4%5H}uhOhdq(_jo zIg!8wqiZW>p6Afaq;E`G+^t@dOwQWscnGr6R;A-CM8CzQ3@tW}V7XIrRfZilfDh9aY|3UiSNj(g~UE0Gsw`pDpi z`Uikq1XwbH@c1udT;MVbS=FhFxL|BbE)Us-(@XV7Vv;Q+QHnj)cjvp~KJ=q@2FL?B zFGZtEDzdWhW_hC#NZbN@@$>f#YrBscR$^RO$&Ml5dcnORn@rxvjDq_xpF7a>0z()& z2C&!>Bq)~yDyyNHR@AJvSv5q}q`YA&I89xXm)Bqc3ddsryxl3U~n;nMc1iJiE_R zQQ|MytdDvwcl4!@`%u0@3N;mf4=0C{9?O)QOQRXyBZ#lkSRrJ|#|^lNi8eew99GyNQ2b(vO1=k3Fz!s@UB9@pALxKf?SdvutE6UKe{6phAmn{^wP znO|#=lO`gGsE-sN9;^xGCXw*Er+f^q_41E8{^*z&X8T5Ic#|@;w|daGB2Xn~2S*ns zpo8rfwy9z z0-BDlG4V8b;LcJOe3j;QaCoskZ3Uc;k6{TeUtM@|$0zA;!+Q9-&RbF){a82z-Qa{6 z&Iz)Ydd@RW2#A$IkqS~Y(56jI5-^G2Vqlb(7tC?gf))a+^ZE?mK!#%~_hL|*MO{3_ zcM3>-?KMT-ixSx{G%q@xoo+?pGA$kGfm&1&-_w`^56(XBh_uAl_IA~sI-RTxyPF3r zF}g!UtZN->g)^yHAFY&&A%JL2fuWBt37 z6BO?0fcxyacW=-6KTDQhKB^6Pyou<5&f(lk>bBz+(Zf}tagn;fXRh^^lgge@^4<}M6iT!>f+X>N(E#gVSvgrkGp}Tw9 zOsPa}L7IYt)c)wbDaapuKI^|W-)ll=mT?A1={bVMO^oiOWNn7&TUPJhK$EOiC*A4u z!DWJ^L?O2n^9nudASC)!MmW{)*!Q-QPk}~s*0G@0?!Ybt+Mi}%RiBL(B1udOk$%Pu zVb!9A6I{fllg-)R7p3<}XqKGbn{uBV2E`=+!d46TA#>tE_PAo6v+3t~5GM$%*y2Q? z4&7gnVBJ-4zbN?{z+s@RqJR;scpFQ{BViqP4dEEJZ`flPlJ|@$k9H|cO(RHSV-Fp0 zpMQejGf_@@?duor6?jfI;`PgF;;6V_3n178H+*avvzV|F*|Gv|5grf|BfY+D*8i8V zf`K!<`A7fU8vb8@&0pt#XcSkH{dWfc-l+N)^lg!TbHx7Ew)#8p_YS_lpbKyHb^p=N z_dERGTLbIKd)ez>c#Ahb^iTZXi(r3; z|6Wn}7hLwOHTX~X@AZYhv-rIl<1ZE}#Q)9W@3k4f!++lm{R@sp{@?I_+Z+8I|NExR zU-$~De_j56ws3w2|L(T`1wLT^Z}4wU{O=rocRT;$V8Qv{9RAG-{T=`BPQ_nn0AP&! st-