minor adjustments

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-04-08 13:45:07 +02:00
parent a5e26354de
commit 65327a4879
No known key found for this signature in database
8 changed files with 69 additions and 27 deletions

View file

@ -2,6 +2,8 @@
Polished and simplified data import module including a much improved REDCap import module.
- *CHANGE* `default_parsing()` now ensure unique variable names.
# FreesearchR 25.4.1
Focus is on polish and improved ui/ux.

View file

@ -1 +1 @@
app_version <- function()'Version: 25.4.1.250403_1506'
app_version <- function()'Version: 25.4.1.250408_1343'

View file

@ -71,7 +71,11 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
column = column,
renderer = function(data) {
data_cl <- class(data)
if (identical(data_cl, "factor")) {
if (all(sapply(data,is.na))){
type <- "line"
ds <- data.frame(x = NA, y = NA)
horizontal <- FALSE
} else if (identical(data_cl, "factor")) {
type <- "column"
s <- summary(data)
ds <- data.frame(x = names(s), y = s)

View file

@ -213,6 +213,7 @@ default_parsing <- function(data) {
name_labels <- lapply(data, \(.x) REDCapCAST::get_attr(.x, attr = "label"))
out <- data |>
setNames(make.names(names(data),unique = TRUE)) |>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |>

View file

@ -218,8 +218,8 @@ import_file_server <- function(id,
shinyWidgets::updatePickerInput(
session = session,
inputId = "sheet",
choices = choices,
selected = selected
selected = selected,
choices = choices
)
datamods:::showUI(paste0("#", ns("sheet-container")))
} else {
@ -291,17 +291,32 @@ import_file_server <- function(id,
)
observeEvent(input$see_data, {
datamods:::show_data(temporary_rv$data, title = datamods:::i18n("Imported data"), type = show_data_in)
tryCatch({
datamods:::show_data(default_parsing(temporary_rv$data), title = datamods:::i18n("Imported data"), type = show_data_in)
},
# warning = function(warn) {
# showNotification(warn, type = "warning")
# },
error = function(err) {
showNotification(err, type = "err")
}
)
})
output$table <- toastui::renderDatagrid2({
req(temporary_rv$data)
tryCatch({
toastui::datagrid(
data = head(temporary_rv$data, 5),
data = setNames(head(temporary_rv$data, 5),make.names(names(temporary_rv$data))),
theme = "striped",
colwidths = "guess",
minBodyHeight = 250
)
},
error = function(err) {
showNotification(err, type = "err")
}
)
})
observeEvent(input$confirm, {
@ -404,9 +419,9 @@ import_xls <- function(file, sheet, skip, na.strings) {
}) |>
purrr::reduce(dplyr::full_join)
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0(err), type = "err")
}
@ -433,9 +448,9 @@ import_ods <- function(file, sheet, skip, na.strings) {
}) |>
purrr::reduce(dplyr::full_join)
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0(err), type = "err")
}

View file

@ -321,7 +321,7 @@ m_redcap_readServer <- function(id) {
"Yes, fill missing, non-repeated values" = "yes",
"No, leave the data as is" = "no"
),
selected = "yes",
selected = "no",
multiple = FALSE
)
}

View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
########
app_version <- function()'Version: 25.4.1.250403_1506'
app_version <- function()'Version: 25.4.1.250408_1343'
########
@ -2102,7 +2102,11 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
column = column,
renderer = function(data) {
data_cl <- class(data)
if (identical(data_cl, "factor")) {
if (all(sapply(data,is.na))){
type <- "line"
ds <- data.frame(x = NA, y = NA)
horizontal <- FALSE
} else if (identical(data_cl, "factor")) {
type <- "column"
s <- summary(data)
ds <- data.frame(x = names(s), y = s)
@ -2686,6 +2690,7 @@ default_parsing <- function(data) {
name_labels <- lapply(data, \(.x) REDCapCAST::get_attr(.x, attr = "label"))
out <- data |>
setNames(make.names(names(data),unique = TRUE)) |>
REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |>
REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |>
@ -3091,8 +3096,8 @@ import_file_server <- function(id,
shinyWidgets::updatePickerInput(
session = session,
inputId = "sheet",
choices = choices,
selected = selected
selected = selected,
choices = choices
)
datamods:::showUI(paste0("#", ns("sheet-container")))
} else {
@ -3164,17 +3169,32 @@ import_file_server <- function(id,
)
observeEvent(input$see_data, {
datamods:::show_data(temporary_rv$data, title = datamods:::i18n("Imported data"), type = show_data_in)
tryCatch({
datamods:::show_data(default_parsing(temporary_rv$data), title = datamods:::i18n("Imported data"), type = show_data_in)
},
# warning = function(warn) {
# showNotification(warn, type = "warning")
# },
error = function(err) {
showNotification(err, type = "err")
}
)
})
output$table <- toastui::renderDatagrid2({
req(temporary_rv$data)
tryCatch({
toastui::datagrid(
data = head(temporary_rv$data, 5),
data = setNames(head(temporary_rv$data, 5),make.names(names(temporary_rv$data))),
theme = "striped",
colwidths = "guess",
minBodyHeight = 250
)
},
error = function(err) {
showNotification(err, type = "err")
}
)
})
observeEvent(input$confirm, {
@ -3277,9 +3297,9 @@ import_xls <- function(file, sheet, skip, na.strings) {
}) |>
purrr::reduce(dplyr::full_join)
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0(err), type = "err")
}
@ -3306,9 +3326,9 @@ import_ods <- function(file, sheet, skip, na.strings) {
}) |>
purrr::reduce(dplyr::full_join)
},
warning = function(warn) {
showNotification(paste0(warn), type = "warning")
},
# warning = function(warn) {
# showNotification(paste0(warn), type = "warning")
# },
error = function(err) {
showNotification(paste0(err), type = "err")
}
@ -4505,7 +4525,7 @@ m_redcap_readServer <- function(id) {
"Yes, fill missing, non-repeated values" = "yes",
"No, leave the data as is" = "no"
),
selected = "yes",
selected = "no",
multiple = FALSE
)
}

View file

@ -5,6 +5,6 @@ account: agdamsbo
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 13611288
bundleId: 10049531
bundleId: 10077795
url: https://agdamsbo.shinyapps.io/freesearcheR/
version: 1