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",