Merge pull request CTU-Basel#2 from markomi/refmodules

Refactor modules

Author: markomi

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: shinysse
 Type: Package
-Title: What the Package Does (Title Case)
-Version: 0.1.2
+Title: Sample size estimation demo shiny app
+Version: 0.1.3
 Author: Milica Markovic
 Maintainer: Milica Markovic <[email protected]>
 Description: Shiny package providing a sample size estimation (sse) web app
-License: What license is it under?
+License: MIT License
 Depends: 
   shiny,
   shinydashboard,

NAMESPACE

@@ -2,8 +2,8 @@
 
 export(app_server)
 export(app_ui)
-export(dash)
-export(fun_calc_prop)
-export(fun_calc_t)
+export(calc_prop)
+export(calc_t)
 export(get_header_mint)
+export(get_module_registry)
 export(run_shiny)

R/app.R

@@ -1,20 +1,19 @@
-#' Shiny main app server function for shinysse
+#' Main Shiny server function for shinysse
 #'
-#' Calls modules defined in app_ui, and passes on relevant data.
+#' Calls modules listed in app_ui, and passes on relevant data.
 #'
 #' @seealso \code{\link{app_ui}}, \code{\link{run_shiny}}
 #' @export
 #'
 app_server <- function(input, output) {
-  # data
+  # fetch calc data from extdata
   calc_t_twosample <- readRDS(system.file("extdata", "calc_t_test_twosample.rds", package = "shinysse"))
-  calc_t_paired <- readRDS(system.file("extdata/calc_t_test_paired.rds", package = "shinysse"))
-  calc_prop <- readRDS(system.file("extdata/calc_prop_test.rds", package = "shinysse"))
-  # modules
-  mod <- fun_get_mods()
-  callModule(dash, mod$dash)
-  callModule(sseBasic, mod$sse_basic, calc_t_twosample, calc_t_paired)
-  callModule(ssePlus, mod$sse_plus, calc_t_twosample)
-  callModule(ssePlus, mod$sse_plus_paired, calc_t_paired)
-  callModule(sseProp, mod$sse_prop, calc_prop)
+  calc_t_paired <- readRDS(system.file("extdata", "calc_t_test_paired.rds", package = "shinysse"))
+  calc_prop <- readRDS(system.file("extdata", "calc_prop_test.rds", package = "shinysse"))
+  # get module labels and then call
+  mod <- get_module_registry()
+  callModule(sse_intro, mod$sse_intro)
+  callModule(sse_ttest, mod$sse_ttest, calc_t_twosample, calc_t_paired)
+  callModule(sse_ttest_plus, mod$sse_ttest_plus, calc_t_twosample, calc_t_paired)
+  callModule(sse_prop, mod$sse_prop, calc_prop)
 }

R/app_server.R

@@ -1,21 +1,20 @@
-#' Shiny main app UI function for shinysse
+#' Main shiny UI function for shinysse
 #'
-#' Controls the general appearance, header, sidebar, body, modules, etc.
+#' Controls the general appearance, header, sidebar, body, tabs with modules, etc.
 #'
-#' @seealso \code{\link{app}}
+#' @seealso \code{\link{app_server}}
 #' @export
 #'
 app_ui <- function(){
-  mod <- fun_get_mods()
+  mod <- get_module_registry()
   dashboardPage(
     get_header_mint("SSE app"),
     dashboardSidebar(
       div(p(" ")),
       sidebarMenu(
-        menuItem("Introduction", tabName = mod$dash, icon = icon("info")),
-        menuItem("Two sample t-Test SSE", tabName = mod$sse_basic, icon = icon("text-size", lib = "glyphicon")),
-        menuItem("Two sample t-Test SSE + input", tabName = mod$sse_plus, icon = icon("text-size", lib = "glyphicon")),
-        menuItem("Paired t-Test SSE + input", tabName = mod$sse_plus_paired, icon = icon("text-size", lib = "glyphicon")),
+        menuItem("Introduction", tabName = mod$sse_intro, icon = icon("info")),
+        menuItem("Two sample t-Test SSE", tabName = mod$sse_ttest, icon = icon("text-size", lib = "glyphicon")),
+        menuItem("Two sample t-Test SSE + input", tabName = mod$sse_ttest_plus, icon = icon("text-size", lib = "glyphicon")),
         menuItem("Proportion Test SSE", tabName = mod$sse_prop, icon = icon("percentage"))
       )
     ),
@@ -24,11 +23,10 @@ app_ui <- function(){
         tags$link(rel = "stylesheet", type = "text/css", href = "www/custom.css")
       ),
       tabItems(
-        dashUI(mod$dash, label = mod$dash),
-        sseBasicUI(mod$sse_basic, label = mod$sse_basic),
-        ssePlusUI(mod$sse_plus, label = mod$sse_plus),
-        ssePlusUI(mod$sse_plus_paired, label = mod$sse_plus_paired),
-        ssePropUI(mod$sse_prop, label = mod$sse_prop)
+        sse_intro_ui(mod$sse_intro, label = mod$sse_intro),
+        sse_ttest_ui(mod$sse_ttest, label = mod$sse_ttest),
+        sse_ttest_plus_ui(mod$sse_ttest_plus, label = mod$sse_ttest_plus),
+        sse_prop_ui(mod$sse_prop, label = mod$sse_prop)
       )
     )
   )

