mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-09-12 01:49:39 +02:00
improved import ui and redcap import with status messages
This commit is contained in:
parent
3e49868ff4
commit
2800177fc5
13 changed files with 427 additions and 165 deletions
|
|
@ -42,6 +42,7 @@ export(getfun)
|
|||
export(gg_theme_export)
|
||||
export(gg_theme_shiny)
|
||||
export(grepl_fix)
|
||||
export(if_not_missing)
|
||||
export(import_delim)
|
||||
export(import_dta)
|
||||
export(import_file_server)
|
||||
|
|
|
|||
4
NEWS.md
4
NEWS.md
|
|
@ -1,3 +1,7 @@
|
|||
# FreesearchR 25.4.12
|
||||
|
||||
Polished and simplified data import module including a much improved REDCap import module.
|
||||
|
||||
# FreesearchR 25.4.1
|
||||
|
||||
Focus is on polish and improved ui/ux.
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'250403_0630'
|
||||
app_version <- function()'Version: 25.4.1.250403_1309'
|
||||
|
|
|
|||
23
R/helpers.R
23
R/helpers.R
|
|
@ -369,3 +369,26 @@ get_ggplot_label <- function(data,label){
|
|||
assertthat::assert_that(ggplot2::is.ggplot(data))
|
||||
data$labels[[label]]
|
||||
}
|
||||
|
||||
|
||||
#' Return if available
|
||||
#'
|
||||
#' @param data vector
|
||||
#' @param default assigned value for missings
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' NULL |> if_not_missing("new")
|
||||
#' c(2,"a",NA) |> if_not_missing()
|
||||
#' "See" |> if_not_missing()
|
||||
if_not_missing <- function(data,default=NULL){
|
||||
if (length(data)>1){
|
||||
Reduce(c,lapply(data,if_not_missing))
|
||||
} else if (is.na(data) || is.null(data)){
|
||||
return(default)
|
||||
} else {
|
||||
return(data)
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
#'
|
||||
#' @return shiny ui element
|
||||
#' @export
|
||||
m_redcap_readUI <- function(id, title = TRUE) {
|
||||
m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
if (isTRUE(title)) {
|
||||
|
|
@ -23,7 +23,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "Web address",
|
||||
value = "https://redcap.your.institution/"
|
||||
value = if_not_missing(url, "https://redcap.your.institution/")
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::textInput(
|
||||
|
|
@ -32,11 +32,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
value = ""
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
# width = NULL,
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::br(),
|
||||
|
|
@ -53,6 +55,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::br()
|
||||
)
|
||||
|
||||
filter_ui <-
|
||||
shiny::tagList(
|
||||
# width = 6,
|
||||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
)
|
||||
|
||||
params_ui <-
|
||||
shiny::tagList(
|
||||
|
|
@ -60,41 +71,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::tags$h4("Data import parameters"),
|
||||
shiny::helpText("Options here will show, when API and uri are typed"),
|
||||
shiny::uiOutput(outputId = ns("fields")),
|
||||
shiny::tags$div(
|
||||
class = "shiny-input-container",
|
||||
shiny::tags$label(
|
||||
class = "control-label",
|
||||
`for` = ns("dropdown_params"),
|
||||
"...",
|
||||
style = htmltools::css(visibility = "hidden")
|
||||
),
|
||||
shinyWidgets::dropMenu(
|
||||
shiny::actionButton(
|
||||
inputId = ns("dropdown_params"),
|
||||
label = "Add data filters",
|
||||
icon = shiny::icon("filter"),
|
||||
width = "100%",
|
||||
class = "px-1"
|
||||
),
|
||||
filter_ui
|
||||
),
|
||||
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
|
||||
),
|
||||
shiny::uiOutput(outputId = ns("data_type")),
|
||||
shiny::uiOutput(outputId = ns("fill")),
|
||||
shinyWidgets::switchInput(
|
||||
inputId = "do_filter",
|
||||
label = "Apply filter?",
|
||||
value = FALSE,
|
||||
inline = FALSE,
|
||||
onLabel = "YES",
|
||||
offLabel = "NO"
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.do_filter",
|
||||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
shiny::fluidPage(
|
||||
title=title,
|
||||
bslib::layout_columns(
|
||||
server_ui,
|
||||
params_ui,
|
||||
col_widths = bslib::breakpoints(
|
||||
sm = c(12, 12),
|
||||
md = c(12, 12)
|
||||
)
|
||||
),
|
||||
shiny::column(
|
||||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
|
|
@ -102,6 +100,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
tags$div(
|
||||
id = ns("retrieved-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("retrieved-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)#,
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
# bslib::input_task_button(
|
||||
# id = ns("data_import"),
|
||||
# label = "Import",
|
||||
|
|
@ -114,12 +124,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
# type = "primary",
|
||||
# auto_reset = TRUE#,state="busy"
|
||||
# ),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
# shiny::br(),
|
||||
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
|
||||
)
|
||||
|
||||
|
||||
shiny::fluidPage(
|
||||
title = title,
|
||||
server_ui,
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.connect_success == true",
|
||||
params_ui,
|
||||
ns = ns
|
||||
),
|
||||
shiny::br()
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -149,7 +167,7 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
if (!is.null(input$uri)){
|
||||
if (!is.null(input$uri)) {
|
||||
uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
|
||||
} else {
|
||||
uri <- input$uri
|
||||
|
|
@ -204,9 +222,11 @@ m_redcap_readServer <- function(id) {
|
|||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
include_data_alert(see_data_text = "Click to see data dictionary",
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see data dictionary",
|
||||
dataIdName = "see_data",
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||
glue::glue("The {data_rv$info$project_title} project is loaded.")),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
|
@ -225,6 +245,9 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
)
|
||||
|
||||
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
||||
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
|
|
@ -313,6 +336,7 @@ m_redcap_readServer <- function(id) {
|
|||
})
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
if (NROW(arms()) > 0) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("arms"),
|
||||
selected = NULL,
|
||||
|
|
@ -320,10 +344,13 @@ m_redcap_readServer <- function(id) {
|
|||
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
||||
multiple = TRUE
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
|
||||
# browser()
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
|
||||
|
|
@ -334,7 +361,11 @@ m_redcap_readServer <- function(id) {
|
|||
events = input$arms,
|
||||
raw_or_label = "both",
|
||||
filter_logic = input$filter,
|
||||
split_forms = if (input$data_type == "long") "none" else "all"
|
||||
split_forms = ifelse(
|
||||
input$data_type == "long" && !is.null(input$data_type),
|
||||
"none",
|
||||
"all"
|
||||
)
|
||||
)
|
||||
|
||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
|
|
@ -342,19 +373,24 @@ m_redcap_readServer <- function(id) {
|
|||
})
|
||||
|
||||
code <- rlang::call2("read_redcap_tables",
|
||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
||||
, .ns = "REDCapCAST")
|
||||
!!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
|
||||
.ns = "REDCapCAST"
|
||||
)
|
||||
|
||||
# browser()
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
data_rv$data_message <- imported$raw_text
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data_message <- "Requested data was retrieved!"
|
||||
|
||||
## The data management below should be separated to allow for changing
|
||||
## "wide"/"long" without re-importing data
|
||||
if (input$data_type != "long") {
|
||||
|
||||
if (parameters$split_form == "all") {
|
||||
# browser()
|
||||
out <- imported |>
|
||||
# redcap_wider()
|
||||
|
|
@ -378,6 +414,20 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
}
|
||||
|
||||
# browser()
|
||||
in_data_check <- parameters$fields %in% names(out) |
|
||||
sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
|
||||
|
||||
if (!any(in_data_check[-1])) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
}
|
||||
|
||||
if (!all(in_data_check)) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
||||
data_rv$data <- out |>
|
||||
|
|
@ -387,13 +437,33 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
})
|
||||
|
||||
# shiny::observe({
|
||||
# shiny::req(data_rv$imported)
|
||||
#
|
||||
# imported <- data_rv$imported
|
||||
#
|
||||
#
|
||||
# })
|
||||
shiny::observeEvent(
|
||||
data_rv$data_status,
|
||||
{
|
||||
# browser()
|
||||
if (identical(data_rv$data_status, "error")) {
|
||||
datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
|
||||
} else if (identical(data_rv$data_status, "success")) {
|
||||
datamods:::insert_alert(
|
||||
selector = ns("retrieved"),
|
||||
status = data_rv$data_status,
|
||||
tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
||||
data_rv$data_message
|
||||
)
|
||||
)
|
||||
} else {
|
||||
datamods:::insert_alert(
|
||||
selector = ns("retrieved"),
|
||||
status = data_rv$data_status,
|
||||
tags$p(
|
||||
tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
|
||||
data_rv$data_message
|
||||
)
|
||||
)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
return(list(
|
||||
status = shiny::reactive(data_rv$data_status),
|
||||
|
|
@ -553,13 +623,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
|||
#' }
|
||||
redcap_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
m_redcap_readUI("data"),
|
||||
m_redcap_readUI("data", url = NULL),
|
||||
DT::DTOutput("data"),
|
||||
shiny::tags$b("Code:"),
|
||||
shiny::verbatimTextOutput(outputId = "code")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
|
||||
data_val <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data <- DT::renderDataTable(
|
||||
|
|
|
|||
|
|
@ -2,12 +2,14 @@
|
|||
#'
|
||||
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
||||
#' A 'tbl_regression' or 'tbl_uvregression' object
|
||||
## #' @param remove_header_rows (scalar `logical`)\cr
|
||||
## #' logical indicating whether to remove header rows
|
||||
## #' for categorical variables. Default is `TRUE`
|
||||
## #' @param remove_reference_rows (scalar `logical`)\cr
|
||||
## #' logical indicating whether to remove reference rows
|
||||
## #' for categorical variables. Default is `FALSE`.
|
||||
#' @param plot_ref (scalar `logical`)\cr
|
||||
#' plot reference values
|
||||
#' @param remove_header_rows (scalar `logical`)\cr
|
||||
#' logical indicating whether to remove header rows
|
||||
#' for categorical variables. Default is `TRUE`
|
||||
#' @param remove_reference_rows (scalar `logical`)\cr
|
||||
#' logical indicating whether to remove reference rows
|
||||
#' for categorical variables. Default is `FALSE`.
|
||||
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
||||
#'
|
||||
#' @returns ggplot object
|
||||
|
|
|
|||
|
|
@ -645,10 +645,10 @@ convert_to <- function(data,
|
|||
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "factor")) {
|
||||
data[[variable]] <- as.factor(x = data[[variable]])
|
||||
data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
|
||||
attr(data, "code_03_convert") <- c(
|
||||
attr(data, "code_03_convert"),
|
||||
setNames(list(expr(as.factor(!!sym(variable)))), variable)
|
||||
setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "numeric")) {
|
||||
data[[variable]] <- as.numeric(data[[variable]], ...)
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
#### Current file: /Users/au301842/FreesearchR/R//app_version.R
|
||||
########
|
||||
|
||||
app_version <- function()'250403_0630'
|
||||
app_version <- function()'Version: 25.4.1.250403_1309'
|
||||
|
||||
|
||||
########
|
||||
|
|
@ -2844,6 +2844,29 @@ get_ggplot_label <- function(data,label){
|
|||
}
|
||||
|
||||
|
||||
#' Return if available
|
||||
#'
|
||||
#' @param data vector
|
||||
#' @param default assigned value for missings
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' NULL |> if_not_missing("new")
|
||||
#' c(2,"a",NA) |> if_not_missing()
|
||||
#' "See" |> if_not_missing()
|
||||
if_not_missing <- function(data,default=NULL){
|
||||
if (length(data)>1){
|
||||
Reduce(c,lapply(data,if_not_missing))
|
||||
} else if (is.na(data) || is.null(data)){
|
||||
return(default)
|
||||
} else {
|
||||
return(data)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
########
|
||||
#### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R
|
||||
########
|
||||
|
|
@ -4168,7 +4191,7 @@ plot_download_server <- function(id,
|
|||
#'
|
||||
#' @return shiny ui element
|
||||
#' @export
|
||||
m_redcap_readUI <- function(id, title = TRUE) {
|
||||
m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||
ns <- shiny::NS(id)
|
||||
|
||||
if (isTRUE(title)) {
|
||||
|
|
@ -4184,7 +4207,7 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::textInput(
|
||||
inputId = ns("uri"),
|
||||
label = "Web address",
|
||||
value = "https://redcap.your.institution/"
|
||||
value = if_not_missing(url, "https://redcap.your.institution/")
|
||||
),
|
||||
shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"),
|
||||
shiny::textInput(
|
||||
|
|
@ -4193,11 +4216,13 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
value = ""
|
||||
),
|
||||
shiny::helpText("The token is a string of 32 numbers and letters."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_connect"),
|
||||
label = "Connect",
|
||||
icon = shiny::icon("link", lib = "glyphicon"),
|
||||
# width = NULL,
|
||||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::br(),
|
||||
|
|
@ -4214,6 +4239,15 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::br()
|
||||
)
|
||||
|
||||
filter_ui <-
|
||||
shiny::tagList(
|
||||
# width = 6,
|
||||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
)
|
||||
|
||||
params_ui <-
|
||||
shiny::tagList(
|
||||
|
|
@ -4221,41 +4255,28 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
shiny::tags$h4("Data import parameters"),
|
||||
shiny::helpText("Options here will show, when API and uri are typed"),
|
||||
shiny::uiOutput(outputId = ns("fields")),
|
||||
shiny::tags$div(
|
||||
class = "shiny-input-container",
|
||||
shiny::tags$label(
|
||||
class = "control-label",
|
||||
`for` = ns("dropdown_params"),
|
||||
"...",
|
||||
style = htmltools::css(visibility = "hidden")
|
||||
),
|
||||
shinyWidgets::dropMenu(
|
||||
shiny::actionButton(
|
||||
inputId = ns("dropdown_params"),
|
||||
label = "Add data filters",
|
||||
icon = shiny::icon("filter"),
|
||||
width = "100%",
|
||||
class = "px-1"
|
||||
),
|
||||
filter_ui
|
||||
),
|
||||
shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters")
|
||||
),
|
||||
shiny::uiOutput(outputId = ns("data_type")),
|
||||
shiny::uiOutput(outputId = ns("fill")),
|
||||
shinyWidgets::switchInput(
|
||||
inputId = "do_filter",
|
||||
label = "Apply filter?",
|
||||
value = FALSE,
|
||||
inline = FALSE,
|
||||
onLabel = "YES",
|
||||
offLabel = "NO"
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "input.do_filter",
|
||||
shiny::uiOutput(outputId = ns("arms")),
|
||||
shiny::textInput(
|
||||
inputId = ns("filter"),
|
||||
label = "Optional filter logic (e.g., [gender] = 'female')"
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
shiny::fluidPage(
|
||||
title=title,
|
||||
bslib::layout_columns(
|
||||
server_ui,
|
||||
params_ui,
|
||||
col_widths = bslib::breakpoints(
|
||||
sm = c(12, 12),
|
||||
md = c(12, 12)
|
||||
)
|
||||
),
|
||||
shiny::column(
|
||||
width = 12,
|
||||
# shiny::actionButton(inputId = ns("import"), label = "Import"),
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
shiny::actionButton(
|
||||
inputId = ns("data_import"),
|
||||
label = "Import",
|
||||
|
|
@ -4263,6 +4284,18 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
width = "100%",
|
||||
disabled = TRUE
|
||||
),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
tags$div(
|
||||
id = ns("retrieved-placeholder"),
|
||||
shinyWidgets::alert(
|
||||
id = ns("retrieved-result"),
|
||||
status = "info",
|
||||
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
|
||||
),
|
||||
dismissible = TRUE
|
||||
)#,
|
||||
## TODO: Use busy indicator like on download to have button activate/deactivate
|
||||
# bslib::input_task_button(
|
||||
# id = ns("data_import"),
|
||||
# label = "Import",
|
||||
|
|
@ -4275,12 +4308,20 @@ m_redcap_readUI <- function(id, title = TRUE) {
|
|||
# type = "primary",
|
||||
# auto_reset = TRUE#,state="busy"
|
||||
# ),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."),
|
||||
shiny::br(),
|
||||
shiny::br()
|
||||
# shiny::br(),
|
||||
# shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.")
|
||||
)
|
||||
|
||||
|
||||
shiny::fluidPage(
|
||||
title = title,
|
||||
server_ui,
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.connect_success == true",
|
||||
params_ui,
|
||||
ns = ns
|
||||
),
|
||||
shiny::br()
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -4310,7 +4351,7 @@ m_redcap_readServer <- function(id) {
|
|||
shiny::observeEvent(list(input$api, input$uri), {
|
||||
shiny::req(input$api)
|
||||
shiny::req(input$uri)
|
||||
if (!is.null(input$uri)){
|
||||
if (!is.null(input$uri)) {
|
||||
uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/")
|
||||
} else {
|
||||
uri <- input$uri
|
||||
|
|
@ -4365,9 +4406,11 @@ m_redcap_readServer <- function(id) {
|
|||
datamods:::insert_alert(
|
||||
selector = ns("connect"),
|
||||
status = "success",
|
||||
include_data_alert(see_data_text = "Click to see data dictionary",
|
||||
include_data_alert(
|
||||
see_data_text = "Click to see data dictionary",
|
||||
dataIdName = "see_data",
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))),
|
||||
extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"),
|
||||
glue::glue("The {data_rv$info$project_title} project is loaded.")),
|
||||
btn_show_data = TRUE
|
||||
)
|
||||
)
|
||||
|
|
@ -4386,6 +4429,9 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
)
|
||||
|
||||
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
||||
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
||||
|
||||
shiny::observeEvent(input$see_data, {
|
||||
datamods::show_data(
|
||||
purrr::pluck(data_rv$dd_list, "data"),
|
||||
|
|
@ -4474,6 +4520,7 @@ m_redcap_readServer <- function(id) {
|
|||
})
|
||||
|
||||
output$arms <- shiny::renderUI({
|
||||
if (NROW(arms()) > 0) {
|
||||
vectorSelectInput(
|
||||
inputId = ns("arms"),
|
||||
selected = NULL,
|
||||
|
|
@ -4481,10 +4528,13 @@ m_redcap_readServer <- function(id) {
|
|||
choices = stats::setNames(arms()[[3]], arms()[[1]]),
|
||||
multiple = TRUE
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$data_import, {
|
||||
shiny::req(input$fields)
|
||||
|
||||
# browser()
|
||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||
|
||||
|
||||
|
|
@ -4495,7 +4545,11 @@ m_redcap_readServer <- function(id) {
|
|||
events = input$arms,
|
||||
raw_or_label = "both",
|
||||
filter_logic = input$filter,
|
||||
split_forms = if (input$data_type == "long") "none" else "all"
|
||||
split_forms = ifelse(
|
||||
input$data_type == "long" && !is.null(input$data_type),
|
||||
"none",
|
||||
"all"
|
||||
)
|
||||
)
|
||||
|
||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||
|
|
@ -4503,19 +4557,24 @@ m_redcap_readServer <- function(id) {
|
|||
})
|
||||
|
||||
code <- rlang::call2("read_redcap_tables",
|
||||
!!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")),
|
||||
, .ns = "REDCapCAST")
|
||||
!!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), ,
|
||||
.ns = "REDCapCAST"
|
||||
)
|
||||
|
||||
# browser()
|
||||
|
||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||
data_rv$data_status <- "error"
|
||||
data_rv$data_list <- NULL
|
||||
data_rv$data_message <- imported$raw_text
|
||||
} else {
|
||||
data_rv$data_status <- "success"
|
||||
data_rv$data_message <- "Requested data was retrieved!"
|
||||
|
||||
## The data management below should be separated to allow for changing
|
||||
## "wide"/"long" without re-importing data
|
||||
if (input$data_type != "long") {
|
||||
|
||||
if (parameters$split_form == "all") {
|
||||
# browser()
|
||||
out <- imported |>
|
||||
# redcap_wider()
|
||||
|
|
@ -4539,6 +4598,20 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
}
|
||||
|
||||
# browser()
|
||||
in_data_check <- parameters$fields %in% names(out) |
|
||||
sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
|
||||
|
||||
if (!any(in_data_check[-1])) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
}
|
||||
|
||||
if (!all(in_data_check)) {
|
||||
data_rv$data_status <- "warning"
|
||||
data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access."
|
||||
}
|
||||
|
||||
data_rv$code <- code
|
||||
|
||||
data_rv$data <- out |>
|
||||
|
|
@ -4548,13 +4621,33 @@ m_redcap_readServer <- function(id) {
|
|||
}
|
||||
})
|
||||
|
||||
# shiny::observe({
|
||||
# shiny::req(data_rv$imported)
|
||||
#
|
||||
# imported <- data_rv$imported
|
||||
#
|
||||
#
|
||||
# })
|
||||
shiny::observeEvent(
|
||||
data_rv$data_status,
|
||||
{
|
||||
# browser()
|
||||
if (identical(data_rv$data_status, "error")) {
|
||||
datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
|
||||
} else if (identical(data_rv$data_status, "success")) {
|
||||
datamods:::insert_alert(
|
||||
selector = ns("retrieved"),
|
||||
status = data_rv$data_status,
|
||||
tags$p(
|
||||
tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
||||
data_rv$data_message
|
||||
)
|
||||
)
|
||||
} else {
|
||||
datamods:::insert_alert(
|
||||
selector = ns("retrieved"),
|
||||
status = data_rv$data_status,
|
||||
tags$p(
|
||||
tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"),
|
||||
data_rv$data_message
|
||||
)
|
||||
)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
return(list(
|
||||
status = shiny::reactive(data_rv$data_status),
|
||||
|
|
@ -4714,13 +4807,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") {
|
|||
#' }
|
||||
redcap_demo_app <- function() {
|
||||
ui <- shiny::fluidPage(
|
||||
m_redcap_readUI("data"),
|
||||
m_redcap_readUI("data", url = NULL),
|
||||
DT::DTOutput("data"),
|
||||
shiny::tags$b("Code:"),
|
||||
shiny::verbatimTextOutput(outputId = "code")
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
|
||||
data_val <- m_redcap_readServer(id = "data")
|
||||
|
||||
output$data <- DT::renderDataTable(
|
||||
|
|
@ -5422,12 +5514,14 @@ regression_model_uv_list <- function(data,
|
|||
#'
|
||||
#' @param x (`tbl_regression`, `tbl_uvregression`)\cr
|
||||
#' A 'tbl_regression' or 'tbl_uvregression' object
|
||||
## #' @param remove_header_rows (scalar `logical`)\cr
|
||||
## #' logical indicating whether to remove header rows
|
||||
## #' for categorical variables. Default is `TRUE`
|
||||
## #' @param remove_reference_rows (scalar `logical`)\cr
|
||||
## #' logical indicating whether to remove reference rows
|
||||
## #' for categorical variables. Default is `FALSE`.
|
||||
#' @param plot_ref (scalar `logical`)\cr
|
||||
#' plot reference values
|
||||
#' @param remove_header_rows (scalar `logical`)\cr
|
||||
#' logical indicating whether to remove header rows
|
||||
#' for categorical variables. Default is `TRUE`
|
||||
#' @param remove_reference_rows (scalar `logical`)\cr
|
||||
#' logical indicating whether to remove reference rows
|
||||
#' for categorical variables. Default is `FALSE`.
|
||||
#' @param ... arguments passed to `ggstats::ggcoef_plot(...)`
|
||||
#'
|
||||
#' @returns ggplot object
|
||||
|
|
@ -7438,10 +7532,10 @@ convert_to <- function(data,
|
|||
setNames(list(expr(as.character(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "factor")) {
|
||||
data[[variable]] <- as.factor(x = data[[variable]])
|
||||
data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]])
|
||||
attr(data, "code_03_convert") <- c(
|
||||
attr(data, "code_03_convert"),
|
||||
setNames(list(expr(as.factor(!!sym(variable)))), variable)
|
||||
setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable)
|
||||
)
|
||||
} else if (identical(new_class, "numeric")) {
|
||||
data[[variable]] <- as.numeric(data[[variable]], ...)
|
||||
|
|
@ -7840,6 +7934,8 @@ ui_elements <- list(
|
|||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.data_loaded == true",
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Specify variables to include"),
|
||||
|
|
@ -7856,7 +7952,7 @@ ui_elements <- list(
|
|||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
update_on = "change",
|
||||
update_on = "end",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
|
|
@ -7864,12 +7960,13 @@ ui_elements <- list(
|
|||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Filter variables with completeness above the specified percentage."),
|
||||
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(outputId = "import_var"),
|
||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
|
|
@ -8568,19 +8665,34 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
output$data_loaded <- shiny::reactive({
|
||||
!is.null(rv$data_temp)
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$source,{
|
||||
rv$data_temp <- NULL
|
||||
})
|
||||
|
||||
shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
|
||||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
input$import_var,
|
||||
input$complete_cutoff
|
||||
input$complete_cutoff,
|
||||
rv$data_temp
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_temp)
|
||||
# browser()
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
temp_data <- rv$data_temp
|
||||
if (all(input$import_var %in% names(temp_data))){
|
||||
temp_data <- temp_data |> dplyr::select(input$import_var)
|
||||
}
|
||||
|
||||
rv$data_original <- temp_data |>
|
||||
default_parsing()
|
||||
|
||||
|
||||
rv$code$import <- rv$code$import |>
|
||||
deparse() |>
|
||||
paste(collapse = "") |>
|
||||
|
|
@ -8593,7 +8705,7 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
},ignoreNULL = FALSE
|
||||
)
|
||||
|
||||
output$data_info_import <- shiny::renderUI({
|
||||
|
|
@ -8618,8 +8730,7 @@ server <- function(input, output, session) {
|
|||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
rv$data_original,
|
||||
input$complete_cutoff
|
||||
rv$data_original
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_original)
|
||||
|
|
|
|||
|
|
@ -158,19 +158,34 @@ server <- function(input, output, session) {
|
|||
)
|
||||
})
|
||||
|
||||
output$data_loaded <- shiny::reactive({
|
||||
!is.null(rv$data_temp)
|
||||
})
|
||||
|
||||
shiny::observeEvent(input$source,{
|
||||
rv$data_temp <- NULL
|
||||
})
|
||||
|
||||
shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE)
|
||||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
input$import_var,
|
||||
input$complete_cutoff
|
||||
input$complete_cutoff,
|
||||
rv$data_temp
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_temp)
|
||||
# browser()
|
||||
rv$data_original <- rv$data_temp |>
|
||||
dplyr::select(input$import_var) |>
|
||||
temp_data <- rv$data_temp
|
||||
if (all(input$import_var %in% names(temp_data))){
|
||||
temp_data <- temp_data |> dplyr::select(input$import_var)
|
||||
}
|
||||
|
||||
rv$data_original <- temp_data |>
|
||||
default_parsing()
|
||||
|
||||
|
||||
rv$code$import <- rv$code$import |>
|
||||
deparse() |>
|
||||
paste(collapse = "") |>
|
||||
|
|
@ -183,7 +198,7 @@ server <- function(input, output, session) {
|
|||
|
||||
rv$code$filter <- NULL
|
||||
rv$code$modify <- NULL
|
||||
}
|
||||
},ignoreNULL = FALSE
|
||||
)
|
||||
|
||||
output$data_info_import <- shiny::renderUI({
|
||||
|
|
@ -208,8 +223,7 @@ server <- function(input, output, session) {
|
|||
|
||||
shiny::observeEvent(
|
||||
eventExpr = list(
|
||||
rv$data_original,
|
||||
input$complete_cutoff
|
||||
rv$data_original
|
||||
),
|
||||
handlerExpr = {
|
||||
shiny::req(rv$data_original)
|
||||
|
|
|
|||
|
|
@ -68,6 +68,8 @@ ui_elements <- list(
|
|||
condition = "input.source=='redcap'",
|
||||
DT::DTOutput(outputId = "redcap_prev")
|
||||
),
|
||||
shiny::conditionalPanel(
|
||||
condition = "output.data_loaded == true",
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::h5("Specify variables to include"),
|
||||
|
|
@ -84,7 +86,7 @@ ui_elements <- list(
|
|||
shinyWidgets::noUiSliderInput(
|
||||
inputId = "complete_cutoff",
|
||||
label = NULL,
|
||||
update_on = "change",
|
||||
update_on = "end",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 5,
|
||||
|
|
@ -92,12 +94,13 @@ ui_elements <- list(
|
|||
format = shinyWidgets::wNumbFormat(decimals = 0),
|
||||
color = datamods:::get_primary_color()
|
||||
),
|
||||
shiny::helpText("Filter variables with completeness above the specified percentage."),
|
||||
shiny::helpText("Exclude variables with completeness below the specified percentage."),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
shiny::uiOutput(outputId = "import_var"),
|
||||
shiny::uiOutput(outputId = "data_info_import", inline = TRUE)
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::br(),
|
||||
shiny::br(),
|
||||
|
|
|
|||
24
man/if_not_missing.Rd
Normal file
24
man/if_not_missing.Rd
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/helpers.R
|
||||
\name{if_not_missing}
|
||||
\alias{if_not_missing}
|
||||
\title{Return if available}
|
||||
\usage{
|
||||
if_not_missing(data, default = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{vector}
|
||||
|
||||
\item{default}{assigned value for missings}
|
||||
}
|
||||
\value{
|
||||
vector
|
||||
}
|
||||
\description{
|
||||
Return if available
|
||||
}
|
||||
\examples{
|
||||
NULL |> if_not_missing("new")
|
||||
c(2,"a",NA) |> if_not_missing()
|
||||
"See" |> if_not_missing()
|
||||
}
|
||||
|
|
@ -16,6 +16,17 @@
|
|||
\item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr
|
||||
A 'tbl_regression' or 'tbl_uvregression' object}
|
||||
|
||||
\item{plot_ref}{(scalar \code{logical})\cr
|
||||
plot reference values}
|
||||
|
||||
\item{remove_header_rows}{(scalar \code{logical})\cr
|
||||
logical indicating whether to remove header rows
|
||||
for categorical variables. Default is \code{TRUE}}
|
||||
|
||||
\item{remove_reference_rows}{(scalar \code{logical})\cr
|
||||
logical indicating whether to remove reference rows
|
||||
for categorical variables. Default is \code{FALSE}.}
|
||||
|
||||
\item{...}{arguments passed to \code{ggstats::ggcoef_plot(...)}}
|
||||
}
|
||||
\value{
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
\alias{redcap_demo_app}
|
||||
\title{Shiny module to browser and export REDCap data}
|
||||
\usage{
|
||||
m_redcap_readUI(id, title = TRUE)
|
||||
m_redcap_readUI(id, title = TRUE, url = NULL)
|
||||
|
||||
m_redcap_readServer(id)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue