first commit to add shiny app for basic upload of dictionary and dataset

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

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)

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()
+  )
+}

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
+}

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

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]]
+}

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")
+}

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
+}

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()
+
+}

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
+}

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