From 05c0f3501662a239b8a6cc7e529b3d47a9e5978b Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 09:34:05 +0100 Subject: [PATCH 1/6] first commit to add shiny app for basic upload of dictionary and dataset --- DESCRIPTION | 6 +- NAMESPACE | 5 + R/shiny_cast.R | 183 ++++++++++++++++++++++++++++++++ R/utils.r | 50 +++++++++ REDCapCAST.Rproj | 2 +- data-raw/data-upload-examples.R | 0 man/file_extension.Rd | 20 ++++ man/read_input.Rd | 22 ++++ man/server_factory.Rd | 14 +++ man/shiny_cast.Rd | 18 ++++ man/ui_factory.Rd | 14 +++ renv.lock | 4 +- 12 files changed, 333 insertions(+), 5 deletions(-) create mode 100644 R/shiny_cast.R create mode 100644 data-raw/data-upload-examples.R create mode 100644 man/file_extension.Rd create mode 100644 man/read_input.Rd create mode 100644 man/server_factory.Rd create mode 100644 man/shiny_cast.Rd create mode 100644 man/ui_factory.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 8a55e6f..a814992 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,11 +36,12 @@ Suggests: here, styler, devtools, - roxygen2 + roxygen2, + openxlsx2 License: GPL (>= 3) Encoding: UTF-8 LazyData: true -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 URL: https://github.com/agdamsbo/REDCapCAST, https://agdamsbo.github.io/REDCapCAST/ BugReports: https://github.com/agdamsbo/REDCapCAST/issues Imports: @@ -64,5 +65,6 @@ Collate: 'redcap_wider.R' 'redcapcast_data.R' 'redcapcast_meta.R' + 'shiny_cast.R' Language: en-US VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 8aaf1ef..072788d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,17 +6,22 @@ export(d2w) export(ds2dd) export(ds2dd_detailed) export(easy_redcap) +export(file_extension) export(focused_metadata) export(get_api_key) export(guess_time_only_filter) export(is_repeated_longitudinal) export(match_fields_to_form) +export(read_input) export(read_redcap_instrument) export(read_redcap_tables) export(redcap_wider) export(sanitize_split) +export(server_factory) +export(shiny_cast) export(split_non_repeating_forms) export(strsplitx) +export(ui_factory) importFrom(REDCapR,redcap_event_instruments) importFrom(REDCapR,redcap_metadata_read) importFrom(REDCapR,redcap_read) diff --git a/R/shiny_cast.R b/R/shiny_cast.R new file mode 100644 index 0000000..8cebd3f --- /dev/null +++ b/R/shiny_cast.R @@ -0,0 +1,183 @@ +#' Shiny server factory +#' +#' @return shiny server +#' @export +server_factory <- function() { + 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$upload.data.print <- shiny::renderPrint({ + shiny::eventReactive(input$upload.meta, { + shiny::req(input$uri) + + shiny::req(input$api) + + REDCapR::redcap_metadata_write( + ds = purrr::pluck(dd(), "meta"), + redcap_uri = input$uri, + token = input$api + ) + }) + }) + + output$upload.data.print <- shiny::renderPrint({ + shiny::eventReactive(input$upload.data, { + shiny::req(input$uri) + + shiny::req(input$api) + + REDCapR::redcap_write( + ds = purrr::pluck(dd(), "data"), + redcap_uri = input$uri, + token = input$api + ) + }) + }) + } +} + + + +#' UI factory for shiny app +#' +#' @return shiny ui +#' @export +ui_factory <- function() { + # require(ggplot2) + + 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 = "" + ), + shiny::textInput( + inputId = "api", + label = "API key", + value = "" + ), + shiny::actionButton( + inputId = "upload.meta", + label = "Upload dictionary", icon = icon("book-bookmark") + ), + shiny::h6("Please note, that before uploading any real data, put your project + into production mode."), + shiny::actionButton( + inputId = "upload.datata", + label = "Upload data", icon = 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 = span), + shiny::h3("Dictionary overview"), + shiny::htmlOutput("meta.tbl", container = span) + ) + ) + ) + ) +} + +#' Launch the included Shiny-app for database casting and upload +#' +#' @return shiny app +#' @export +#' +#' @examples +#' # shiny_cast() +#' +shiny_cast <- function() { + # shiny::runApp(appDir = here::here("app/"), launch.browser = TRUE) + + shiny::shinyApp( + ui_factory(), + server_factory() + ) +} diff --git a/R/utils.r b/R/utils.r index eec3fcd..98edb75 100644 --- a/R/utils.r +++ b/R/utils.r @@ -490,3 +490,53 @@ is_repeated_longitudinal <- function(data, generics = c( } any(generics %in% names) } + + + +#' Helper to import files correctly +#' +#' @param filenames file names +#' +#' @return character vector +#' @export +#' +#' @examples +#' file_extension(list.files(here::here(""))[[2]])[[1]] +file_extension <- function(filenames) { + sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", filenames, perl = TRUE) +} + +#' Flexible file import based on extension +#' +#' @param file file name +#' @param consider.na character vector of strings to consider as NAs +#' +#' @return tibble +#' @export +#' +#' @examples +#' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv") +read_input <- function(file, consider.na= c("NA", '""',"")){ + + ext <- file_extension(file) + + tryCatch( + { + if (ext == "csv") { + df <- readr::read_csv(file = file,na = consider.na) + } else if (ext %in% c("xls", "xlsx")) { + df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na) + } else if (ext == "dta"){ + df <- haven::read_dta(file = file) + } else { + stop("Input file format has to be either '.csv', '.xls' or '.xlsx'") + } + }, + error = function(e) { + # return a safeError if a parsing error occurs + stop(shiny::safeError(e)) + } + ) + + df +} diff --git a/REDCapCAST.Rproj b/REDCapCAST.Rproj index cba1b6b..4b56c89 100644 --- a/REDCapCAST.Rproj +++ b/REDCapCAST.Rproj @@ -18,4 +18,4 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source -PackageRoxygenize: rd,collate,namespace +PackageRoxygenize: rd,collate,namespace,vignette diff --git a/data-raw/data-upload-examples.R b/data-raw/data-upload-examples.R new file mode 100644 index 0000000..e69de29 diff --git a/man/file_extension.Rd b/man/file_extension.Rd new file mode 100644 index 0000000..5a6aeb6 --- /dev/null +++ b/man/file_extension.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.r +\name{file_extension} +\alias{file_extension} +\title{Helper to import files correctly} +\usage{ +file_extension(filenames) +} +\arguments{ +\item{filenames}{file names} +} +\value{ +character vector +} +\description{ +Helper to import files correctly +} +\examples{ +file_extension(list.files(here::here(""))[[2]])[[1]] +} diff --git a/man/read_input.Rd b/man/read_input.Rd new file mode 100644 index 0000000..f762f75 --- /dev/null +++ b/man/read_input.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.r +\name{read_input} +\alias{read_input} +\title{Flexible file import based on extension} +\usage{ +read_input(file, consider.na = c("NA", "\\"\\"", "")) +} +\arguments{ +\item{file}{file name} + +\item{consider.na}{character vector of strings to consider as NAs} +} +\value{ +tibble +} +\description{ +Flexible file import based on extension +} +\examples{ +read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv") +} diff --git a/man/server_factory.Rd b/man/server_factory.Rd new file mode 100644 index 0000000..6c3a7d0 --- /dev/null +++ b/man/server_factory.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_cast.R +\name{server_factory} +\alias{server_factory} +\title{Shiny server factory} +\usage{ +server_factory() +} +\value{ +shiny server +} +\description{ +Shiny server factory +} diff --git a/man/shiny_cast.Rd b/man/shiny_cast.Rd new file mode 100644 index 0000000..7811ed7 --- /dev/null +++ b/man/shiny_cast.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_cast.R +\name{shiny_cast} +\alias{shiny_cast} +\title{Launch the included Shiny-app for database casting and upload} +\usage{ +shiny_cast() +} +\value{ +shiny app +} +\description{ +Launch the included Shiny-app for database casting and upload +} +\examples{ +# shiny_cast() + +} diff --git a/man/ui_factory.Rd b/man/ui_factory.Rd new file mode 100644 index 0000000..80ca574 --- /dev/null +++ b/man/ui_factory.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_cast.R +\name{ui_factory} +\alias{ui_factory} +\title{UI factory for shiny app} +\usage{ +ui_factory() +} +\value{ +shiny ui +} +\description{ +UI factory for shiny app +} diff --git a/renv.lock b/renv.lock index 96748f7..69777eb 100644 --- a/renv.lock +++ b/renv.lock @@ -512,7 +512,7 @@ }, "tidyr": { "Package": "tidyr", - "Version": "1.3.0", + "Version": "1.3.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -531,7 +531,7 @@ "utils", "vctrs" ], - "Hash": "e47debdc7ce599b070c8e78e8ac0cfcf" + "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" }, "tidyselect": { "Package": "tidyselect", From 77989a21ed1a998fd3e1fc32b448e9165c720b90 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 15:07:17 +0100 Subject: [PATCH 2/6] slightly modified mtcars for upload testing --- data-raw/data-upload-examples.R | 5 +++++ data/mtcars_redcap.csv | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100644 data/mtcars_redcap.csv diff --git a/data-raw/data-upload-examples.R b/data-raw/data-upload-examples.R index e69de29..f07de0e 100644 --- a/data-raw/data-upload-examples.R +++ b/data-raw/data-upload-examples.R @@ -0,0 +1,5 @@ +mtcars |> dplyr::mutate(record_id=seq_len(n()), + name=rownames(mtcars) + ) |> + dplyr::select(record_id,dplyr::everything()) |> + write.csv(here::here("data/mtcars_redcap.csv"),row.names = FALSE) diff --git a/data/mtcars_redcap.csv b/data/mtcars_redcap.csv new file mode 100644 index 0000000..9fbb408 --- /dev/null +++ b/data/mtcars_redcap.csv @@ -0,0 +1,33 @@ +"record_id","mpg","cyl","disp","hp","drat","wt","qsec","vs","am","gear","carb","name" +1,21,6,160,110,3.9,2.62,16.46,0,1,4,4,"Mazda RX4" +2,21,6,160,110,3.9,2.875,17.02,0,1,4,4,"Mazda RX4 Wag" +3,22.8,4,108,93,3.85,2.32,18.61,1,1,4,1,"Datsun 710" +4,21.4,6,258,110,3.08,3.215,19.44,1,0,3,1,"Hornet 4 Drive" +5,18.7,8,360,175,3.15,3.44,17.02,0,0,3,2,"Hornet Sportabout" +6,18.1,6,225,105,2.76,3.46,20.22,1,0,3,1,"Valiant" +7,14.3,8,360,245,3.21,3.57,15.84,0,0,3,4,"Duster 360" +8,24.4,4,146.7,62,3.69,3.19,20,1,0,4,2,"Merc 240D" +9,22.8,4,140.8,95,3.92,3.15,22.9,1,0,4,2,"Merc 230" +10,19.2,6,167.6,123,3.92,3.44,18.3,1,0,4,4,"Merc 280" +11,17.8,6,167.6,123,3.92,3.44,18.9,1,0,4,4,"Merc 280C" +12,16.4,8,275.8,180,3.07,4.07,17.4,0,0,3,3,"Merc 450SE" +13,17.3,8,275.8,180,3.07,3.73,17.6,0,0,3,3,"Merc 450SL" +14,15.2,8,275.8,180,3.07,3.78,18,0,0,3,3,"Merc 450SLC" +15,10.4,8,472,205,2.93,5.25,17.98,0,0,3,4,"Cadillac Fleetwood" +16,10.4,8,460,215,3,5.424,17.82,0,0,3,4,"Lincoln Continental" +17,14.7,8,440,230,3.23,5.345,17.42,0,0,3,4,"Chrysler Imperial" +18,32.4,4,78.7,66,4.08,2.2,19.47,1,1,4,1,"Fiat 128" +19,30.4,4,75.7,52,4.93,1.615,18.52,1,1,4,2,"Honda Civic" +20,33.9,4,71.1,65,4.22,1.835,19.9,1,1,4,1,"Toyota Corolla" +21,21.5,4,120.1,97,3.7,2.465,20.01,1,0,3,1,"Toyota Corona" +22,15.5,8,318,150,2.76,3.52,16.87,0,0,3,2,"Dodge Challenger" +23,15.2,8,304,150,3.15,3.435,17.3,0,0,3,2,"AMC Javelin" +24,13.3,8,350,245,3.73,3.84,15.41,0,0,3,4,"Camaro Z28" +25,19.2,8,400,175,3.08,3.845,17.05,0,0,3,2,"Pontiac Firebird" +26,27.3,4,79,66,4.08,1.935,18.9,1,1,4,1,"Fiat X1-9" +27,26,4,120.3,91,4.43,2.14,16.7,0,1,5,2,"Porsche 914-2" +28,30.4,4,95.1,113,3.77,1.513,16.9,1,1,5,2,"Lotus Europa" +29,15.8,8,351,264,4.22,3.17,14.5,0,1,5,4,"Ford Pantera L" +30,19.7,6,145,175,3.62,2.77,15.5,0,1,5,6,"Ferrari Dino" +31,15,8,301,335,3.54,3.57,14.6,0,1,5,8,"Maserati Bora" +32,21.4,4,121,109,4.11,2.78,18.6,1,1,4,2,"Volvo 142E" From 29cf7b2745560fb93bf13e9dab68982a883ead90 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 15:07:54 +0100 Subject: [PATCH 3/6] we have a working prototype! needs a bit of cleaning --- R/shiny_cast.R | 107 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 78 insertions(+), 29 deletions(-) diff --git a/R/shiny_cast.R b/R/shiny_cast.R index 8cebd3f..b3ebfed 100644 --- a/R/shiny_cast.R +++ b/R/shiny_cast.R @@ -6,6 +6,28 @@ 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) @@ -45,33 +67,46 @@ server_factory <- function() { write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE) } ) - output$upload.data.print <- shiny::renderPrint({ - shiny::eventReactive(input$upload.meta, { - shiny::req(input$uri) - shiny::req(input$api) + output_staging <- shiny::reactiveValues() + output_staging$meta <- output_staging$data <- NA - REDCapR::redcap_metadata_write( - ds = purrr::pluck(dd(), "meta"), - redcap_uri = input$uri, - token = input$api - ) - }) - }) + shiny::observeEvent(input$upload.meta,{ upload_meta() }) - output$upload.data.print <- shiny::renderPrint({ - shiny::eventReactive(input$upload.data, { - shiny::req(input$uri) + shiny::observeEvent(input$upload.data,{ upload_data() }) - shiny::req(input$api) + 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) - REDCapR::redcap_write( - ds = purrr::pluck(dd(), "data"), - redcap_uri = input$uri, - token = input$api - ) - }) - }) } } @@ -126,22 +161,22 @@ ui_factory <- function() { shiny::textInput( inputId = "uri", label = "URI", - value = "" + value = "https://redcap.au.dk/api/" ), shiny::textInput( inputId = "api", label = "API key", - value = "" + value = "21CF2C17EA1CA4F3688DF991C8FE3EBF" ), shiny::actionButton( inputId = "upload.meta", - label = "Upload dictionary", icon = icon("book-bookmark") + 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.datata", - label = "Upload data", icon = icon("upload") + inputId = "upload.data", + label = "Upload data", icon = shiny::icon("upload") ), # Horizontal line ---- @@ -156,9 +191,19 @@ ui_factory <- function() { shiny::tabPanel( "Summary", shiny::h3("Data overview (first 20)"), - shiny::htmlOutput("data.tbl", container = span), + shiny::htmlOutput("data.tbl", container = shiny::span), shiny::h3("Dictionary overview"), - shiny::htmlOutput("meta.tbl", container = span) + 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) ) ) ) @@ -181,3 +226,7 @@ shiny_cast <- function() { server_factory() ) } + +shiny_cast() +# ds <- REDCapR::redcap_metadata_read(redcap_uri = "https://redcap.au.dk/api/", +# token = "21CF2C17EA1CA4F3688DF991C8FE3EBF") From 6467cc724b2aac7da9dd111483b7c6cf8b37bd0f Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 15:09:30 +0100 Subject: [PATCH 4/6] trying to ignore ds_store --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 4695a9c..f0f2011 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,5 @@ logo.R *.DS_Store docs drafting +\.DS_Store +.DS_Store From 538c6ee188202fdfd2cee58f08595b606c0f6257 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 19:51:16 +0100 Subject: [PATCH 5/6] delete --- .DS_Store | Bin 6148 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 .DS_Store diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index bc280ca2de2383f01e9dda134e8c735437f007a4..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeHKJ5Iwu5S@vG6qF_ zW@lx4v5}|{LNn6tv*+Wt`)ql4iHN5+^9j+2hz4kay=`v@k9vwOxKUC{~M zF3%@fE884@Q33q`=6Gw@XpQ%GTI4GoFuwu^^d%=R(sZ^gW)j$TfZh7rafLkNb+pMQV;P z5=CcKj&uEQ)9q{xn-@<5R`y&QxIsCED zOFWi}T2Abk@f^?0{)EDQr^B&JCr%WtHw8?AP=QEqN3#AOe1HBAi|o!6Fa`dV0^Cot zbc!kYwY4=lS!-joV>B_zD;28}T)3qexv~`RpgDs-mJ49wu~dWyW*Y$~gLS6BuPX2f D%@u!Y From 71e53e5cd6cae0569c9b973dd752ac48493f544d Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 26 Feb 2024 20:32:26 +0100 Subject: [PATCH 6/6] 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)) } }