R/app_ui.R

@@ -1,26 +1,38 @@
-#' Evaluates power -function for power.prop.test
+#' Evaluates power functions for power.prop.test
 #'
-#' For all pre-set combinations of n, theta, xi and alpha, this function calculates a list of powPar (package: sse)
-#' objects and saves them at a pre-set location in inst/extdata. The function uses the stats::power.prop.test for
-#' this purpose. Make sure to re-build the package after running the function, in order to make it available
-#' with package installation.
+#' For all pre-set combinations of n, theta, xi and alpha, this function calculates a list of powCalc
+#' objects and saves the list.
 #'
-#' @return list of calculated powPar objects
+#' Input parameters are optional. Defaults:
+#' * n <- seq(from = 3, to = 10000, by = 5)
+#' * theta <- c(seq(from = 0, to = 0.15, by = 0.0125), seq(from = 0.2, to = 0.5, by = 0.05))
+#' * xi <- seq(from = 0.05, to = 1, by = 0.05)
+#' * alpha <- c(0.01, 0.025, 0.05)
+#' * save_path <- file.path("inst", "extdata", "calc_prop_test.rds")
+#' @md
+#' @param n numeric vector containing possible range of sample sizes
+#' @param theta numeric vector containing possible range of effect sizes
+#' @param xi numeric vector containing possible range of proportions
+#' @param alpha numeric vector containing possible range of significance levels
+#' @param save_path string inidicating where the function output should be saved
+#' @return list of calculated powCalc objects
+#' @seealso \code{\link{calc_t}}
 #' @export
 #'
