andreas/FreesearchR
1
0
Fork 0
mirror of https://github.com/agdamsbo/FreesearchR.git synced 2025-09-12 09:59:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

minor adjustments

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
NEWS.md
View file

@ -2,6 +2,8 @@
Polished and simplified data import module including a much improved REDCap import module. 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 # FreesearchR 25.4.1
Focus is on polish and improved ui/ux. Focus is on polish and improved ui/ux.

2
R/app_version.R
View file

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

6
R/data-summary.R
View file

@ -71,7 +71,11 @@ add_sparkline <- function(grid, column = "vals", color.main = "#2a8484", color.s
column = column, column = column,
renderer = function(data) { renderer = function(data) {
data_cl <- class(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" type <- "column"
s <- summary(data) s <- summary(data)
ds <- data.frame(x = names(s), y = s) ds <- data.frame(x = names(s), y = s)

1
R/helpers.R
View file

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

35
R/import-file-ext.R
View file

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

2
R/redcap_read_shiny_module.R
View file

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

46
inst/apps/FreesearchR/app.R
View file

@ -10,7 +10,7 @@
#### Current file: /Users/au301842/FreesearchR/R//app_version.R #### 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, column = column,
renderer = function(data) { renderer = function(data) {
data_cl <- class(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" type <- "column"
s <- summary(data) s <- summary(data)
ds <- data.frame(x = names(s), y = s) 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")) name_labels <- lapply(data, \(.x) REDCapCAST::get_attr(.x, attr = "label"))
out <- data |> out <- data |>
setNames(make.names(names(data),unique = TRUE)) |>
REDCapCAST::parse_data() |> REDCapCAST::parse_data() |>
REDCapCAST::as_factor() |> REDCapCAST::as_factor() |>
REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |> REDCapCAST::numchar2fct(numeric.threshold = 8, character.throshold = 10) |>
@ -3091,8 +3096,8 @@ import_file_server <- function(id,
shinyWidgets::updatePickerInput( shinyWidgets::updatePickerInput(
session = session, session = session,
inputId = "sheet", inputId = "sheet",
choices = choices, selected = selected,
selected = selected choices = choices
) )
datamods:::showUI(paste0("#", ns("sheet-container"))) datamods:::showUI(paste0("#", ns("sheet-container")))
} else { } else {
@ -3164,17 +3169,32 @@ import_file_server <- function(id,
) )
observeEvent(input$see_data, { 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({ output$table <- toastui::renderDatagrid2({
req(temporary_rv$data) req(temporary_rv$data)
tryCatch({
toastui::datagrid( toastui::datagrid(
data = head(temporary_rv$data, 5), data = setNames(head(temporary_rv$data, 5),make.names(names(temporary_rv$data))),
theme = "striped", theme = "striped",
colwidths = "guess", colwidths = "guess",
minBodyHeight = 250 minBodyHeight = 250
) )
},
error = function(err) {
showNotification(err, type = "err")
}
)
}) })
observeEvent(input$confirm, { observeEvent(input$confirm, {
@ -3277,9 +3297,9 @@ import_xls <- function(file, sheet, skip, na.strings) {
}) |> }) |>
purrr::reduce(dplyr::full_join) purrr::reduce(dplyr::full_join)
}, },
warning = function(warn) { # warning = function(warn) {
showNotification(paste0(warn), type = "warning") # showNotification(paste0(warn), type = "warning")
}, # },
error = function(err) { error = function(err) {
showNotification(paste0(err), type = "err") showNotification(paste0(err), type = "err")
} }
@ -3306,9 +3326,9 @@ import_ods <- function(file, sheet, skip, na.strings) {
}) |> }) |>
purrr::reduce(dplyr::full_join) purrr::reduce(dplyr::full_join)
}, },
warning = function(warn) { # warning = function(warn) {
showNotification(paste0(warn), type = "warning") # showNotification(paste0(warn), type = "warning")
}, # },
error = function(err) { error = function(err) {
showNotification(paste0(err), type = "err") showNotification(paste0(err), type = "err")
} }
@ -4505,7 +4525,7 @@ m_redcap_readServer <- function(id) {
"Yes, fill missing, non-repeated values" = "yes", "Yes, fill missing, non-repeated values" = "yes",
"No, leave the data as is" = "no" "No, leave the data as is" = "no"
), ),
selected = "yes", selected = "no",
multiple = FALSE multiple = FALSE
) )
} }

2
inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf
View file

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