mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-22 05:20:23 +01:00
shiny app moved to app folder and seperate files for possible shinylive deploy
This commit is contained in:
parent
538c6ee188
commit
71e53e5cd6
@ -37,7 +37,8 @@ Suggests:
|
||||
styler,
|
||||
devtools,
|
||||
roxygen2,
|
||||
openxlsx2
|
||||
openxlsx2,
|
||||
rsconnect
|
||||
License: GPL (>= 3)
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
|
||||
224
R/shiny_cast.R
224
R/shiny_cast.R
@ -3,114 +3,9 @@
|
||||
#' @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)
|
||||
source(here::here("app/server.R"))
|
||||
server
|
||||
}
|
||||
)
|
||||
|
||||
# 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)
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' UI factory for shiny app
|
||||
#'
|
||||
@ -118,96 +13,8 @@ server_factory <- function() {
|
||||
#' @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,)
|
||||
}
|
||||
|
||||
81
app/server.R
Normal file
81
app/server.R
Normal file
@ -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)
|
||||
|
||||
}
|
||||
89
app/ui.R
Normal file
89
app/ui.R
Normal file
@ -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)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@ -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",
|
||||
|
||||
@ -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))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user