R/shiny_cast.R

In REDCapCAST: REDCap Metadata Casting and Castellated Data Handling

#' Launch the included Shiny-app for database casting and upload
#'
#' @description
#' Wraps shiny::runApp()
#'
#' @param ... Arguments passed to shiny::runApp()
#'
#' @return shiny app
#' @export
#'
#' @examples
#' # shiny_cast()
#'
shiny_cast <- function(...) {
  appDir <- system.file("shiny-examples", "casting", package = "REDCapCAST")
  if (appDir == "") {
    stop("Could not find example directory. Try re-installing `REDCapCAST`.", call. = FALSE)
  }

  shiny::runApp(appDir = appDir, ...)
}


#' DEPRECATED Helper to import files correctly
#'
#' @param filenames file names
#'
#' @return character vector
#' @export
#'
#' @examples
#' file_extension(list.files(here::here(""))[[2]])[[1]]
#' file_extension(c("file.cd..ks", "file"))
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
#'
#' @importFrom openxlsx2 read_xlsx
#' @importFrom haven read_dta
#' @importFrom readODS read_ods
#' @importFrom readr read_csv read_rds
#'
#'
#' @examples
#' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv")
read_input <- function(file, consider.na = c("NA", '""', "")) {
  ext <- tolower(tools::file_ext(file))

  tryCatch(
    {
      if (ext == "csv") {
        df <- read_csv(file = file, na = consider.na)
      } else if (ext %in% c("xls", "xlsx")) {
        df <- read_xlsx(file = file, na.strings = consider.na)
      } else if (ext == "dta") {
        df <- read_dta(file = file)
      } else if (ext == "ods") {
        df <- read_ods(path = file)
      } else if (ext == "rds") {
        df <- read_rds(file = file)
      }else {
        stop("Input file format has to be on of:
             '.csv', '.xls', '.xlsx', '.dta', '.ods' or '.rds'")
      }
    },
    error = function(e) {
      # return a safeError if a parsing error occurs
      stop(shiny::safeError(e))
    }
  )

  df
}

#' Overview of REDCapCAST data for shiny
#'
#' @param data list with class 'REDCapCAST'
#'
#' @return gt object
#' @export
cast_data_overview <- function(data){
  stopifnot("REDCapCAST" %in% class(data))
  data |>
    purrr::pluck("data") |>
    utils::head(20) |>
    # dplyr::tibble() |>
    gt::gt() |>
    gt::tab_style(
      style = gt::cell_text(weight = "bold"),
      locations = gt::cells_column_labels(dplyr::everything())
    ) |>
    gt::tab_header(
      title = "Imported data preview",
      subtitle = "The first 20 subjects of the supplied dataset for reference."
    )
}


#' Overview of REDCapCAST meta data for shiny
#'
#' @param data list with class 'REDCapCAST'
#'
#' @return gt object
#' @export
cast_meta_overview <- function(data){
  stopifnot("REDCapCAST" %in% class(data))
  data |>
    purrr::pluck("meta") |>
    # dplyr::tibble() |>
    dplyr::mutate(
      dplyr::across(
        dplyr::everything(),
        \(.x) {
          .x[is.na(.x)] <- ""
          return(.x)
        }
      )
    ) |>
    dplyr::select(1:8) |>
    gt::gt() |>
    gt::tab_style(
      style = gt::cell_text(weight = "bold"),
      locations = gt::cells_column_labels(dplyr::everything())
    ) |>
    gt::tab_header(
      title = "Generated metadata",
      subtitle = "Only the first 8 columns are modified using REDCapCAST. Download the metadata to see everything."
    ) |>
    gt::tab_style(
      style = gt::cell_borders(
        sides = c("left", "right"),
        color = "grey80",
        weight = gt::px(1)
      ),
      locations = gt::cells_body(
        columns = dplyr::everything()
      )
    )
}


#' Nav_bar defining function for shiny ui
#'
#' @return shiny object
#' @export
#'
nav_bar_page <- function(){
  bslib::page_navbar(
    title = "Easy REDCap database creation",
    sidebar = bslib::sidebar(
      width = 300,
      shiny::h5("Metadata casting"),
      shiny::fileInput(
        inputId = "ds",
        label = "Upload spreadsheet",
        multiple = FALSE,
        accept = c(
          ".csv",
          ".xls",
          ".xlsx",
          ".dta",
          ".rds",
          ".ods"
        )
      ),
      # shiny::actionButton(
      #   inputId = "load_data",
      #   label = "Load data",
      #   icon = shiny::icon("circle-down")
      # ),
      shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."),
      # For some odd reason this only unfolds when the preview panel is shown..
      # This has been solved by adding an arbitrary button to load data - which was abandoned again
      shiny::conditionalPanel(
        condition = "output.uploaded=='yes'",
        shiny::radioButtons(
          inputId = "add_id",
          label = "Add ID, or use first column?",
          selected = "no",
          inline = TRUE,
          choices = list(
            "First column" = "no",
            "Add ID" = "yes",
            "No ID" = "none"
          )
        ),
        shiny::radioButtons(
          inputId = "specify_factors",
          label = "Specify categorical variables?",
          selected = "no",
          inline = TRUE,
          choices = list(
            "No" = "no",
            "Yes" = "yes"
          )
        ),
        shiny::conditionalPanel(
          condition = "input.specify_factors=='yes'",
          shiny::uiOutput("factor_vars")
        ),
        # condition = "input.load_data",
        #  shiny::helpText("Below you can download the dataset formatted for upload and the
        # corresponding data dictionary for a new data base, if you want to upload manually."),
        # Button
        shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"),

        # Button
        shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"),

        # Button
        shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"),

        # Horizontal line ----
        shiny::tags$hr(),
        shiny::radioButtons(
          inputId = "upload_redcap",
          label = "Upload directly to REDCap server?",
          selected = "no",
          inline = TRUE,
          choices = list(
            "No" = "no",
            "Yes" = "yes"
          )
        ),
        shiny::conditionalPanel(
          condition = "input.upload_redcap=='yes'",
          shiny::h4("2) Data base upload"),
          shiny::helpText("This tool is usable for now. Detailed instructions are coming."),
          shiny::textInput(
            inputId = "uri",
            label = "URI",
            value = "https://redcap.your.institution/api/"
          ),
          shiny::textInput(
            inputId = "api",
            label = "API key",
            value = ""
          ),
          shiny::helpText("An API key is an access key to the REDCap database. Please", shiny::a("see here for directions", href = "https://www.iths.org/news/redcap-tip/redcap-api-101/"), " to obtain an API key for your project."),
          shiny::actionButton(
            inputId = "upload.meta",
            label = "Upload datadictionary", icon = shiny::icon("book-bookmark")
          ),
          shiny::helpText("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")
          )
        )
      ),
      shiny::br(),
      shiny::br(),
      shiny::br(),
      shiny::p(
        "License: ", shiny::a("GPL-3+", href = "https://agdamsbo.github.io/REDCapCAST/LICENSE.html")
      ),
      shiny::p(
        shiny::a("Package documentation", href = "https://agdamsbo.github.io/REDCapCAST")
      )
    ),
    bslib::nav_panel(
      title = "Intro",
      shiny::markdown(readLines("www/SHINYCAST.md")),
      shiny::br()
    ),
    # bslib::nav_spacer(),
    bslib::nav_panel(
      title = "Data preview",
      gt::gt_output(outputId = "data.tbl")
      # shiny::htmlOutput(outputId = "data.tbl", container = shiny::span)
    ),
    bslib::nav_panel(
      title = "Dictionary overview",
      gt::gt_output(outputId = "meta.tbl")
      # shiny::htmlOutput(outputId = "meta.tbl", container = shiny::span)
    ),
    bslib::nav_panel(
      title = "Upload",
      shiny::h3("Meta upload overview"),
      shiny::textOutput(outputId = "upload.meta.print"),
      shiny::h3("Data upload overview"),
      shiny::textOutput(outputId = "upload.data.print")
    )
  )
}