diff --git a/.Rbuildignore b/.Rbuildignore index ad4dece..3ab787a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -20,3 +20,5 @@ app ^\.lintr$ ^CODE_OF_CONDUCT\.md$ ^~/REDCapCAST/inst/shiny-examples/casting/rsconnect$ +^inst/shiny-examples/casting/functions\.R$ +^functions\.R$ diff --git a/.gitignore b/.gitignore index 8015b2c..c362c79 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ drafting cran-comments.md ~/REDCapCAST/inst/shiny-examples/casting/rsconnect ~/REDCapCAST/inst/shiny-examples/casting/rsconnect/ +inst/shiny-examples/casting/functions.R +functions.R diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION deleted file mode 100644 index d848e7d..0000000 --- a/CRAN-SUBMISSION +++ /dev/null @@ -1,3 +0,0 @@ -Version: 24.11.2 -Date: 2024-11-22 12:08:45 UTC -SHA: a8f8fac245b06fef4a5e191d046bc4e9a345bf2b diff --git a/DESCRIPTION b/DESCRIPTION index 13d7177..da7b1b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: REDCapCAST Title: REDCap Metadata Casting and Castellated Data Handling -Version: 24.11.3 +Version: 24.11.4 Authors@R: c( person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", role = c("aut", "cre"),comment = c(ORCID = "0000-0002-7559-1154")), @@ -68,7 +68,6 @@ Collate: 'REDCap_split.r' 'as_factor.R' 'doc2dd.R' - 'ds2dd.R' 'ds2dd_detailed.R' 'easy_redcap.R' 'export_redcap_instrument.R' diff --git a/NAMESPACE b/NAMESPACE index 6ec3128..b8d6fe5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ export(cast_data_overview) export(cast_meta_overview) export(char2choice) export(char2cond) +export(clean_field_label) export(clean_redcap_name) export(compact_vec) export(create_html_table) @@ -48,7 +49,9 @@ export(possibly_roman) export(process_user_input) export(read_input) export(read_redcap_instrument) +export(read_redcap_labelled) export(read_redcap_tables) +export(redcap_meta_default) export(redcap_wider) export(sanitize_split) export(set_attr) diff --git a/R/ds2dd.R b/R/ds2dd.R deleted file mode 100644 index e0deefd..0000000 --- a/R/ds2dd.R +++ /dev/null @@ -1,89 +0,0 @@ -utils::globalVariables(c("metadata_names")) -#' (DEPRECATED) Data set to data dictionary function -#' -#' @description -#' Creates a very basic data dictionary skeleton. Please see `ds2dd_detailed()` -#' for a more advanced function. -#' -#' @details -#' Migrated from stRoke ds2dd(). Fits better with the functionality of -#' 'REDCapCAST'. -#' @param ds data set -#' @param record.id name or column number of id variable, moved to first row of -#' data dictionary, character of integer. Default is "record_id". -#' @param form.name vector of form names, character string, length 1 or length -#' equal to number of variables. Default is "basis". -#' @param field.type vector of field types, character string, length 1 or length -#' equal to number of variables. Default is "text. -#' @param field.label vector of form names, character string, length 1 or length -#' equal to number of variables. Default is NULL and is then identical to field -#' names. -#' @param include.column.names Flag to give detailed output including new -#' column names for original data set for upload. -#' @param metadata Metadata column names. Default is the included -#' REDCapCAST::metadata_names. -#' -#' @return data.frame or list of data.frame and vector -#' @export -#' -#' @examples -#' redcapcast_data$record_id <- seq_len(nrow(redcapcast_data)) -#' ds2dd(redcapcast_data, include.column.names=TRUE) - -ds2dd <- - function(ds, - record.id = "record_id", - form.name = "basis", - field.type = "text", - field.label = NULL, - include.column.names = FALSE, - metadata = metadata_names) { - dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds))) - colnames(dd) <- metadata - - if (is.character(record.id) && !record.id %in% colnames(ds)) { - stop("Provided record.id is not a variable name in provided data set.") - } - - # renaming to lower case and substitute spaces with underscore - field.name <- gsub(" ", "_", tolower(colnames(ds))) - - # handles both character and integer - colsel <- - colnames(ds) == colnames(ds[record.id]) - - if (summary(colsel)[3] != 1) { - stop("Provided record.id has to be or refer to a uniquely named column.") - } - - dd[, "field_name"] <- - c(field.name[colsel], field.name[!colsel]) - - if (length(form.name) > 1 && length(form.name) != ncol(ds)) { - stop( - "Provided form.name should be of length 1 (value is reused) or equal - length as number of variables in data set." - ) - } - dd[, "form_name"] <- form.name - - if (length(field.type) > 1 && length(field.type) != ncol(ds)) { - stop( - "Provided field.type should be of length 1 (value is reused) or equal - length as number of variables in data set." - ) - } - - dd[, "field_type"] <- field.type - - if (is.null(field.label)) { - dd[, "field_label"] <- dd[, "field_name"] - } else - dd[, "field_label"] <- field.label - - if (include.column.names){ - list("DataDictionary"=dd,"Column names"=field.name) - } else dd - } - - diff --git a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast-latest.dcf b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast-latest.dcf deleted file mode 100644 index 0e4b1ae..0000000 --- a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast-latest.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: redcapcast-latest -title: -username: agdamsbo -account: agdamsbo -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 13442058 -bundleId: 9412341 -url: https://agdamsbo.shinyapps.io/redcapcast-latest/ -version: 1 diff --git a/inst/shiny-examples/casting/server.R b/inst/shiny-examples/casting/server.R deleted file mode 100644 index 0deb29c..0000000 --- a/inst/shiny-examples/casting/server.R +++ /dev/null @@ -1,180 +0,0 @@ -library(bslib) -library(shiny) -library(openxlsx2) -library(haven) -library(readODS) -library(readr) -library(dplyr) -library(devtools) -if (!requireNamespace("REDCapCAST")) { - devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never") -} -library(REDCapCAST) - - -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" - ) - }) - - 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) - # }) -} diff --git a/inst/shiny-examples/casting/ui.R b/inst/shiny-examples/casting/ui.R deleted file mode 100644 index 8fd747f..0000000 --- a/inst/shiny-examples/casting/ui.R +++ /dev/null @@ -1,7 +0,0 @@ -library(REDCapCAST) -ui <- - bslib::page( - theme = bslib::bs_theme(preset = "united"), - title = "REDCap database creator", - REDCapCAST::nav_bar_page() - )