From 71e53e5cd6cae0569c9b973dd752ac48493f544d Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 20:32:26 +0100 Subject: [PATCH] shiny app moved to app folder and seperate files for possible shinylive deploy --- DESCRIPTION | 3 +- R/shiny_cast.R | 224 ++++++------------------------------------------ app/server.R | 81 +++++++++++++++++ app/ui.R | 89 +++++++++++++++++++ renv.lock | 4 +- renv/activate.R | 39 +++++++-- 6 files changed, 229 insertions(+), 211 deletions(-) create mode 100644 app/server.R create mode 100644 app/ui.R diff --git a/DESCRIPTION b/DESCRIPTION index a814992..828fc23 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,8 @@ Suggests: styler, devtools, roxygen2, - openxlsx2 + openxlsx2, + rsconnect License: GPL (>= 3) Encoding: UTF-8 LazyData: true diff --git a/R/shiny_cast.R b/R/shiny_cast.R index b3ebfed..2ce90ff 100644 --- a/R/shiny_cast.R +++ b/R/shiny_cast.R @@ -3,211 +3,18 @@ #' @return shiny server #' @export server_factory <- function() { - function(input, output, session) { - require(REDCapCAST) - - - ## Trial and error testing - # dat <- read_input(file = here::here("data/mtcars_redcap.csv")) - # - # dd <- ds2dd_detailed(data = dat) - # - # write.csv(purrr::pluck(dd, "meta"),file = "dd_test.csv",row.names = FALSE,na = "") - # - # View(as.data.frame(purrr::pluck(dd, "meta"))) - # - # REDCapR::redcap_metadata_write( - # ds = as.data.frame(purrr::pluck(dd, "meta")), - # redcap_uri = "https://redcap.au.dk/api/", - # token = "21CF2C17EA1CA4F3688DF991C8FE3EBF" - # ) - # - # REDCapR::redcap_write( - # ds = as.data.frame(purrr::pluck(dd, "data")), - # redcap_uri = "https://redcap.au.dk/api/", - # token = "21CF2C17EA1CA4F3688DF991C8FE3EBF" - # ) - - dat <- shiny::reactive({ - shiny::req(input$ds) - - read_input(input$ds$datapath) - }) - - dd <- shiny::reactive({ - ds2dd_detailed(data = dat()) - }) - - - output$data.tbl <- shiny::renderTable({ - dd() |> - purrr::pluck("data") |> - head(20) |> - dplyr::tibble() - }) - - output$meta.tbl <- shiny::renderTable({ - dd() |> - purrr::pluck("meta") |> - dplyr::tibble() - }) - - # Downloadable csv of dataset ---- - output$downloadData <- shiny::downloadHandler( - filename = "data_ready.csv", - content = function(file) { - write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE) - } - ) - - # Downloadable csv of data dictionary ---- - output$downloadMeta <- shiny::downloadHandler( - filename = "dictionary_ready.csv", - content = function(file) { - write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE) - } - ) - - output_staging <- shiny::reactiveValues() - output_staging$meta <- output_staging$data <- NA - - shiny::observeEvent(input$upload.meta,{ upload_meta() }) - - shiny::observeEvent(input$upload.data,{ upload_data() }) - - upload_meta <- function(){ - # output_staging$title <- paste0("random number ",runif(1)) - - shiny::req(input$uri) - - shiny::req(input$api) - - output_staging$meta <- REDCapR::redcap_metadata_write( - ds = purrr::pluck(dd(), "meta"), - redcap_uri = input$uri, - token = input$api - )|> purrr::pluck("success") - } - - upload_data <- function(){ - # output_staging$title <- paste0("random number ",runif(1)) - - shiny::req(input$uri) - - shiny::req(input$api) - - output_staging$data <- REDCapR::redcap_write( - ds = purrr::pluck(dd(), "data"), - redcap_uri = input$uri, - token = input$api - ) |> purrr::pluck("success") - } - - output$upload.meta.print <- renderText(output_staging$meta) - - output$upload.data.print <- renderText(output_staging$data) - - } + source(here::here("app/server.R")) + server } - - #' UI factory for shiny app #' #' @return shiny ui #' @export ui_factory <- function() { # require(ggplot2) +source(here::here("app/ui.R")) - shiny::fluidPage( - - ## ----------------------------------------------------------------------------- - ## Application title - ## ----------------------------------------------------------------------------- - shiny::titlePanel("Simple REDCap data base creation and data upload from data set file via API", - windowTitle = "REDCap databse creator" - ), - shiny::h5("Please note, that this tool serves as a demonstration of some of the functionality - of the REDCapCAST package. No responsibility for data loss or any other - problems will be taken."), - - ## ----------------------------------------------------------------------------- - ## Side panel - ## ----------------------------------------------------------------------------- - - shiny::sidebarPanel( - shiny::h4("REDCap database and dataset"), - shiny::fileInput("ds", "Choose data file", - multiple = FALSE, - accept = c( - ".csv", - ".xls", - ".xlsx", - ".dta" - ) - ), - shiny::h6("Below you can download the dataset formatted for upload and the - corresponding data dictionary for a new data base."), - # Button - shiny::downloadButton("downloadData", "Download data"), - - # Button - shiny::downloadButton("downloadMeta", "Download dictionary"), - - - # Horizontal line ---- - shiny::tags$hr(), - shiny::h4("REDCap upload"), - shiny::textInput( - inputId = "uri", - label = "URI", - value = "https://redcap.au.dk/api/" - ), - shiny::textInput( - inputId = "api", - label = "API key", - value = "21CF2C17EA1CA4F3688DF991C8FE3EBF" - ), - shiny::actionButton( - inputId = "upload.meta", - label = "Upload dictionary", icon = shiny::icon("book-bookmark") - ), - shiny::h6("Please note, that before uploading any real data, put your project - into production mode."), - shiny::actionButton( - inputId = "upload.data", - label = "Upload data", icon = shiny::icon("upload") - ), - - # Horizontal line ---- - shiny::tags$hr() - ), - shiny::mainPanel( - shiny::tabsetPanel( - - ## ----------------------------------------------------------------------------- - ## Summary tab - ## ----------------------------------------------------------------------------- - shiny::tabPanel( - "Summary", - shiny::h3("Data overview (first 20)"), - shiny::htmlOutput("data.tbl", container = shiny::span), - shiny::h3("Dictionary overview"), - shiny::htmlOutput("meta.tbl", container = shiny::span) - ), - ## ----------------------------------------------------------------------------- - ## Upload tab - ## ----------------------------------------------------------------------------- - shiny::tabPanel( - "Upload", - shiny::h3("Meta upload overview"), - shiny::htmlOutput("upload.meta.print", container = shiny::span), - shiny::h3("Data upload overview"), - shiny::htmlOutput("upload.data.print", container = shiny::span) - ) - ) - ) - ) } #' Launch the included Shiny-app for database casting and upload @@ -227,6 +34,25 @@ shiny_cast <- function() { ) } -shiny_cast() -# ds <- REDCapR::redcap_metadata_read(redcap_uri = "https://redcap.au.dk/api/", -# token = "21CF2C17EA1CA4F3688DF991C8FE3EBF") +#' Deploy the Shiny app with rsconnect +#' +#' @return deploy +#' @export +#' +#' @examples +#' # deploy_shiny +#' +deploy_shiny <- function(path=here::here("app/"), name.app="shiny_cast"){ + # Ensure to install latest package version + renv::install("agdamsbo/REDCapCAST") + + # Connecting + rsconnect::setAccountInfo( + name = "cognitiveindex", + token = keyring::key_get(service = "rsconnect_cognitiveindex_token"), + secret = keyring::key_get(service = "rsconnect_cognitiveindex_secret") + ) + + # Deploying + rsconnect::deployApp(appDir = path,lint = TRUE,appName = name.app,) +} diff --git a/app/server.R b/app/server.R new file mode 100644 index 0000000..df8900e --- /dev/null +++ b/app/server.R @@ -0,0 +1,81 @@ +server <- function(input, output, session) { + require(REDCapCAST) + + dat <- shiny::reactive({ + shiny::req(input$ds) + + read_input(input$ds$datapath) + }) + + dd <- shiny::reactive({ + ds2dd_detailed(data = dat()) + }) + + + output$data.tbl <- shiny::renderTable({ + dd() |> + purrr::pluck("data") |> + head(20) |> + dplyr::tibble() + }) + + output$meta.tbl <- shiny::renderTable({ + dd() |> + purrr::pluck("meta") |> + dplyr::tibble() + }) + + # Downloadable csv of dataset ---- + output$downloadData <- shiny::downloadHandler( + filename = "data_ready.csv", + content = function(file) { + write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE) + } + ) + + # Downloadable csv of data dictionary ---- + output$downloadMeta <- shiny::downloadHandler( + filename = "dictionary_ready.csv", + content = function(file) { + write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE) + } + ) + + output_staging <- shiny::reactiveValues() + output_staging$meta <- output_staging$data <- NA + + shiny::observeEvent(input$upload.meta,{ upload_meta() }) + + shiny::observeEvent(input$upload.data,{ upload_data() }) + + upload_meta <- function(){ + + shiny::req(input$uri) + + shiny::req(input$api) + + output_staging$meta <- REDCapR::redcap_metadata_write( + ds = purrr::pluck(dd(), "meta"), + redcap_uri = input$uri, + token = input$api + )|> purrr::pluck("success") + } + + upload_data <- function(){ + + shiny::req(input$uri) + + shiny::req(input$api) + + output_staging$data <- REDCapR::redcap_write( + ds = purrr::pluck(dd(), "data"), + redcap_uri = input$uri, + token = input$api + ) |> purrr::pluck("success") + } + + output$upload.meta.print <- renderText(output_staging$meta) + + output$upload.data.print <- renderText(output_staging$data) + +} diff --git a/app/ui.R b/app/ui.R new file mode 100644 index 0000000..b20423b --- /dev/null +++ b/app/ui.R @@ -0,0 +1,89 @@ +ui <- shiny::fluidPage( + + ## ----------------------------------------------------------------------------- + ## Application title + ## ----------------------------------------------------------------------------- + shiny::titlePanel("Simple REDCap data base creation and data upload from data set file via API", + windowTitle = "REDCap databse creator" + ), + shiny::h5("Please note, that this tool serves as a demonstration of some of the functionality + of the REDCapCAST package. No responsibility for data loss or any other + problems will be taken."), + + ## ----------------------------------------------------------------------------- + ## Side panel + ## ----------------------------------------------------------------------------- + + shiny::sidebarPanel( + shiny::h4("REDCap database and dataset"), + shiny::fileInput("ds", "Choose data file", + multiple = FALSE, + accept = c( + ".csv", + ".xls", + ".xlsx", + ".dta" + ) + ), + shiny::h6("Below you can download the dataset formatted for upload and the + corresponding data dictionary for a new data base."), + # Button + shiny::downloadButton("downloadData", "Download data"), + + # Button + shiny::downloadButton("downloadMeta", "Download dictionary"), + + + # Horizontal line ---- + shiny::tags$hr(), + shiny::h4("REDCap upload"), + shiny::textInput( + inputId = "uri", + label = "URI", + value = "https://redcap.au.dk/api/" + ), + shiny::textInput( + inputId = "api", + label = "API key", + value = "21CF2C17EA1CA4F3688DF991C8FE3EBF" + ), + shiny::actionButton( + inputId = "upload.meta", + label = "Upload dictionary", icon = shiny::icon("book-bookmark") + ), + shiny::h6("Please note, that before uploading any real data, put your project + into production mode."), + shiny::actionButton( + inputId = "upload.data", + label = "Upload data", icon = shiny::icon("upload") + ), + + # Horizontal line ---- + shiny::tags$hr() + ), + shiny::mainPanel( + shiny::tabsetPanel( + + ## ----------------------------------------------------------------------------- + ## Summary tab + ## ----------------------------------------------------------------------------- + shiny::tabPanel( + "Summary", + shiny::h3("Data overview (first 20)"), + shiny::htmlOutput("data.tbl", container = shiny::span), + shiny::h3("Dictionary overview"), + shiny::htmlOutput("meta.tbl", container = shiny::span) + ), + ## ----------------------------------------------------------------------------- + ## Upload tab + ## ----------------------------------------------------------------------------- + shiny::tabPanel( + "Upload", + shiny::h3("Meta upload overview"), + shiny::htmlOutput("upload.meta.print", container = shiny::span), + shiny::h3("Data upload overview"), + shiny::htmlOutput("upload.data.print", container = shiny::span) + ) + ) + ) +) diff --git a/renv.lock b/renv.lock index 69777eb..61bdd07 100644 --- a/renv.lock +++ b/renv.lock @@ -428,13 +428,13 @@ }, "renv": { "Package": "renv", - "Version": "1.0.3", + "Version": "1.0.4", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "utils" ], - "Hash": "41b847654f567341725473431dd0d5ab" + "Hash": "11abaf7c540ff33f94514d50f929bfd1" }, "rlang": { "Package": "rlang", diff --git a/renv/activate.R b/renv/activate.R index cb5401f..d98ed73 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,7 @@ local({ # the requested version of renv - version <- "1.0.3" + version <- "1.0.4" attr(version, "sha") <- NULL # the project directory @@ -31,6 +31,14 @@ local({ if (!is.null(override)) return(override) + # if we're being run in a context where R_LIBS is already set, + # don't load -- presumably we're being run as a sub-process and + # the parent process has already set up library paths for us + rcmd <- Sys.getenv("R_CMD", unset = NA) + rlibs <- Sys.getenv("R_LIBS", unset = NA) + if (!is.na(rlibs) && !is.na(rcmd)) + return(FALSE) + # next, check environment variables # TODO: prefer using the configuration one in the future envvars <- c( @@ -50,9 +58,22 @@ local({ }) - if (!enabled) + # bail if we're not enabled + if (!enabled) { + + # if we're not enabled, we might still need to manually load + # the user profile here + profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile") + if (file.exists(profile)) { + cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE") + if (tolower(cfg) %in% c("true", "t", "1")) + sys.source(profile, envir = globalenv()) + } + return(FALSE) + } + # avoid recursion if (identical(getOption("renv.autoloader.running"), TRUE)) { warning("ignoring recursive attempt to run renv autoloader") @@ -1041,7 +1062,7 @@ local({ # if jsonlite is loaded, use that instead if ("jsonlite" %in% loadedNamespaces()) { - json <- catch(renv_json_read_jsonlite(file, text)) + json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity) if (!inherits(json, "error")) return(json) @@ -1050,7 +1071,7 @@ local({ } # otherwise, fall back to the default JSON reader - json <- catch(renv_json_read_default(file, text)) + json <- tryCatch(renv_json_read_default(file, text), error = identity) if (!inherits(json, "error")) return(json) @@ -1063,14 +1084,14 @@ local({ } renv_json_read_jsonlite <- function(file = NULL, text = NULL) { - text <- paste(text %||% read(file), collapse = "\n") + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") jsonlite::fromJSON(txt = text, simplifyVector = FALSE) } renv_json_read_default <- function(file = NULL, text = NULL) { # find strings in the JSON - text <- paste(text %||% read(file), collapse = "\n") + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' locs <- gregexpr(pattern, text, perl = TRUE)[[1]] @@ -1118,14 +1139,14 @@ local({ map <- as.list(map) # remap strings in object - remapped <- renv_json_remap(json, map) + remapped <- renv_json_read_remap(json, map) # evaluate eval(remapped, envir = baseenv()) } - renv_json_remap <- function(json, map) { + renv_json_read_remap <- function(json, map) { # fix names if (!is.null(names(json))) { @@ -1152,7 +1173,7 @@ local({ # recurse if (is.recursive(json)) { for (i in seq_along(json)) { - json[i] <- list(renv_json_remap(json[[i]], map)) + json[i] <- list(renv_json_read_remap(json[[i]], map)) } }