mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
fix: keep level labels
This commit is contained in:
parent
748a3c3e07
commit
9b4ddafe6f
1 changed files with 198 additions and 188 deletions
|
|
@ -11,10 +11,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
ns <- shiny::NS(id)
|
ns <- shiny::NS(id)
|
||||||
|
|
||||||
if (isTRUE(title)) {
|
if (isTRUE(title)) {
|
||||||
title <- shiny::tags$h4(
|
title <- shiny::tags$h4(i18n$t("Import data from REDCap"), class = "redcap-module-title")
|
||||||
i18n$t("Import data from REDCap"),
|
|
||||||
class = "redcap-module-title"
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
server_ui <- shiny::tagList(
|
server_ui <- shiny::tagList(
|
||||||
|
|
@ -25,7 +22,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
value = if_not_missing(url, "https://redcap.your.institution/"),
|
value = if_not_missing(url, "https://redcap.your.institution/"),
|
||||||
width = "100%"
|
width = "100%"
|
||||||
),
|
),
|
||||||
shiny::helpText(i18n$t("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'")),
|
shiny::helpText(
|
||||||
|
i18n$t(
|
||||||
|
"Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"
|
||||||
|
)
|
||||||
|
),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::passwordInput(
|
shiny::passwordInput(
|
||||||
|
|
@ -34,7 +35,9 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
value = "",
|
value = "",
|
||||||
width = "100%"
|
width = "100%"
|
||||||
),
|
),
|
||||||
shiny::helpText(i18n$t("The token is a string of 32 numbers and letters.")),
|
shiny::helpText(i18n$t(
|
||||||
|
"The token is a string of 32 numbers and letters."
|
||||||
|
)),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::br(),
|
shiny::br(),
|
||||||
shiny::actionButton(
|
shiny::actionButton(
|
||||||
|
|
@ -51,7 +54,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
shinyWidgets::alert(
|
shinyWidgets::alert(
|
||||||
id = ns("connect-result"),
|
id = ns("connect-result"),
|
||||||
status = "info",
|
status = "info",
|
||||||
tags$p(phosphoricons::ph("info", weight = "bold"), i18n$t("Please fill in web address and API token, then press 'Connect'."))
|
tags$p(
|
||||||
|
phosphoricons::ph("info", weight = "bold"),
|
||||||
|
i18n$t("Please fill in web address and API token, then press 'Connect'.")
|
||||||
|
)
|
||||||
),
|
),
|
||||||
dismissible = TRUE
|
dismissible = TRUE
|
||||||
),
|
),
|
||||||
|
|
@ -64,8 +70,8 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
shiny::uiOutput(outputId = ns("arms")),
|
shiny::uiOutput(outputId = ns("arms")),
|
||||||
shiny::textInput(
|
shiny::textInput(
|
||||||
inputId = ns("filter"),
|
inputId = ns("filter"),
|
||||||
label = i18n$t("Optional filter logic (e.g., [gender] = 'female')"
|
label = i18n$t("Optional filter logic (e.g., [gender] = 'female')")
|
||||||
))
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
params_ui <-
|
params_ui <-
|
||||||
|
|
@ -96,7 +102,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
shiny::helpText(i18n$t("Select fields/variables to import and click the funnel to apply optional filters")),
|
shiny::helpText(
|
||||||
|
i18n$t(
|
||||||
|
"Select fields/variables to import and click the funnel to apply optional filters"
|
||||||
|
)
|
||||||
|
),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::tags$br(),
|
shiny::tags$br(),
|
||||||
shiny::uiOutput(outputId = ns("data_type")),
|
shiny::uiOutput(outputId = ns("data_type")),
|
||||||
|
|
@ -115,7 +125,10 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
shinyWidgets::alert(
|
shinyWidgets::alert(
|
||||||
id = ns("retrieved-result"),
|
id = ns("retrieved-result"),
|
||||||
status = "info",
|
status = "info",
|
||||||
tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.")
|
tags$p(
|
||||||
|
phosphoricons::ph("info", weight = "bold"),
|
||||||
|
"Please specify data to download, then press 'Import'."
|
||||||
|
)
|
||||||
),
|
),
|
||||||
dismissible = TRUE
|
dismissible = TRUE
|
||||||
)
|
)
|
||||||
|
|
@ -126,11 +139,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) {
|
||||||
title = title,
|
title = title,
|
||||||
server_ui,
|
server_ui,
|
||||||
# shiny::uiOutput(ns("params_ui")),
|
# shiny::uiOutput(ns("params_ui")),
|
||||||
shiny::conditionalPanel(
|
shiny::conditionalPanel(condition = "output.connect_success == true", params_ui, ns = ns),
|
||||||
condition = "output.connect_success == true",
|
|
||||||
params_ui,
|
|
||||||
ns = ns
|
|
||||||
),
|
|
||||||
shiny::br()
|
shiny::br()
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
@ -162,7 +171,11 @@ m_redcap_readServer <- function(id) {
|
||||||
shiny::req(input$api)
|
shiny::req(input$api)
|
||||||
shiny::req(input$uri)
|
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/")
|
uri <- paste0(ifelse(
|
||||||
|
endsWith(input$uri, "/"),
|
||||||
|
input$uri,
|
||||||
|
paste0(input$uri, "/")
|
||||||
|
), "api/")
|
||||||
} else {
|
} else {
|
||||||
uri <- input$uri
|
uri <- input$uri
|
||||||
}
|
}
|
||||||
|
|
@ -176,75 +189,68 @@ m_redcap_readServer <- function(id) {
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
tryCatch(
|
tryCatch({
|
||||||
{
|
shiny::observeEvent(list(input$data_connect), {
|
||||||
shiny::observeEvent(
|
shiny::req(input$api)
|
||||||
list(
|
shiny::req(data_rv$uri)
|
||||||
input$data_connect
|
|
||||||
),
|
|
||||||
{
|
|
||||||
shiny::req(input$api)
|
|
||||||
shiny::req(data_rv$uri)
|
|
||||||
|
|
||||||
parameters <- list(
|
parameters <- list(redcap_uri = data_rv$uri, token = input$api)
|
||||||
redcap_uri = data_rv$uri,
|
|
||||||
token = input$api
|
|
||||||
)
|
|
||||||
|
|
||||||
# browser()
|
# browser()
|
||||||
shiny::withProgress(
|
shiny::withProgress({
|
||||||
{
|
imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters),
|
||||||
imported <- try(rlang::exec(REDCapR::redcap_metadata_read, !!!parameters), silent = TRUE)
|
silent = TRUE)
|
||||||
},
|
}, message = paste("Connecting to", data_rv$uri))
|
||||||
message = paste("Connecting to", data_rv$uri)
|
|
||||||
)
|
|
||||||
|
|
||||||
## TODO: Simplify error messages
|
## TODO: Simplify error messages
|
||||||
if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
if (inherits(imported, "try-error") ||
|
||||||
if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
NROW(imported) < 1 ||
|
||||||
mssg <- imported$raw_text
|
ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) {
|
||||||
} else {
|
if (ifelse(is.list(imported),
|
||||||
mssg <- attr(imported, "condition")$message
|
!isTRUE(imported$success),
|
||||||
}
|
FALSE)) {
|
||||||
|
mssg <- imported$raw_text
|
||||||
|
} else {
|
||||||
|
mssg <- attr(imported, "condition")$message
|
||||||
|
}
|
||||||
|
|
||||||
datamods:::insert_error(mssg = mssg, selector = "connect")
|
datamods:::insert_error(mssg = mssg, selector = "connect")
|
||||||
data_rv$dd_status <- "error"
|
data_rv$dd_status <- "error"
|
||||||
data_rv$dd_list <- NULL
|
data_rv$dd_list <- NULL
|
||||||
} else if (isTRUE(imported$success)) {
|
} else if (isTRUE(imported$success)) {
|
||||||
data_rv$dd_status <- "success"
|
data_rv$dd_status <- "success"
|
||||||
|
|
||||||
data_rv$info <- REDCapR::redcap_project_info_read(
|
data_rv$info <- REDCapR::redcap_project_info_read(redcap_uri = data_rv$uri, token = input$api)$data
|
||||||
redcap_uri = data_rv$uri,
|
|
||||||
token = input$api
|
|
||||||
)$data
|
|
||||||
|
|
||||||
datamods:::insert_alert(
|
datamods:::insert_alert(
|
||||||
selector = ns("connect"),
|
selector = ns("connect"),
|
||||||
status = "success",
|
status = "success",
|
||||||
include_data_alert(
|
include_data_alert(
|
||||||
see_data_text = i18n$t("Click to see data dictionary"),
|
see_data_text = i18n$t("Click to see data dictionary"),
|
||||||
dataIdName = "see_dd",
|
dataIdName = "see_dd",
|
||||||
extra = tags$p(
|
extra = tags$p(
|
||||||
tags$b(phosphoricons::ph("check", weight = "bold"), i18n$t("Connected to server!")),
|
tags$b(
|
||||||
glue::glue(i18n$t("The {data_rv$info$project_title} project is loaded."))
|
phosphoricons::ph("check", weight = "bold"),
|
||||||
),
|
i18n$t("Connected to server!")
|
||||||
btn_show_data = TRUE
|
),
|
||||||
|
glue::glue(
|
||||||
|
i18n$t(
|
||||||
|
"The {data_rv$info$project_title} project is loaded."
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
),
|
||||||
|
btn_show_data = TRUE
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
data_rv$dd_list <- imported
|
data_rv$dd_list <- imported
|
||||||
}
|
}
|
||||||
},
|
}, ignoreInit = TRUE)
|
||||||
ignoreInit = TRUE
|
}, warning = function(warn) {
|
||||||
)
|
showNotification(paste0(warn), type = "warning")
|
||||||
},
|
}, error = function(err) {
|
||||||
warning = function(warn) {
|
showNotification(paste0(err), type = "err")
|
||||||
showNotification(paste0(warn), type = "warning")
|
})
|
||||||
},
|
|
||||||
error = function(err) {
|
|
||||||
showNotification(paste0(err), type = "err")
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success"))
|
||||||
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE)
|
||||||
|
|
@ -275,10 +281,7 @@ m_redcap_readServer <- function(id) {
|
||||||
shiny::req(input$api)
|
shiny::req(input$api)
|
||||||
shiny::req(data_rv$uri)
|
shiny::req(data_rv$uri)
|
||||||
|
|
||||||
REDCapR::redcap_event_read(
|
REDCapR::redcap_event_read(redcap_uri = data_rv$uri, token = input$api)$data
|
||||||
redcap_uri = data_rv$uri,
|
|
||||||
token = input$api
|
|
||||||
)$data
|
|
||||||
})
|
})
|
||||||
|
|
||||||
output$fields <- shiny::renderUI({
|
output$fields <- shiny::renderUI({
|
||||||
|
|
@ -288,7 +291,7 @@ m_redcap_readServer <- function(id) {
|
||||||
label = i18n$t("Select fields/variables to import:"),
|
label = i18n$t("Select fields/variables to import:"),
|
||||||
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
choices = purrr::pluck(data_rv$dd_list, "data") |>
|
||||||
dplyr::select(field_name, form_name) |>
|
dplyr::select(field_name, form_name) |>
|
||||||
(\(.x){
|
(\(.x) {
|
||||||
split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
|
split(.x$field_name, REDCapCAST::as_factor(.x$form_name))
|
||||||
})(),
|
})(),
|
||||||
updateOn = "change",
|
updateOn = "change",
|
||||||
|
|
@ -321,14 +324,10 @@ m_redcap_readServer <- function(id) {
|
||||||
shiny::req(input$data_type)
|
shiny::req(input$data_type)
|
||||||
|
|
||||||
## Get repeated field
|
## Get repeated field
|
||||||
data_rv$rep_fields <- data_rv$dd_list$data$field_name[
|
data_rv$rep_fields <- data_rv$dd_list$data$field_name[data_rv$dd_list$data$form_name %in% repeated_instruments(uri = data_rv$uri, token = input$api)]
|
||||||
data_rv$dd_list$data$form_name %in% repeated_instruments(
|
|
||||||
uri = data_rv$uri,
|
|
||||||
token = input$api
|
|
||||||
)
|
|
||||||
]
|
|
||||||
|
|
||||||
if (input$data_type == "long" && isTRUE(any(input$fields %in% data_rv$rep_fields))) {
|
if (input$data_type == "long" &&
|
||||||
|
isTRUE(any(input$fields %in% data_rv$rep_fields))) {
|
||||||
vectorSelectInput(
|
vectorSelectInput(
|
||||||
inputId = ns("fill"),
|
inputId = ns("fill"),
|
||||||
label = i18n$t("Fill missing values?"),
|
label = i18n$t("Fill missing values?"),
|
||||||
|
|
@ -370,7 +369,6 @@ m_redcap_readServer <- function(id) {
|
||||||
# browser()
|
# browser()
|
||||||
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1]
|
||||||
|
|
||||||
|
|
||||||
parameters <- list(
|
parameters <- list(
|
||||||
uri = data_rv$uri,
|
uri = data_rv$uri,
|
||||||
token = input$api,
|
token = input$api,
|
||||||
|
|
@ -386,26 +384,31 @@ m_redcap_readServer <- function(id) {
|
||||||
)
|
)
|
||||||
|
|
||||||
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", {
|
||||||
imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE)
|
imported <- tryCatch(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters),
|
||||||
|
silent = TRUE)
|
||||||
})
|
})
|
||||||
|
|
||||||
parameters_code <- parameters[c("uri", "fields", "events", "raw_or_label", "filter_logic")]
|
# d <- REDCapCAST::apply_factor_labels(data = imported$survey, meta = data_rv$dd_list$data)
|
||||||
|
|
||||||
code <- rlang::call2(
|
parameters_code <- parameters[c("uri",
|
||||||
"easy_redcap",
|
"fields",
|
||||||
!!!utils::modifyList(
|
"events",
|
||||||
parameters_code,
|
"raw_or_label",
|
||||||
list(
|
"filter_logic")]
|
||||||
data_format = ifelse(
|
|
||||||
input$data_type == "long" && !is.null(input$data_type),
|
code <- rlang::call2("easy_redcap",
|
||||||
"long",
|
!!!utils::modifyList(
|
||||||
"wide"
|
parameters_code,
|
||||||
),
|
list(
|
||||||
project.name = simple_snake(data_rv$info$project_title)
|
data_format = ifelse(
|
||||||
)
|
input$data_type == "long" && !is.null(input$data_type),
|
||||||
),
|
"long",
|
||||||
.ns = "REDCapCAST"
|
"wide"
|
||||||
)
|
),
|
||||||
|
project.name = simple_snake(data_rv$info$project_title)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
.ns = "REDCapCAST")
|
||||||
|
|
||||||
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
if (inherits(imported, "try-error") || NROW(imported) < 1) {
|
||||||
data_rv$data_status <- "error"
|
data_rv$data_status <- "error"
|
||||||
|
|
@ -419,7 +422,6 @@ m_redcap_readServer <- function(id) {
|
||||||
## "wide"/"long" without re-importing data
|
## "wide"/"long" without re-importing data
|
||||||
|
|
||||||
if (parameters$split_form == "all") {
|
if (parameters$split_form == "all") {
|
||||||
# browser()
|
|
||||||
out <- imported |>
|
out <- imported |>
|
||||||
# redcap_wider()
|
# redcap_wider()
|
||||||
REDCapCAST::redcap_wider()
|
REDCapCAST::redcap_wider()
|
||||||
|
|
@ -442,78 +444,91 @@ m_redcap_readServer <- function(id) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# browser()
|
## Ensure correct factor labels
|
||||||
|
## It is a little hacky and should be included in the read_redcap_tables, but is lost along the way
|
||||||
|
out <- REDCapCAST::apply_factor_labels(data = out, meta = data_rv$dd_list$data)
|
||||||
|
|
||||||
|
|
||||||
in_data_check <- parameters$fields %in% names(out) |
|
in_data_check <- parameters$fields %in% names(out) |
|
||||||
sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y))))
|
sapply(names(out), \(.x) any(sapply(
|
||||||
|
parameters$fields, \(.y) startsWith(.x, .y)
|
||||||
|
)))
|
||||||
|
|
||||||
if (!any(in_data_check[-1])) {
|
if (!any(in_data_check[-1])) {
|
||||||
data_rv$data_status <- "warning"
|
data_rv$data_status <- "warning"
|
||||||
data_rv$data_message <- i18n$t("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.")
|
data_rv$data_message <- i18n$t(
|
||||||
|
"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)) {
|
if (!all(in_data_check)) {
|
||||||
data_rv$data_status <- "warning"
|
data_rv$data_status <- "warning"
|
||||||
data_rv$data_message <- i18n$t("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$data_message <- i18n$t(
|
||||||
|
"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$code <- code
|
||||||
|
|
||||||
|
## Level labels nare lost at this point...
|
||||||
data_rv$data <- out |>
|
data_rv$data <- out |>
|
||||||
dplyr::select(-dplyr::ends_with("_complete")) |>
|
dplyr::select(-dplyr::ends_with("_complete")) |>
|
||||||
# dplyr::select(-dplyr::any_of(record_id)) |>
|
# dplyr::select(-dplyr::any_of(record_id)) |>
|
||||||
REDCapCAST::suffix2label()
|
REDCapCAST::suffix2label()
|
||||||
|
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
shiny::observeEvent(
|
shiny::observeEvent(data_rv$data_status, {
|
||||||
data_rv$data_status,
|
# browser()
|
||||||
{
|
if (identical(data_rv$data_status, "error")) {
|
||||||
# browser()
|
datamods:::insert_error(mssg = data_rv$data_message,
|
||||||
if (identical(data_rv$data_status, "error")) {
|
selector = ns("retrieved"))
|
||||||
datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved"))
|
} else if (identical(data_rv$data_status, "success")) {
|
||||||
} else if (identical(data_rv$data_status, "success")) {
|
datamods:::insert_alert(
|
||||||
datamods:::insert_alert(
|
selector = ns("retrieved"),
|
||||||
selector = ns("retrieved"),
|
status = data_rv$data_status,
|
||||||
status = data_rv$data_status,
|
# tags$p(
|
||||||
# tags$p(
|
# tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
||||||
# tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"),
|
# data_rv$data_message
|
||||||
# data_rv$data_message
|
# ),
|
||||||
# ),
|
include_data_alert(
|
||||||
include_data_alert(
|
see_data_text = i18n$t("Click to see the imported data"),
|
||||||
see_data_text = i18n$t("Click to see the imported data"),
|
dataIdName = "see_data",
|
||||||
dataIdName = "see_data",
|
extra = tags$p(tags$b(
|
||||||
extra = tags$p(
|
phosphoricons::ph("check", weight = "bold"),
|
||||||
tags$b(phosphoricons::ph("check", weight = "bold"), data_rv$data_message)
|
|
||||||
),
|
|
||||||
btn_show_data = TRUE
|
|
||||||
)
|
|
||||||
)
|
|
||||||
} 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
|
data_rv$data_message
|
||||||
)
|
)),
|
||||||
|
btn_show_data = TRUE
|
||||||
)
|
)
|
||||||
}
|
)
|
||||||
|
} 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(
|
return(
|
||||||
status = shiny::reactive(data_rv$data_status),
|
list(
|
||||||
name = shiny::reactive(data_rv$info$project_title),
|
status = shiny::reactive(data_rv$data_status),
|
||||||
info = shiny::reactive(data_rv$info),
|
name = shiny::reactive(data_rv$info$project_title),
|
||||||
code = shiny::reactive(data_rv$code),
|
info = shiny::reactive(data_rv$info),
|
||||||
data = shiny::reactive(data_rv$data)
|
code = shiny::reactive(data_rv$code),
|
||||||
))
|
data = shiny::reactive(data_rv$data)
|
||||||
|
)
|
||||||
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
shiny::moduleServer(
|
shiny::moduleServer(id = id, module = module)
|
||||||
id = id,
|
|
||||||
module = module
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @importFrom htmltools tagList tags
|
#' @importFrom htmltools tagList tags
|
||||||
|
|
@ -524,14 +539,12 @@ include_data_alert <- function(dataIdName = "see_data",
|
||||||
extra = NULL,
|
extra = NULL,
|
||||||
session = shiny::getDefaultReactiveDomain()) {
|
session = shiny::getDefaultReactiveDomain()) {
|
||||||
if (isTRUE(btn_show_data)) {
|
if (isTRUE(btn_show_data)) {
|
||||||
success_message <- tagList(
|
success_message <- tagList(extra,
|
||||||
extra,
|
tags$br(),
|
||||||
tags$br(),
|
shiny::actionLink(
|
||||||
shiny::actionLink(
|
inputId = session$ns(dataIdName),
|
||||||
inputId = session$ns(dataIdName),
|
label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
|
||||||
label = tagList(phosphoricons::ph("book-open-text"), see_data_text)
|
))
|
||||||
)
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
return(success_message)
|
return(success_message)
|
||||||
}
|
}
|
||||||
|
|
@ -583,20 +596,18 @@ is_valid_redcap_url <- function(url) {
|
||||||
#' @examples
|
#' @examples
|
||||||
#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
|
#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "")
|
||||||
#' is_valid_token(token)
|
#' is_valid_token(token)
|
||||||
is_valid_token <- function(token, pattern_env = NULL, nchar = 32) {
|
is_valid_token <- function(token,
|
||||||
|
pattern_env = NULL,
|
||||||
|
nchar = 32) {
|
||||||
checkmate::assert_character(token, any.missing = TRUE, len = 1)
|
checkmate::assert_character(token, any.missing = TRUE, len = 1)
|
||||||
|
|
||||||
if (!is.null(pattern_env)) {
|
if (!is.null(pattern_env)) {
|
||||||
checkmate::assert_character(pattern_env,
|
checkmate::assert_character(pattern_env, any.missing = FALSE, len = 1)
|
||||||
any.missing = FALSE,
|
|
||||||
len = 1
|
|
||||||
)
|
|
||||||
pattern <- pattern_env
|
pattern <- pattern_env
|
||||||
} else {
|
} else {
|
||||||
pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
|
pattern <- glue::glue("^([0-9A-Fa-f]{<nchar>})(?:\\n)?$",
|
||||||
.open = "<",
|
.open = "<",
|
||||||
.close = ">"
|
.close = ">")
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if (is.na(token)) {
|
if (is.na(token)) {
|
||||||
|
|
@ -636,10 +647,15 @@ repeated_instruments <- function(uri, token) {
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
drop_empty_event <- function(data, event = "redcap_event_name") {
|
drop_empty_event <- function(data, event = "redcap_event_name") {
|
||||||
generics <- c(names(data)[1], "redcap_event_name", "redcap_repeat_instrument", "redcap_repeat_instance")
|
generics <- c(
|
||||||
|
names(data)[1],
|
||||||
|
"redcap_event_name",
|
||||||
|
"redcap_repeat_instrument",
|
||||||
|
"redcap_repeat_instance"
|
||||||
|
)
|
||||||
|
|
||||||
filt <- split(data, data[[event]]) |>
|
filt <- split(data, data[[event]]) |>
|
||||||
lapply(\(.x){
|
lapply(\(.x) {
|
||||||
dplyr::select(.x, -tidyselect::all_of(generics)) |>
|
dplyr::select(.x, -tidyselect::all_of(generics)) |>
|
||||||
REDCapCAST::all_na()
|
REDCapCAST::all_na()
|
||||||
}) |>
|
}) |>
|
||||||
|
|
@ -667,16 +683,10 @@ redcap_demo_app <- function() {
|
||||||
server <- function(input, output, session) {
|
server <- function(input, output, session) {
|
||||||
data_val <- m_redcap_readServer(id = "data")
|
data_val <- m_redcap_readServer(id = "data")
|
||||||
|
|
||||||
output$data <- DT::renderDataTable(
|
output$data <- DT::renderDataTable({
|
||||||
{
|
shiny::req(data_val$data)
|
||||||
shiny::req(data_val$data)
|
data_val$data()
|
||||||
data_val$data()
|
}, options = list(scrollX = TRUE, pageLength = 5), )
|
||||||
},
|
|
||||||
options = list(
|
|
||||||
scrollX = TRUE,
|
|
||||||
pageLength = 5
|
|
||||||
),
|
|
||||||
)
|
|
||||||
output$code <- shiny::renderPrint({
|
output$code <- shiny::renderPrint({
|
||||||
shiny::req(data_val$code)
|
shiny::req(data_val$code)
|
||||||
data_val$code()
|
data_val$code()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue