moved app to correctly include in package and allow load with dataset

R/app.R

@@ -0,0 +1,34 @@
+#' 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", package = "webResearch")
+  if (appDir == "") {
+    stop("Could not find example directory. Try re-installing `webResearch`.", call. = FALSE)
+  }
+
+  G <- .GlobalEnv
+  assign("webResearch_data", data, envir = G)
+  a <- shiny::runApp(appDir = appDir, ...)
+  return(invisible(a))
+}
+
+
+#' Wrapping nav_spacer to avoid errors on dependencies when packaging
+#'
+#' @return bslib object
+#' @export
+#'
+panel_space <- function() {
+  bslib::nav_spacer()
+}

R/baseline_table.R

@@ -13,7 +13,7 @@
 #' mtcars |> baseline_table(fun.args = list(by = "gear"))
 baseline_table <- function(data, fun.args = NULL, fun = gtsummary::tbl_summary, vars = NULL) {
   if (!is.null(vars)) {
-    data <- dplyr::select(dplyr::all_of(vars))
+    data <- data |> dplyr::select(dplyr::all_of(vars))
   }
 
   out <- do.call(fun, c(list(data = data), fun.args))

R/helpers.R

@@ -48,24 +48,6 @@ write_quarto <- function(data,fileformat,qmd.file=here::here("analyses.qmd"),fil
   )
 }
 
-#' Helper to import files correctly
-#'
-#' @param filenames file names
-#'
-#' @return character vector
-#' @export
-#'
-#' @examples
-#' file_extension(list.files(here::here(""))[[2]])[[1]]
-#' file_extension(c("file.cd..ks", "file"))
-file_extension <- function(filenames) {
-  sub(
-    pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
-    filenames,
-    perl = TRUE
-  )
-}
-
 #' Flexible file import based on extension
 #'
 #' @param file file name
@@ -77,7 +59,7 @@ file_extension <- function(filenames) {
 #' @examples
 #' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv")
 read_input <- function(file, consider.na = c("NA", '""', "")) {
-  ext <- file_extension(file)
+  ext <- tools::file_ext(file)
 
   if (ext == "csv") {
     df <- readr::read_csv(file = file, na = consider.na)
@@ -86,10 +68,12 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
   } else if (ext == "dta") {
     df <- haven::read_dta(file = file)
   } else if (ext == "ods") {
-    df <- readODS::read_ods(file = file)
+    df <- readODS::read_ods(path = file)
+  } else if (ext == "rds") {
+    df <- readr::read_rds(file = file)
   } else {
     stop("Input file format has to be on of:
-             '.csv', '.xls', '.xlsx', '.dta' or '.ods'")
+             '.csv', '.xls', '.xlsx', '.dta', '.ods' or '.rds'")
   }
 
   df

R/regression_model.R

@@ -4,7 +4,7 @@
 #' @param fun Name of function as character vector or function to use for model creation.
 #' @param vars character vector of variables to include
 #' @param outcome.str Name of outcome variable. Character vector.
-#' @param auto.mode Make assumptions on function dependent on outcome data format.
+#' @param auto.mode Make assumptions on function dependent on outcome data format. Overwrites other arguments.
 #' @param formula.str Formula as string. Passed through 'glue::glue'. If given, 'outcome.str' and 'vars' are ignored. Optional.
 #' @param args.list List of arguments passed to 'fun' with 'do.call'.
 #'
@@ -15,16 +15,18 @@
 #'
 #' @examples
 #' gtsummary::trial |>
-#'   regression_model(outcome.str = "age",)
+#'   regression_model(outcome.str = "age")
 #' gtsummary::trial |>
 #'   regression_model(
 #'     outcome.str = "age",
+#'     auto.mode = FALSE,
 #'     fun = "stats::lm",
 #'     formula.str = "{outcome.str}~.",
 #'     args.list = NULL
 #'   )
 #' gtsummary::trial |> regression_model(
 #'   outcome.str = "trt",
+#'   auto.mode = FALSE,
 #'   fun = "stats::glm",
 #'   args.list = list(family = binomial(link = "logit"))
 #' )
@@ -35,8 +37,10 @@ regression_model <- function(data,
                              args.list = NULL,
                              fun = NULL,
                              vars = NULL) {
-  if (formula.str==""){
-    formula.str <- NULL
+  if (!is.null(formula.str)) {
+    if (formula.str == "") {
+      formula.str <- NULL
+    }
   }
 
   if (!is.null(formula.str)) {
@@ -66,7 +70,7 @@ regression_model <- function(data,
     } else if (is.factor(data[[outcome.str]])) {
       if (length(levels(data[[outcome.str]])) == 2) {
         fun <- "stats::glm"
-        args.list <- list(family = binomial(link = "logit"))
+        args.list <- list(family = stats::binomial(link = "logit"))
       } else if (length(levels(data[[outcome.str]])) > 2) {
         fun <- "MASS::polr"
         args.list <- list(

R/regression_table.R

@@ -13,7 +13,7 @@
 #'     outcome.str = "stage",
 #'     fun = "MASS::polr"
 #'   ) |>
-#'   regression_table(args.list = list(exponentiate = TRUE))
+#'   regression_table(args.list = list("exponentiate" = TRUE))
 #' gtsummary::trial |>
 #'   regression_model(
 #'     outcome.str = "age",
@@ -32,7 +32,9 @@
 regression_table <- function(data, args.list = NULL, fun = "gtsummary::tbl_regression") {
 
   if (any(c(length(class(data))!=1, class(data)!="lm"))){
-    args.list <- c(args.list,list(exponentiate=TRUE))
+    if (!"exponentiate" %in% names(args.list)){
+      args.list <- c(args.list,list(exponentiate=TRUE))
+    }
   }
 
   out <- do.call(getfun(fun), c(list(x = data), args.list))