Development

.Rbuildignore

@@ -17,5 +17,5 @@ $run_dev.*
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
-
+^.covrignore$
 ^codecov\.yml$

.covrignore

@@ -0,0 +1,5 @@
+R/mod_*
+R/run_app.R
+R/app_server.R
+R/app_ui.R
+R/app_config.R

.github/workflows/test-coverage.yaml

@@ -3,7 +3,7 @@
 on:
   workflow_dispatch:
   push:
-    branches: [main, master]
+    branches: [main, master, development]
   pull_request:
     branches: [main, master]
 

DESCRIPTION

@@ -16,7 +16,6 @@ Imports:
     dplyr,
     DT,
     ggplot2,
-    glue,
     golem (>= 0.4.0),
     magrittr,
     purrr,
@@ -29,7 +28,6 @@ Imports:
     shinydashboardPlus,
     shinyWidgets,
     stats,
-    stringr,
     tidyr,
     markdown,
     withr

NAMESPACE

@@ -17,7 +17,6 @@ import(ggplot2)
 import(shiny)
 import(shinycssloaders)
 import(shinydashboard)
-import(stringr)
 import(tidyr)
 importFrom(golem,activate_js)
 importFrom(golem,add_resource_path)

R/app_ui.R

@@ -13,6 +13,7 @@
     shinydashboardPlus::dashboardPage(
       shinydashboardPlus::dashboardHeader(
         title = "ordinalsimr",
+        mod_rng_option_ui("rng_option_1"),
         tags$li(class = "dropdown", tags$a(
           href = "https://neuroshepherd.github.io/ordinalsimr/",
           icon("book-open-reader"), "Docs", target = "_blank"
@@ -29,10 +30,10 @@
       shinydashboardPlus::dashboardSidebar(
         sidebarMenu(
           menuItem("Home", tabName = "homeinfo_page", icon = icon("book")),
           menuItem("Simulation", tabName = "simulation_page", icon = icon("sliders")),
           menuItem("Distributions", tabName = "distributions_page", icon = icon("chart-simple")),
           menuItem("Report", tabName = "report_page", icon = icon("markdown")),
           menuItem("Data Download", tabName = "download_page", icon = icon("file-excel"))
         )
       ),
       dashboardBody(
@@ -48,9 +49,8 @@
                 width = 3,
                 mod_iterations_ui("iterations_1"),
                 mod_sample_size_ui("sample_size_1"),
-                mod_sample_probabilities_ui("sample_probabilities_1"),
-                mod_rng_option_ui("rng_option_1")
-              ),
+                mod_sample_probabilities_ui("sample_probabilities_1")
+                ),
               box(
                 width = 9,
                 mod_data_entry_ui("data_entry_1")

R/mod_rng_option.R

@@ -9,7 +9,12 @@
 #' @importFrom shiny NS tagList
 mod_rng_option_ui <- function(id) {
   ns <- NS(id)
-  tagList(
+
+  shinydashboardPlus::dropdownBlock(
+    id = ns("rng_options"),
+    title = "RNG Options",
+    icon = icon("gear"),
+    badgeStatus = "info",
     selectInput(ns("rng_kind"),
       label = "RNG Kind",
       choices = c(
@@ -29,6 +34,7 @@ mod_rng_option_ui <- function(id) {
       selected = "Rejection"
     )
   )
+
 }
 
 #' rng_option Server Functions

R/mod_sample_size.R

@@ -12,7 +12,7 @@ mod_sample_size_ui <- function(id) {
   ns <- NS(id)
   tagList(
     numericRangeInput(
-      inputId = ns("sample_n"), label = "Sample Size Range",
+      inputId = ns("sample_n"), label = "Total Sample Size Range",
       value = c(30, 80), step = 1
     )
   )

R/mod_save_data.R

@@ -49,7 +49,7 @@ mod_save_data_server <- function(id, input_data, processed_data, rng_info, input
     output$save_button <- downloadHandler(
       filename = function() {
         # Consider: use .RData in future for flexibility?
-        glue::glue("data-{Sys.Date()}-{session$token}-{download_counter()}.rds")
+        paste0("data", Sys.Date(), session$token, download_counter(), ".rds")
       },
       content = function(file) {
         saveRDS(data_to_save(), file)
@@ -61,7 +61,7 @@ mod_save_data_server <- function(id, input_data, processed_data, rng_info, input
     output$save_xlsx <- downloadHandler(
       filename = function() {
         # Consider: use .RData in future for flexibility?
-        glue::glue("data-{Sys.Date()}-{session$token}-{download_counter()}.xlsx")
+        paste0("data", Sys.Date(), session$token, download_counter(), ".xlsx")
       },
       content = function(file) {
         writexl::write_xlsx(

R/mod_stats_calculations.R

@@ -111,13 +111,14 @@ mod_stats_calculations_server <- function(id, probability_data, sample_prob, ite
     })
 
 
-    output$results_table <- DT::renderDataTable(
+    output$results_table <- DT::renderDataTable({
+      # browser()
       comparison_results() %>%
         bind_rows() %>%
         dplyr::select(.data$sample_size, .data$wilcox:.data$coinasymp) %>%
         DT::datatable(options = list(scrollX = TRUE)) %>%
-        DT::formatRound(2:8, digits = 5)
-    )
+        DT::formatRound(2:7, digits = 5)
+    })
     outputOptions(output, "results_table", suspendWhenHidden = FALSE)
 
     # if not keeping these output tables, use observe({group1_results()}) to
@@ -127,7 +128,7 @@ mod_stats_calculations_server <- function(id, probability_data, sample_prob, ite
         bind_rows() %>%
         dplyr::select(.data$sample_size, .data$wilcox:.data$coinasymp) %>%
         DT::datatable(options = list(scrollX = TRUE)) %>%
-        DT::formatRound(2:8, digits = 5)
+        DT::formatRound(2:7, digits = 5)
     )
     outputOptions(output, "group1_pvalues", suspendWhenHidden = FALSE)
 
@@ -136,7 +137,7 @@ mod_stats_calculations_server <- function(id, probability_data, sample_prob, ite
         bind_rows() %>%
         dplyr::select(.data$sample_size, .data$wilcox:.data$coinasymp) %>%
         DT::datatable(options = list(scrollX = TRUE)) %>%
-        DT::formatRound(2:8, digits = 5)
+        DT::formatRound(2:7, digits = 5)
     )
     outputOptions(output, "group2_pvalues", suspendWhenHidden = FALSE)
 

R/ordinal_tests.R

@@ -8,7 +8,6 @@
 #'  \item{stats::chisq.test(correct = FALSE)}
 #'  \item{stats::chisq.test(correct = TRUE)}
 #'  \item{rms::lrm()}
-#'  \item{stats.kruskal.test()}
 #'  \item{coin::independence_test(ytrafo = coin::rank_trafo)}
 #'  }
 #' @param x Group one
@@ -27,7 +26,6 @@ ordinal_tests <- function(x, y, ...) {
     chi_sq_false = stats::chisq.test(x, y, correct = FALSE)[["p.value"]],
     chi_sq_true = stats::chisq.test(x, y, correct = TRUE)[["p.value"]],
     lrm = rms::lrm(x ~ y)$stats[["P"]],
-    kruskal = stats::kruskal.test(x ~ y)[["p.value"]],
     coinasymp = coin::pvalue(coin::independence_test(x ~ y, ytrafo = coin::rank_trafo))
   )
 }

R/run_simulations.R

@@ -34,10 +34,10 @@ run_simulations <- function(sample_size, sample_prob, prob0, prob1, niter,
 
 
   K <- length(prob0)
-  p_values <- matrix(NA, niter, 7)
+  p_values <- matrix(NA, niter, 6)
   colnames(p_values) <- c(
-    "Wilcoxon", "Fisher", "Chi Squared\n(No Correction)", "Chi Squared\n(Correction)",
-    "Prop. Odds", "Kruskal-Wallis", "Coin Indep. Test"
+    "Wilcoxon", "Fisher", "Chi Squared\n(No Correction)",
+    "Chi Squared\n(Correction)", "Prop. Odds", "Coin Indep. Test"
   )
 
 
@@ -73,5 +73,5 @@ run_simulations <- function(sample_size, sample_prob, prob0, prob1, niter,
       format = "Running {niter} iterations on {length(sample_size)} sample sizes. Progress: {cli::pb_bar} {cli::pb_percent} {cli::pb_eta}"
     )
   ) %>%
-    purrr::set_names(glue::glue("sample_size_{sample_size}"))
+    purrr::set_names(paste0("sample_size_",sample_size))
 }

R/utils.R

@@ -7,19 +7,18 @@
 #' @return Numeric vector of length 2
 #' @export
 #'
-#' @import stringr
 #'
 #' @examples
 #'
 #' parse_ratio_text("70:30")
 #'
 parse_ratio_text <- function(text) {
-  assert_that(str_detect(text, "[[:digit:]]{1,2}:[[:digit:]]{1,2}"),
+  assert_that(grepl("[[:digit:]]{1,2}:[[:digit:]]{1,2}", text),
     msg = "Incorrect ratio format."
   )
 
-  pre_value <- as.numeric(str_extract(text, "^[[:digit:]]{1,2}"))
-  post_value <- as.numeric(str_extract(text, "[[:digit:]]{1,2}$"))
+  pre_value <- as.numeric(regmatches(text, regexpr("^[[:digit:]]{1,2}", text)))
+  post_value <- as.numeric(regmatches(text, regexpr("[[:digit:]]{1,2}$", text)))
 
   assert_that(pre_value + post_value == 100,
     msg = "Ratio does not sum to 100."
@@ -47,8 +46,8 @@ parse_ratio_text <- function(text) {
 #' @export
 #'
 calculate_power_t2error <- function(df, alpha = 0.05, power_confidence_int = 95, n = NA_real_) {
-  ci_power_label <- glue::glue("Power {power_confidence_int}% CI")
-  ci_t2error_label <- glue::glue("TII Error {power_confidence_int}% CI")
+  ci_power_label <- paste0("Power ", power_confidence_int, "% CI")
+  ci_t2error_label <- paste0("TII Error ", power_confidence_int, "% CI")
 
   df %>%
     group_by(.data[["sample_size"]]) %>%
@@ -60,11 +59,11 @@ calculate_power_t2error <- function(df, alpha = 0.05, power_confidence_int = 95,
             lower_power_bound = binom_power$conf.int[[1]],
             upper_power_bound = binom_power$conf.int[[2]],
             power = binom_power$estimate,
-            !!ci_power_label := glue::glue("[{round(lower_power_bound, 4)}, {round(upper_power_bound, 4)}]"),
+            !!ci_power_label := paste0("[",round(lower_power_bound, 4), ", ", round(upper_power_bound, 4), "]"),
             lower_t2error_bound = 1 - upper_power_bound,
             upper_t2error_bound = 1 - lower_power_bound,
             t2_error = 1 - binom_power$estimate,
-            !!ci_t2error_label := glue::glue("[{round(lower_t2error_bound, 4)}, {round(upper_t2error_bound, 4)}]")
+            !!ci_t2error_label := paste0("[",round(lower_t2error_bound, 4), ", ", round(upper_t2error_bound, 4), "]")
           )
         }) %>%
           purrr::list_rbind(names_to = "test")
@@ -89,7 +88,7 @@ calculate_power_t2error <- function(df, alpha = 0.05, power_confidence_int = 95,
 #' @export
 #'
 calculate_t1_error <- function(df, alpha = 0.05, t1_error_confidence_int = 95, n = NA_real_) {
-  ci_label <- glue::glue("{t1_error_confidence_int}% CI")
+  ci_label <- paste0(t1_error_confidence_int, "% CI")
 
   df %>%
     group_by(.data[["sample_size"]]) %>%
@@ -101,8 +100,8 @@ calculate_t1_error <- function(df, alpha = 0.05, t1_error_confidence_int = 95, n
             lower_t1_bound = binom_results$conf.int[[1]],
             upper_t1_bound = binom_results$conf.int[[2]],
             t1_error = binom_results$estimate,
-            !!ci_label := glue::glue("[{round(lower_t1_bound,4)}, {round(upper_t1_bound,4)}]")
-          )
+            !!ci_label := paste0("[",round(lower_t1_bound, 4), ", ", round(upper_t1_bound, 4), "]")
+            )
         }) %>%
           purrr::list_rbind(names_to = "test")
       }
@@ -127,9 +126,11 @@ plot_distribution_results <- function(df, alpha = 0.05, outlier_removal = 0.10)
   df %>%
     pivot_longer(cols = -.data$sample_size, names_to = "test_name") %>%
     mutate(test_name = stats::reorder(.data[["test_name"]], .data[["value"]], decreasing = TRUE)) %>%
+    group_by(.data$sample_size, .data$test_name) %>%
+    summarise(value = mean(.data$value)) %>%
     {
       ggplot(., aes(x = .data[["sample_size"]], y = .data[["value"]], color = .data[["test_name"]])) +
-        geom_smooth(alpha = 0.1) +
+        geom_line() +
         geom_hline(yintercept = alpha, linetype = "dashed", size = 2) +
         ggtitle("Plot of p-values") +
         labs(x = "Sample Size", y = "p-value", color = "Statistical Test") +
@@ -178,11 +179,7 @@ plot_power <- function(df) {
       ymin = .data[["lower_power_bound"]], ymax = .data[["upper_power_bound"]],
       color = .data[["test"]], fill = .data[["test"]]
     )) +
-    geom_smooth(
-      method = "glm",
-      method.args = list(family = "binomial"),
-      se = F
-    ) +
+    geom_line() +
     theme_bw() +
     theme(
       axis.text = element_text(face = "bold", size = 14),

inst/homepage.Rmd

@@ -24,7 +24,6 @@ vignette("ordinalsimr", package = "ordinalsimr")
 * Chi-Squared without Continuity Correction: `stats::chisq.test(correct = FALSE)`
 * Chi-Squared with Continuity Correction: `stats::chisq.test(correct = TRUE)`
 * Proportional Odds model: `rms::lrm()`
-* Kruskal-Wallis test: `stats.kruskal.test()`
 * Independence Test: `coin::independence_test(ytrafo = coin::rank_trafo)`
 
 ## Pages

inst/homepage.md

@@ -25,7 +25,6 @@ vignettes for more information on coding your own simulation studies.
 -   Chi-Squared with Continuity Correction:
     `stats::chisq.test(correct = TRUE)`
 -   Proportional Odds model: `rms::lrm()`
--   Kruskal-Wallis test: `stats.kruskal.test()`
 -   Independence Test:
     `coin::independence_test(ytrafo = coin::rank_trafo)`
 

tests/testthat/test-utils.R

@@ -42,7 +42,7 @@ test_that("t1 error calculations work", {
 # test data
 test_that("data object names are consistent", {
   expected_col_names <- c(
-    "wilcox", "fisher", "chi_sq_false", "chi_sq_true", "lrm", "kruskal",
+    "wilcox", "fisher", "chi_sq_false", "chi_sq_true", "lrm",
     "coinasymp", "run", "y", "x", "n_null", "n_intervene", "sample_size", "K"
   )
 
@@ -56,11 +56,11 @@ test_that("data object names are consistent", {
 test_that("data formatting works", {
   results <- format_simulation_data(simulation_data_one_group)
   tbl_cols <- c(
-    "wilcox", "fisher", "chi_sq_false", "chi_sq_true", "lrm", "kruskal",
+    "wilcox", "fisher", "chi_sq_false", "chi_sq_true", "lrm",
     "coinasymp", "run", "y", "x", "n_null", "n_intervene", "sample_size", "K"
   )
 
   expect_equal(colnames(results), tbl_cols)
   expect_s3_class(results, "tbl")
-  expect_equal(ncol(results), 14)
+  expect_equal(ncol(results), 13)
 })