-fun_calc_prop <- function(){
-  ## define range of significance levels
-  alpha <- c(0.01, 0.025, 0.05)
-  ## defining the range of n and theta to be evaluated
-  psi_prop <- powPar(n = seq(from = 3, to = 10000, by = 5), # possible range of sample sizes
-                     theta = c(seq(from = 0, to = 0.15, by = 0.0125),
-                               seq(from = 0.2, to = 0.5, by = 0.05)), # possible range of effect sizes
-                     xi = seq(from = 0.05, to = 1, by = 0.05)) # possible range of proportions
+calc_prop <- function(n, theta, xi, alpha, save_path){
+  if (missing(n)) n <- seq(from = 3, to = 10000, by = 5)
+  if (missing(theta)) theta <- c(seq(from = 0, to = 0.15, by = 0.0125), seq(from = 0.2, to = 0.5, by = 0.05))
+  if (missing(xi)) xi <- seq(from = 0.05, to = 1, by = 0.05)
+  if (missing(alpha)) alpha <- c(0.01, 0.025, 0.05)
+  if (missing(save_path)) save_path <- file.path("inst", "extdata", "calc_prop_test.rds")
 
-  ## defining a power-function based on a power.prop.test
+  ## defining power parameters needed for power fun evluation later on
+  psi_prop <- powPar(n = n, theta = theta, xi = xi)
+  ## defining a power fun based on a power.prop.test and parameters set in powPar
   powFuns_prop <- list()
-  for(i in 1:length(alpha)){
-    eval(parse(text = paste(paste0("powFuns_prop[[", paste0("'alpha", sub(".", "p", alpha[i], fixed = TRUE)), "']]", " <- function(psi)"),
+  for (i in 1:length(alpha)){
+    eval(parse(text = paste(paste0("powFuns_prop[[", paste0("'alpha", sub(".", "p", alpha[i], fixed = TRUE)), "']]",
+                                   " <- function(psi)"),
                             "{",
                             "p1 = xi(psi)",
                             "power.prop.test(n = sse::n(psi)/2,",
@@ -31,15 +43,8 @@ fun_calc_prop <- function(){
                             ")$power",
                             "}", sep = "\n")))
   }
-
-  ## evaulate power-function for all combinations of n, theta, xi and alpha
+  ## evaulate power function for all combinations of n, theta, xi and alpha
   calc_prop <- map(powFuns_prop, ~powCalc(psi_prop, .))
-
-  ## readRDS
-  calc_prop <- readRDS("calc_prop_test.rds")
-  calc_prop <- readRDS(system.file("extdata", "calc_prop_test.rds", package = "shinyssepkg"))
-  ## save calcs to be used in the shiny app
-  save_path <- file.path("inst", "extdata", "calc_prop_test.rds")
   saveRDS(calc_prop, save_path)
   return(calc_prop)
 }

R/fun_calc_prop.R

@@ -1,39 +1,53 @@
-#' Evaluates power -function for power.t.test
+#' Evaluates power functions for power.t.test
 #'
-#' For all pre-set combinations of n, theta, xi and alpha, this function calculates a list of powPar (package: sse)
-#' objects and saves them at a pre-set location in inst/extdata. The function uses the stats::power.t.test for
-#' this purpose. Make sure to re-build the package after running the function, in order to make it available
+#' For all pre-set combinations of n, theta, xi and alpha, this function calculates a list of powCalc
+#' objects and saves the list.
 #'
-#' @param type character string specifying the type of t test. options: "two.sample", "one.sample", "paired"
-#' @return list of calculated powPar objects
+#' Input parameters are optional. Defaults:
+#' * n <- seq(from = 5, to = 2000, by = 5)
+#' * theta <- seq(from = 1, to = 50, by = 1)
+#' * xi <- seq(from = 1, to = 80, by = 1)
+#' * alpha <- c(0.01, 0.025, 0.05)
+#' * save_path <- file.path("inst", "extdata", "calc_t_test.rds")
+#' @md
+#' @param n numeric vector containing possible range of sample sizes
+#' @param theta numeric vector containing possible range of effect sizes
+#' @param xi numeric vector containing possible range of standard deviations
+#' @param alpha numeric vector containing possible range of significance levels
+#' @param type string of value "two.sample", "one.sample", or "paired"
+#' @param save_path string inidicating where the function output should be saved
+#' @return list of calculated powCalc objects
+#' @seealso \code{\link{calc_prop}}
 #' @export
 #'
-fun_calc_t <- function(type = "two.sided"){
-  print(type)
-  ## define range of significance levels
-  alpha <- c(0.01, 0.025, 0.05)
+calc_t <- function(n, theta, xi, alpha, type, save_path){
+  if (missing(n)) n <- seq(from = 5, to = 2000, by = 5)
+  if (missing(theta)) theta <- seq(from = 1, to = 50, by = 1)
+  if (missing(xi)) xi <- seq(from = 1, to = 80, by = 1)
+  if (missing(alpha)) alpha <- c(0.01, 0.025, 0.05)
+  if (missing(type)) type <- "two.sample"
+  if (missing(save_path)) save_path <- file.path("inst", "extdata", "calc_t_test.rds")
+
   ## defining the range of n and theta to be evaluated
-  psi_t <- powPar(n = seq(from = 5, to = 2000, by = 5), # possible range of sample sizes
-                  theta = seq(from = 1, to = 50, by = 1), # possible range of effect sizes
-                  xi = seq(from = 1, to = 80, by = 1)) # possible range of standard deviations
-  ## defining a power-function based on a power.t.test
+  psi_t <- powPar(n = n, theta = theta, xi = xi)
+  ## defining a power fun based on a power.t.test
   powFuns_t <- list()
-  for(i in 1:length(alpha)){
-    eval(parse(text = paste(paste0("powFuns_t[[", paste0("'alpha", sub(".", "p", alpha[i], fixed = TRUE)), "']]", " <- function(psi)"),
-                            "{",
-                            "power.t.test(n = sse::n(psi)/2,",
-                            "delta = theta(psi),",
-                            "sd = xi(psi),",
-                            paste0("sig.level = ", alpha[i], ","),
-                            "power = NULL,",
-                            paste0("type = '", type, "'"),
-                            ")$power",
-                            "}", sep = "\n")))
+  for (i in 1:length(alpha)){
+    eval(parse(text =
+      paste(paste0("powFuns_t[[", paste0("'alpha", sub(".", "p", alpha[i], fixed = TRUE)), "']]", " <- function(psi)"),
+            "{",
+            "power.t.test(n = sse::n(psi)/2,",
+            "delta = theta(psi),",
+            "sd = xi(psi),",
+            paste0("sig.level = ", alpha[i], ","),
+            "power = NULL,",
+            paste0("type = '", type, "'"),
+            ")$power",
+            "}", sep = "\n")))
   }
-  ## evaulate power-function for all combinations of n, theta, xi and alpha
+  ## evaulates power function for all combinations of n, theta, xi and alpha
   calc_t <- map(powFuns_t, ~powCalc(psi_t, .))
   ## save calcs to be used in the shiny app
-  save_path <- file.path("inst", "extdata", paste0("calc_t_test_", type, ".rds"))
   saveRDS(calc_t, save_path)
   return(calc_t)
 }

R/fun_calc_t.R

@@ -1,7 +1,7 @@
 #' Shinydashboard two-color custom mint header
 #'
 #' @param header_title string containing a header title
-#' @return shiny.tag list with a custom header with title as defined in header_title
+#' @return shiny.tag list with a custom header
 #' @export
 #'
 get_header_mint <- function(header_title){

R/fun_get_header_mint.R

@@ -0,0 +1,17 @@
+#' Retrieves a list of module aliases
+#'
+#' Module aliases retrieved via get_module_registry() are used to define module IDs in shiny::callModule(),
+#' and are also used as tabnames for the sidebar, and shiny UI function, label and id.
+#'
+#' @return list of strings containing module aliases
+#' @seealso \code{\link{app_ui}}, \code{\link{app_server}}
+#' @export
+#'
+get_module_registry <- function(){
+  mod <- list()
+  mod$sse_intro <- "sse_intro"
+  mod$sse_ttest <- "sse_ttest"
+  mod$sse_ttest_plus <- "sse_ttest_plus"
+  mod$sse_prop <- "sse_prop"
+  return(mod)
+}