cleaning

.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$

.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

CRAN-SUBMISSION

@@ -1,3 +0,0 @@
-Version: 24.11.2
-Date: 2024-11-22 12:08:45 UTC
-SHA: a8f8fac245b06fef4a5e191d046bc4e9a345bf2b

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'

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)

R/ds2dd.R

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

inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast-latest.dcf

@@ -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

inst/shiny-examples/casting/server.R

@@ -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)
-  # })
-}

inst/shiny-examples/casting/ui.R

@@ -1,7 +0,0 @@
-library(REDCapCAST)
-ui <-
-  bslib::page(
-    theme = bslib::bs_theme(preset = "united"),
-    title = "REDCap database creator",
-    REDCapCAST::nav_bar_page()
-  )