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

feat: более явный перенос данных (даты, числа, все остальное - текст)

Browse Source
This commit is contained in:
madeliri
2026-04-13 19:58:17 +03:00
parent 2f62a94afa
commit 0212726b06
2 changed files with 15 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
app.R
View File

@@ -868,6 +868,7 @@ server <- function(input, output, session) {
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
@@ -875,9 +876,10 @@ server <- function(input, output, session) {
dplyr::across(tidyselect::all_of({{date_columns}}), as.Date), dplyr::across(tidyselect::all_of({{date_columns}}), as.Date),
# числа - к единому формату десятичных значений # числа - к единому формату десятичных значений
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)), dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
) |> ) |>
# очистка от пустых ключей # очистка от пустых ключей
dplyr::filter(!is.na(main_key)) dplyr::filter(!is.na(mhcs()$get_main_key_id))
df df
} }
@@ -1044,6 +1046,7 @@ server <- function(input, output, session) {
# столбцы в таблицы и схема # столбцы в таблицы и схема
df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id)) df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id))
df_to_schema_compare <- df_to_schema_compare[df_to_schema_compare != main_key_id]
schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df)) schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
if (length(df_to_schema_compare) > 0 ) { if (length(df_to_schema_compare) > 0 ) {
@@ -1054,8 +1057,8 @@ server <- function(input, output, session) {
if (length(schema_to_df_compare) > 0 ) { if (length(schema_to_df_compare) > 0 ) {
message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме") message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме")
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
showNotification(message, type = "error") showNotification(message, type = "error")
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
return() return()
} }
@@ -1067,8 +1070,9 @@ server <- function(input, output, session) {
df <- openxlsx2::read_xlsx(wb, table_name) df <- openxlsx2::read_xlsx(wb, table_name)
scheme <- mhcs()$get_scheme_with_values_forms(table_name) scheme <- mhcs()$get_scheme_with_values_forms(table_name)
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
# функция для преобразование числовых значений и сохранения "NA" # функция для преобразование числовых значений и сохранения "NA"
num_converter <- function(old_col) { num_converter <- function(old_col) {
@@ -1086,8 +1090,9 @@ server <- function(input, output, session) {
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
# даты - к единому формату # даты - к единому формату
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)), dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)),
dplyr::across(tidyselect::all_of({{number_columns}}), num_converter), dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
) |> ) |>
select(all_of(unique(c(main_key_id, scheme$form_id)))) select(all_of(unique(c(main_key_id, scheme$form_id))))
@@ -1115,7 +1120,7 @@ server <- function(input, output, session) {
# очистка от пустых ключей # очистка от пустых ключей
df <- df |> df <- df |>
dplyr::filter(!is.na(main_key)) dplyr::filter(!is.na({{main_key_id}}))
DBI::dbWriteTable( DBI::dbWriteTable(
con, con,

5
modules/db.R
View File

@@ -191,6 +191,7 @@ write_df_to_db = function(
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
@@ -198,8 +199,12 @@ write_df_to_db = function(
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)), dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)),
# числа - к единому формату десятичных значений # числа - к единому формату десятичных значений
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)), dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
) )
df |>
dplyr::glimpse()
if (table_name == "main") { if (table_name == "main") {
del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'") del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")
} }