Merge pull request #15 from LMJL-Alea/dev

Resolves #12: Use viridis only as suggested package

DESCRIPTION

@@ -17,7 +17,11 @@ Authors@R: c(
            email = "[email protected]"),
     person(given = "Juliette",
            family = "Chiapello",
-           role = "ctb"))
+           role = "ctb"),
+    person(given = "Manon", 
+           family = "Simonot", 
+           role = "ctb", 
+           email = "[email protected]"))
 Description: A flexible permutation framework for making 
     inference such as point estimation, confidence 
     intervals or hypothesis testing, on any kind of data, 
@@ -42,7 +46,6 @@ Imports:
     rlang,
     tibble,
     usethis,
-    viridisLite,
     withr
 Suggests: 
     covr,
@@ -54,7 +57,9 @@ Suggests:
     plotly,
     rmarkdown,
     testthat (>= 3.0.0),
-    tidyr
+    tidyr,
+    viridis,
+    viridisLite
 VignetteBuilder: knitr
 URL: https://LMJL-Alea.github.io/flipr/, https://github.com/LMJL-Alea/flipr/
 BugReports: https://github.com/LMJL-Alea/flipr/issues/

R/plausibility-class.R

@@ -71,7 +71,7 @@ PlausibilityFunction <- R6::R6Class(
         )
         seed <- 1234
       }
-      private$seed <- seed
+      self$seed <- seed
     },
 
     #' @field nparams An integer specifying the number of parameters to be
@@ -205,8 +205,8 @@ PlausibilityFunction <- R6::R6Class(
     },
 
     #' @field pvalue_formula A string specifying which formula to use for
-    #'   computing the permutation p-value. Choices are either `probability`
-    #'   (default) or `estimator`. The former provides p-values that lead to
+    #'   computing the permutation p-value. Choices are either `exact`
+    #'   (default), `upper_bound` or `estimate`. The former provides p-values that lead to
     #'   exact hypothesis tests while the latter provides an unbiased estimate
     #'   of the traditional p-value.
     pvalue_formula = "exact",
@@ -285,7 +285,7 @@ PlausibilityFunction <- R6::R6Class(
           length(parameters),
           "."
         ))
-      withr::local_seed(private$seed)
+      withr::local_seed(self$seed)
       if (private$nsamples == 1) {
         x <- private$null_spec(private$data[[1]], parameters)
         test_result <- one_sample_test(
@@ -502,7 +502,7 @@ PlausibilityFunction <- R6::R6Class(
           stat_functions = private$stat_functions,
           stat_assignments = private$stat_assignments[param_index],
           !!!private$data,
-          seed = private$seed
+          seed = self$seed
         )
         pvf_temp$set_nperms(self$nperms)
         pvf_temp$set_alternative("two_tail")
@@ -661,7 +661,10 @@ PlausibilityFunction <- R6::R6Class(
         pbapply::pbsapply(self$get_value, cl = cl)
       if (ncores > 1L)
         parallel::stopCluster(cl)
-    }
+    },
+
+    #' @field seed A numeric value specifying the seed to be used. Defaults to `1234`.
+    seed = 1234
   ),
   private = list(
     null_spec = NULL,
@@ -687,8 +690,6 @@ PlausibilityFunction <- R6::R6Class(
       private$stat_functions <- purrr::map(val, rlang::as_function)
     },
 
-    seed = 1234,
-
     alternative_choices = c("two_tail", "left_tail", "right_tail"),
     aggregator_choices = c("tippett", "fisher"),
     pvalue_formula_choices = c("exact", "upper_bound", "estimate"),

R/viz.R

@@ -49,7 +49,13 @@ plot_pf <- function(pf, alpha = 0.05, ngrid = 10, ncores = 1, subtitle = "") {
   if (is.null(pf$grid))
     abort("The plausbility function has not yet been evaluated on a grid of parameters. Consider running the `$set_grid()` method first.")
 
-  color_palette <- viridisLite::viridis(3)
+  if (requireNamespace("viridis", quietly = TRUE)) {
+    color_palette <- viridis::viridis(3)
+  } else if (requireNamespace("viridisLite", quietly = TRUE)) {
+    color_palette <- viridisLite::viridis(3)
+  } else {
+    color_palette <- gg_color_hue(3)
+  }
 
   if (pf$nparams == 1) {
     nm <- names(pf$parameters)
@@ -59,12 +65,12 @@ plot_pf <- function(pf, alpha = 0.05, ngrid = 10, ncores = 1, subtitle = "") {
       labs(
         title = format_title(paste(
           pf$alternative,
-          pf$type,
+          pf$pvalue_formula,
           "p-value function"
         )),
         subtitle = format_title(paste(
           "Using",
-          pf$B,
+          pf$nperms,
           "randomly sampled permutations from seed",
           pf$seed
         )),
@@ -117,6 +123,11 @@ plot_pf <- function(pf, alpha = 0.05, ngrid = 10, ncores = 1, subtitle = "") {
   }
 }
 
+gg_color_hue <- function(n) {
+  hues <- seq(15, 375, length = n + 1)
+  grDevices::hcl(h = hues, l = 65, c = 100)[1:n]
+}
+
 format_title <- function(x) {
   x <- gsub("_", "-", x)
   paste0(toupper(substring(x, 1, 1)), tolower(substring(x, 2)))

tests/testthat/test-plausibility-class.R

@@ -29,7 +29,7 @@ test_that("Regular test - Documentation example", {
   expect_gt(actual, expected)
 })
 
-test_that("Snapshot test - Two normal distributions with different means and variances", {
+test_that("Regular test - Two normal distributions with different means and variances", {
   # Arrange
   set.seed(123)
   n <- 15