87 rewrite pkg structure (#92)

* Move all app functions from `inst/app` to `R`
* Update `run_pioneer()` to use new logic for loading server and ui
* Update documentation for functions and make changes to adhere to R package standards
* Update NEWS

DESCRIPTION

@@ -17,23 +17,25 @@ Depends:
     R (>= 4.1.0),
     shiny (>= 1.7.0)
 Imports:
-    lpSolveAPI (>= 5.5.2),
+    bslib (>= 0.5.1),
+    cli (>= 3.6.0),
+    ggplot2 (>= 3.3.0),
     haven (>= 2.5.0),
+    htmltools,
+    lpSolveAPI (>= 5.5.2),
     markdown,
     productivity (>= 1.1.0),
-    readxl,
-    writexl,
-    bslib (>= 0.5.1),
-    ggplot2 (>= 3.3.0),
     reactable (>= 0.4.0),
-    cli (>= 3.6.0)
+    readxl,
+    rlang (>= 1.1.0),
+    scales,
+    writexl
 Suggests:
     Benchmarking (>= 0.30),
     data.table,
     rmarkdown,
     knitr,
-    scales,
-    rlang,
+    magick,
     testthat (>= 3.0.0),
     tibble,
     withr

NAMESPACE

@@ -19,3 +19,9 @@ import(reactable)
 import(readxl)
 import(shiny)
 import(writexl)
+importFrom(stats,complete.cases)
+importFrom(stats,median)
+importFrom(stats,quantile)
+importFrom(stats,rnorm)
+importFrom(stats,sd)
+importFrom(stats,var)

NEWS.md

@@ -4,6 +4,7 @@
 
 - Updated documentation for `run_pioneer()`
 - Added custom functions for DEA calculations in order to remove `{Benchmarking}` as a dependency (#80)
+- All R functions - including `server()` and `ui()` - have now been moved to the `R` directory with benefits to how internal functions are accessed. In additions, the global environment should be untouched when the app is run (#87)
 
 ## Bug fixes
 

inst/app/R/fct_dea-bootstrap.R → R/fct_dea-bootstrap.R

@@ -1,3 +1,6 @@
+#' @importFrom stats complete.cases median quantile rnorm sd var
+NULL
+
 bw_rule <- function(delta, rule = 'ucv') {
   # Values must be in range 1, Inf. Take inverse if values are in range 0, 1
   if (min(delta) < 1) {
@@ -8,10 +11,10 @@ bw_rule <- function(delta, rule = 'ucv') {
   delta_2m <- c(delta_m, 2 - delta_m)
   # See Daraio & Wilson (2007) for a discussion on methods for determining bandwidth
   h <- switch(rule,
-    silverman = bw.nrd0(delta_2m),
-    scott = bw.nrd(delta_2m),
-    ucv = suppressWarnings({ h <- bw.ucv(delta_2m) }),
-    suppressWarnings({ h <- bw.ucv(delta_2m) })
+    silverman = stats::bw.nrd0(delta_2m),
+    scott = stats::bw.nrd(delta_2m),
+    ucv = suppressWarnings({ h <- stats::bw.ucv(delta_2m) }),
+    suppressWarnings({ h <- stats::bw.ucv(delta_2m) })
   )
   # See Daraio & Wilson (2007), p. 61, eq. 3.26
   h <- h * 2^(1/5) * (length(delta_m)/length(delta))^(1/5) * (sd(delta)/sd(delta_2m))
@@ -38,11 +41,11 @@ perform_boot <- function(x, y, rts, orientation, i, h, theta, boot) {
   beta <- bootstrap_sample(theta, h = h)
   if (orientation == 'in') {
     x_ref <- (theta / beta) * x
-    boot[, i] <- pioneeR:::compute_efficiency(x, y, rts = rts, orientation = orientation, xref = x_ref, yref = y, values_only = TRUE)$values
+    boot[, i] <- compute_efficiency(x, y, rts = rts, orientation = orientation, xref = x_ref, yref = y, values_only = TRUE)$values
   } else if (orientation == 'out') {
     beta <- 1 / beta
     y_ref <- (theta / beta) * y
-    boot[, i] <- pioneeR:::compute_efficiency(x, y, rts = rts, orientation = orientation, xref = x, yref = y_ref, values_only = TRUE)$values
+    boot[, i] <- compute_efficiency(x, y, rts = rts, orientation = orientation, xref = x, yref = y_ref, values_only = TRUE)$values
   }
   return(invisible(boot))
 }

inst/app/R/fct_file-functions.R → R/fct_file-functions.R

@@ -1,3 +1,5 @@
+#' Check user provided file
+#' @noRd 
 check_file <- function(file) {
 
   check_missing <- sapply(1:nrow(file), function(i) all(is.na(file[i,])))
@@ -28,6 +30,8 @@ check_file <- function(file) {
 
 }
 
+#' Check if a cell in Excel has a value
+#' @noRd 
 has_value <- function(x) {
   if (length(x) > 1L) return(sapply(x, has_value, USE.NAMES = FALSE))
   if (is.null(x) || is.na(x)) return(FALSE)

inst/app/R/fct_ui-functions.R → R/fct_ui-functions.R

@@ -1,3 +1,5 @@
+#' Create a bootstrap styled alert box
+#' @noRd
 alert <- function(..., color = 'primary', icon = NULL, dismissable = FALSE) {
 
   cls <- sprintf('alert alert-%s', color)
@@ -14,6 +16,8 @@ alert <- function(..., color = 'primary', icon = NULL, dismissable = FALSE) {
 
 }
 
+#' Create a bootstrap styled modal button
+#' @noRd
 bs_modal_button <- function(
     label = 'Close', color = 'default', size = c('normal', 'sm', 'lg'))
 {
@@ -23,6 +27,8 @@ bs_modal_button <- function(
   tags$button(type = 'button', class = cls, `data-bs-dismiss` = 'modal', label)
 }
 
+#' Create a content element with proper Bootstrap styling
+#' @noRd
 content_div <- function(...) {
   tags$div(
     class = 'container mt-1',

inst/app/R/mod_file-upload.R → R/mod_file-upload.R

@@ -1,5 +1,5 @@
-library(reactable)
-
+#' UI module for file upload function
+#' @noRd 
 file_upload_ui <- function(id, wrap = FALSE, ...) {
   ns <- NS(id)
   if (wrap) {
@@ -9,6 +9,8 @@ file_upload_ui <- function(id, wrap = FALSE, ...) {
   }
 }
 
+#' Server module for file upload function
+#' @noRd 
 file_upload_srv <- function(id) {
   moduleServer(
     id, function(input, output, session) {
@@ -76,7 +78,7 @@ file_upload_srv <- function(id) {
         if (ext %in% c('csv', 'tsv', 'dsv', 'txt')) {
           req(input$file_sep, input$file_dec)
           header <- if (is.null(input$file_header)) TRUE else as.logical(input$file_header)
-          clean_doc <- read.table(
+          clean_doc <- utils::read.table(
             textConnection(raw_file()),
             sep = input$file_sep,
             dec = input$file_dec,

R/pkg-utils.R

@@ -1,3 +1,5 @@
+#' Create temporary data that can be used by pioneeR when run locally
+#' @noRd
 set_local_data <- function(x) {
 
   if (nzchar(Sys.getenv('PIONEER_DATA'))) {
@@ -28,12 +30,16 @@ set_local_data <- function(x) {
 
 }
 
+#' Get list of unsafe ports that are used in Chrome
+#' @noRd
 unsafe_ports <- function() {
   return(
     c(3659, 4045, 5060, 5061, 6000, 6566, 6665:6669, 6697)
   )
 }
 
+#' Checks if the specified port is inside the ranges that are considered safe
+#' @noRd
 check_for_unsafe_port <- function(port) {
   if (is.null(port)) return()
   port <- as.numeric(port)