naming and dealing with a dependency issue. ready for first release

R/cut-variable-dates.R

@@ -206,9 +206,11 @@ cut.Date <- function(x,breaks,start.on.monday=TRUE,...){
 #' @export
 #'
 #' @examples
+#' \dontrun{
 #' vapply(REDCapCAST::redcapcast_data, \(.x){
 #'   is_any_class(.x, c("hms", "Date", "POSIXct", "POSIXt"))
 #' }, logical(1))
+#' }
 is_any_class <- function(data, class.vec) {
   any(class(data) %in% class.vec)
 }

R/file-import-module.R

@@ -1,125 +1,125 @@
-#' Shiny UI module to load a data file
+#' #' Shiny UI module to load a data file
+#' #'
+#' #' @param id id
+#' #'
+#' #' @return shiny UI
+#' #' @export
+#' #'
+#' m_datafileUI <- function(id) {
+#'   ns <- shiny::NS(id)
+#'   shiny::tagList(
+#'     shiny::fileInput(
+#'       inputId = ns("file"),
+#'       label = "Upload a file",
+#'       multiple = FALSE,
+#'       accept = c(
+#'         ".csv",
+#'         ".xlsx",
+#'         ".xls",
+#'         ".dta",
+#'         ".ods",
+#'         ".rds"
+#'       )
+#'     ),
+#'     shiny::h4("Parameter specifications"),
+#'     shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")),
+#'     shiny::uiOutput(ns("include_vars")),
+#'     DT::DTOutput(ns("data_input")),
+#'     shiny::actionButton(ns("submit"), "Submit")
+#'   )
+#' }
 #'
-#' @param id id
+#' m_datafileServer <- function(id, output.format = "df") {
+#'   shiny::moduleServer(id, function(input, output, session, ...) {
+#'     ns <- shiny::NS(id)
+#'     ds <- shiny::reactive({
+#'       REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data()
+#'     })
 #'
-#' @return shiny UI
-#' @export
+#'     output$include_vars <- shiny::renderUI({
+#'       shiny::req(input$file)
+#'       shiny::selectizeInput(
+#'         inputId = ns("include_vars"),
+#'         selected = NULL,
+#'         label = "Covariables to include",
+#'         choices = colnames(ds()),
+#'         multiple = TRUE
+#'       )
+#'     })
 #'
-m_datafileUI <- function(id) {
-  ns <- shiny::NS(id)
-  shiny::tagList(
-    shiny::fileInput(
-      inputId = ns("file"),
-      label = "Upload a file",
-      multiple = FALSE,
-      accept = c(
-        ".csv",
-        ".xlsx",
-        ".xls",
-        ".dta",
-        ".ods",
-        ".rds"
-      )
-    ),
-    shiny::h4("Parameter specifications"),
-    shiny::helpText(shiny::em("Select the desired variables and press 'Submit'")),
-    shiny::uiOutput(ns("include_vars")),
-    DT::DTOutput(ns("data_input")),
-    shiny::actionButton(ns("submit"), "Submit")
-  )
-}
-
-m_datafileServer <- function(id, output.format = "df") {
-  shiny::moduleServer(id, function(input, output, session, ...) {
-    ns <- shiny::NS(id)
-    ds <- shiny::reactive({
-      REDCapCAST::read_input(input$file$datapath) |> REDCapCAST::parse_data()
-    })
-
-    output$include_vars <- shiny::renderUI({
-      shiny::req(input$file)
-      shiny::selectizeInput(
-        inputId = ns("include_vars"),
-        selected = NULL,
-        label = "Covariables to include",
-        choices = colnames(ds()),
-        multiple = TRUE
-      )
-    })
-
-    base_vars <- shiny::reactive({
-      if (is.null(input$include_vars)) {
-        out <- colnames(ds())
-      } else {
-        out <- input$include_vars
-      }
-      out
-    })
-
-    output$data_input <-
-      DT::renderDT({
-        shiny::req(input$file)
-        ds()[base_vars()]
-      })
-
-    shiny::eventReactive(input$submit, {
-      # shiny::req(input$file)
-
-      data <- shiny::isolate({
-        ds()[base_vars()]
-      })
-
-      file_export(data,
-        output.format = output.format,
-        tools::file_path_sans_ext(input$file$name)
-      )
-    })
-  })
-}
-
-
-
-
-
-file_app <- function() {
-  ui <- shiny::fluidPage(
-    m_datafileUI("data"),
-    # DT::DTOutput(outputId = "redcap_prev")
-    toastui::datagridOutput2(outputId = "redcap_prev")
-  )
-  server <- function(input, output, session) {
-    m_datafileServer("data", output.format = "list")
-  }
-  shiny::shinyApp(ui, server)
-}
-
-file_app()
-
-tdm_data_upload <- teal::teal_data_module(
-  ui <- function(id) {
-    shiny::fluidPage(
-      m_datafileUI(id)
-    )
-  },
-  server = function(id) {
-    m_datafileServer(id, output.format = "teal")
-  }
-)
-
-tdm_data_read <- teal::teal_data_module(
-  ui <- function(id) {
-    shiny::fluidPage(
-      m_redcap_readUI(id = "redcap")
-    )
-  },
-  server = function(id) {
-    moduleServer(
-      id,
-      function(input, output, session) {
-        ns <- session$ns
-
-        m_redcap_readServer(id = "redcap", output.format = "teal")
-      }
-    )
-  }
-)
+#'     base_vars <- shiny::reactive({
+#'       if (is.null(input$include_vars)) {
+#'         out <- colnames(ds())
+#'       } else {
+#'         out <- input$include_vars
+#'       }
+#'       out
+#'     })
+#'
+#'     output$data_input <-
+#'       DT::renderDT({
+#'         shiny::req(input$file)
+#'         ds()[base_vars()]
+#'       })
+#'
+#'     shiny::eventReactive(input$submit, {
+#'       # shiny::req(input$file)
+#'
+#'       data <- shiny::isolate({
+#'         ds()[base_vars()]
+#'       })
+#'
+#'       file_export(data,
+#'         output.format = output.format,
+#'         tools::file_path_sans_ext(input$file$name)
+#'       )
+#'     })
+#'   })
+#' }
+#'
+#'
+#'
+#'
+#'
+#' file_app <- function() {
+#'   ui <- shiny::fluidPage(
+#'     m_datafileUI("data"),
+#'     # DT::DTOutput(outputId = "redcap_prev")
+#'     toastui::datagridOutput2(outputId = "redcap_prev")
+#'   )
+#'   server <- function(input, output, session) {
+#'     m_datafileServer("data", output.format = "list")
+#'   }
+#'   shiny::shinyApp(ui, server)
+#' }
+#'
+#' file_app()
+#'
+#' tdm_data_upload <- teal::teal_data_module(
+#'   ui <- function(id) {
+#'     shiny::fluidPage(
+#'       m_datafileUI(id)
+#'     )
+#'   },
+#'   server = function(id) {
+#'     m_datafileServer(id, output.format = "teal")
+#'   }
+#' )
+#'
+#' tdm_data_read <- teal::teal_data_module(
+#'   ui <- function(id) {
+#'     shiny::fluidPage(
+#'       m_redcap_readUI(id = "redcap")
+#'     )
+#'   },
+#'   server = function(id) {
+#'     moduleServer(
+#'       id,
+#'       function(input, output, session) {
+#'         ns <- session$ns
+#'
+#'         m_redcap_readServer(id = "redcap", output.format = "teal")
+#'       }
+#'     )
+#'   }
+#' )

R/helpers.R

@@ -98,6 +98,7 @@ argsstring2list <- function(string) {
 #' @param vars variables to force factorize
 #'
 #' @return data.frame
+#' @importFrom REDCapCAST as_factor
 #' @export
 factorize <- function(data, vars) {
   if (!is.null(vars)) {
@@ -105,7 +106,7 @@ factorize <- function(data, vars) {
       dplyr::mutate(
         dplyr::across(
           dplyr::all_of(vars),
-          REDCapCAST::as_factor
+          as_factor
         )
       )
   } else {
@@ -128,6 +129,17 @@ dummy_Imports <- function() {
 }
 
 
+#' Title
+#'
+#' @param data data
+#' @param output.format output
+#' @param filename filename
+#' @param ... passed on
+#'
+#' @returns data
+#' @export
+#' @importFrom REDCapCAST as_factor parse_data numchar2fct
+#'
 file_export <- function(data, output.format = c("df", "teal", "list"), filename, ...) {
   output.format <- match.arg(output.format)
 
@@ -139,9 +151,9 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
       {
         assign(name, value |>
           dplyr::bind_cols() |>
-          REDCapCAST::parse_data() |>
-          REDCapCAST::as_factor() |>
-          REDCapCAST::numchar2fct())
+          parse_data() |>
+          as_factor() |>
+          numchar2fct())
       },
       value = data,
       name = filename
@@ -150,9 +162,9 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
     datanames(out) <- filename
   } else if (output.format == "df") {
     out <- data|>
-      REDCapCAST::parse_data() |>
-      REDCapCAST::as_factor() |>
-      REDCapCAST::numchar2fct()
+      parse_data() |>
+      as_factor() |>
+      numchar2fct()
   } else if (output.format == "list") {
     out <- list(
       data = data,
@@ -172,13 +184,14 @@ file_export <- function(data, output.format = c("df", "teal", "list"), filename,
 #'
 #' @returns data.frame or tibble
 #' @export
+#' @importFrom REDCapCAST as_factor parse_data numchar2fct
 #'
 #' @examples
 #' mtcars |> str()
 #' mtcars |> default_parsing() |> str()
 default_parsing <- function(data){
   data |>
-    REDCapCAST::parse_data() |>
-    REDCapCAST::as_factor() |>
-    REDCapCAST::numchar2fct()
+    parse_data() |>
+    as_factor() |>
+    numchar2fct()
 }

R/redcap_read_shiny_module.R

@@ -100,6 +100,7 @@ m_redcap_readUI <- function(id, include_title = TRUE) {
 #'
 #' @return shiny server module
 #' @export
+#' @importFrom REDCapCAST read_redcap_tables redcap_wider suffix2label
 #'
 m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
   output.format <- match.arg(output.format)
@@ -226,7 +227,7 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
       shiny::req(input$fields)
       record_id <- dd()[[1]][1]
 
-      redcap_data <- REDCapCAST::read_redcap_tables(
+      redcap_data <- read_redcap_tables(
         uri = input$uri,
         token = input$api,
         fields = unique(c(record_id, input$fields)),
@@ -235,10 +236,10 @@ m_redcap_readServer <- function(id, output.format = c("df", "teal", "list")) {
         raw_or_label = "both",
         filter_logic = input$filter
       ) |>
-        REDCapCAST::redcap_wider() |>
+        redcap_wider() |>
         dplyr::select(-dplyr::ends_with("_complete")) |>
         dplyr::select(-dplyr::any_of(record_id)) |>
-        REDCapCAST::suffix2label()
+        suffix2label()
 
       out_object <- file_export(redcap_data,
                                 output.format = output.format,

R/regression_model.R

@@ -10,6 +10,7 @@
 #' @param ... ignored for now
 #'
 #' @importFrom stats as.formula
+#' @importFrom REDCapCAST as_factor
 #'
 #' @return object of standard class for fun
 #' @export
@@ -66,7 +67,7 @@ regression_model <- function(data,
   data <- data |>
     purrr::map(\(.x){
       if (is.character(.x)) {
-        suppressWarnings(REDCapCAST::as_factor(.x))
+        suppressWarnings(as_factor(.x))
       } else {
         .x
       }

R/regression_table.R

@@ -81,7 +81,7 @@
 #' #' @export
 #' regression_table.default <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
 #'   # Stripping custom class
-#'   class(x) <- class(x)[class(x) != "webresearch_model"]
+#'   class(x) <- class(x)[class(x) != "freesearcher_model"]
 #'
 #'   if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
 #'     if (!"exponentiate" %in% names(args.list)) {
@@ -110,7 +110,7 @@ regression_table <- function(x, ...) {
 
 regression_table_create <- function(x, ..., args.list = NULL, fun = "gtsummary::tbl_regression") {
   # Stripping custom class
-  class(x) <- class(x)[class(x) != "webresearch_model"]
+  class(x) <- class(x)[class(x) != "freesearcher_model"]
 
   if (any(c(length(class(x)) != 1, class(x) != "lm"))) {
     if (!"exponentiate" %in% names(args.list)) {

R/shiny_freesearcheR.R

@@ -0,0 +1,25 @@
+#' Launch the freesearcheR tool locally
+#'
+#' @description
+#' All data.frames in the global environment will be accessible through the app.
+#'
+#'
+#' @param ... arguments passed on to `shiny::runApp()`
+#'
+#' @return shiny app
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' data(mtcars)
+#' shiny_freesearcheR(launch.browser = TRUE)
+#' }
+shiny_freesearcheR <- function(...) {
+  appDir <- system.file("apps", "data_analysis_modules", package = "freesearcheR")
+  if (appDir == "") {
+    stop("Could not find the app directory. Try re-installing `freesearcheR`.", call. = FALSE)
+  }
+
+  a <- shiny::runApp(appDir = paste0(appDir,"/app.R"), ...)
+  return(invisible(a))
+}

R/shiny_webResearch.R

@@ -1,27 +0,0 @@
-#' Test version of the shiny_cast function to launch the app with a data set in
-#' the environment.
-#'
-#' @param data optional data set to provide for analysis
-#' @param ... arguments passed on to `shiny::runApp()`
-#'
-#' @return shiny app
-#' @export
-#'
-#' @examples
-#' \dontrun{
-#' mtcars |> shiny_webResearch(launch.browser = TRUE)
-#' }
-shiny_webResearch <- function(data = NULL, ...) {
-  appDir <- system.file("apps", "data_analysis_modules", package = "webResearch")
-  if (appDir == "") {
-    stop("Could not find the app directory. Try re-installing `webResearch`.", call. = FALSE)
-  }
-
-  G <- .GlobalEnv
-
-  if (!is.null(data) && is.data.frame(data)) {
-    assign("webResearch_data", data, envir = G)
-  }
-  a <- shiny::runApp(appDir = appDir, ...)
-  return(invisible(a))
-}