mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-27 15:21:55 +01:00
343 lines
9.7 KiB
R
343 lines
9.7 KiB
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)
|