REDCapCAST/inst/shiny-examples/casting/app.R

library(bslib)
library(shiny)
library(openxlsx2)
library(haven)
library(readODS)
library(readr)
library(dplyr)
library(gt)
library(devtools)

# if (!requireNamespace("REDCapCAST")) {
#   install.packages("REDCapCAST")
# }
# library(REDCapCAST)

## Load merged files for shinyapps.io hosting
if (file.exists(here::here("functions.R"))) {
  source(here::here("functions.R"))
}

server <- function(input, output, session) {
  v <- shiny::reactiveValues(
    file = NULL
  )

  ds <- shiny::reactive({
    shiny::req(input$ds)

    out <- read_input(input$ds$datapath)

    out <- out |>
      ## Parses data with readr functions
      parse_data() |>
      ## Converts logical to factor, preserving attributes with own function
      dplyr::mutate(dplyr::across(dplyr::where(is.logical), as_factor))

    out
  })

  dat <- shiny::reactive({
    out <- ds()

    if (!is.null(input$factor_vars)) {
      out <- out |>
        dplyr::mutate(
          dplyr::across(
            dplyr::all_of(input$factor_vars),
            as_factor
          )
        )
    }

    out
  })

  # getData <- reactive({
  #   if(is.null(input$ds$datapath)) return(NULL)
  # })
  # output$uploaded <- reactive({
  #   return(!is.null(getData()))
  # })

  dd <- shiny::reactive({
    shiny::req(input$ds)
    v$file <- "loaded"
    ds2dd_detailed(
      data = dat(),
      add.auto.id = input$add_id == "yes",
      metadata = c(
        "field_name", "form_name", "section_header", "field_type",
        "field_label", "select_choices_or_calculations", "field_note",
        "text_validation_type_or_show_slider_number", "text_validation_min",
        "text_validation_max", "identifier", "branching_logic", "required_field",
        "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking",
        "field_annotation"
      )
    )
  })

  output$uploaded <- shiny::reactive({
    if (is.null(v$file)) {
      "no"
    } else {
      "yes"
    }
  })

  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)

  output$factor_vars <- shiny::renderUI({
    shiny::req(input$ds)
    selectizeInput(
      inputId = "factor_vars",
      selected = colnames(dat())[sapply(dat(), is.factor)],
      label = "Covariables to format as categorical",
      choices = colnames(dat()),
      multiple = TRUE
    )
  })

  ## Specify ID if necessary
  # output$id_var <- shiny::renderUI({
  #   shiny::req(input$ds)
  #   selectizeInput(
  #     inputId = "id_var",
  #     selected = colnames(dat())[1],
  #     label = "ID variable",
  #     choices = colnames(dat())[-match(colnames(dat()),input$factor_vars)],
  #     multiple = FALSE
  #   )
  # })

  output$data.tbl <- gt::render_gt(
    dd() |>
      cast_data_overview()
  )

  output$meta.tbl <- gt::render_gt(
    dd() |>
      cast_meta_overview()
  )

  # 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, na = "")
    }
  )

  # Downloadable csv of data dictionary ----
  output$downloadMeta <- shiny::downloadHandler(
    filename = paste0("REDCapCAST_DataDictionary_", Sys.Date(), ".csv"),
    content = function(file) {
      write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE, na = "")
    }
  )

  # Downloadable .zip of instrument ----
  output$downloadInstrument <- shiny::downloadHandler(
    filename = paste0("REDCapCAST_instrument", Sys.Date(), ".zip"),
    content = function(file) {
      export_redcap_instrument(purrr::pluck(dd(), "meta"),
        file = file,
        record.id = ifelse(input$add_id == "none", NA, names(dat())[1])
      )
    }
  )

  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)

  # session$onSessionEnded(function() {
  #   # cat("Session Ended\n")
  #   unlink("www",recursive = TRUE)
  # })
}


ui <-
  bslib::page(
    theme = bslib::bs_theme(preset = "united"),
    title = "REDCap database creator",
    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")
      )
    )
  )


shiny::shinyApp(ui = ui, server = server)