added palette manipulation

victor-navarro · Apr 7, 2024 · f163b47 · f163b47
1 parent 06eaaa4
commit f163b47
Show file tree

Hide file tree

Showing 35 changed files with 150 additions and 48 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: calmr
 Title: Canonical Associative Learning Models and their Representations
-Version: 0.6.2
+Version: 0.6.3
 Authors@R: 
     person("Victor", "Navarro", , "navarrov@cardiff.ac.uk", role = c("aut", "cre", "cph"))
 Description: Implementations of canonical associative learning models,
@@ -78,6 +78,7 @@ Collate:
     'calmr_verbosity.R'
     'parallel_helpers.R'
     'maps.R'
+    'set_calmr_palette.R'
     'class_model.R'
     'class_design.R'
     'class_result.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -28,6 +28,7 @@ export(plot_tbins)
 export(plot_trials)
 export(rsa)
 export(run_experiment)
+export(set_calmr_palette)
 export(set_reward_parameters)
 export(supported_families)
 export(supported_models)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# calmr 0.6.3
+* Added `set_calmr_palette()` function to control the colour/fill scales used to plot results ([#1](https://github.com/victor-navarro/calmr/issues/1)).
+
 # calmr 0.6.2
 * Aggregation of ANCCR data now ignores time; time entries are averaged.
 * Added the Temporal Difference model under the name "TD". The model is in an experimental state.

diff --git a/R/assertions.R b/R/assertions.R
@@ -147,3 +147,14 @@ is_design <- function(object) {
       length(experiment@design@mapping$unique_nominal_stimuli) > 1
   )
 }
+
+.assert_valid_palette <- function(palette) {
+  if (is.null(palette)) {
+    return("viridis")
+  }
+  stopifnot(
+    "Palette must be one returned by `set_calmr_palette()`" =
+      palette %in% set_calmr_palette()
+  )
+  palette
+}
diff --git a/R/maps.R b/R/maps.R
@@ -260,7 +260,7 @@ plots_map <- function() {
     "elegibilities" = "Elegibility Trace",
     "probabilities" = "Response Probability"
   )
-  ggplot2::labs(y = prettynames[output])
+  prettynames[output]
 }
 
 .get_scale_prettyname <- function(output) {

diff --git a/R/plotting_functions.R b/R/plotting_functions.R
@@ -155,18 +155,29 @@ plot_targetted_complex_trials <- function(data, col) {
 #' @return A 'ggplot2' scale for colour or fill.
 #' @noRd
 .calmr_scales <- function(which, ...) {
-  switch(which,
-    "colour_d" = {
-      ggplot2::scale_colour_viridis_d(begin = .1, end = .9, ...)
-    },
-    "fill_d" = {
-      ggplot2::scale_fill_viridis_d(begin = .1, end = .9, ...)
-    },
-    "colour_c" = {
-      ggplot2::scale_colour_viridis_c(begin = .1, end = .9, ...) # nocov
-    },
-    "fill_c" = {
-      ggplot2::scale_fill_viridis_c(begin = .1, end = .9, ...)
-    }
-  )
+  current_scale <- getOption("calmr_palette", default = "viridis")
+  if (current_scale == "viridis") {
+    return(switch(which,
+      "colour_d" = ggplot2::scale_colour_viridis_d(
+        begin = .1, end = .9, ...
+      ),
+      "fill_d" = ggplot2::scale_fill_viridis_d(
+        begin = .1, end = .9, ...
+      ),
+      "colour_c" = ggplot2::scale_colour_viridis_c(
+        begin = .1, end = .9, ...
+      ),
+      "fill_c" = ggplot2::scale_fill_viridis_c(
+        begin = .1, end = .9, ...
+      )
+    ))
+  }
+  if (current_scale == "hue") {
+    return(switch(which,
+      "colour_d" = ggplot2::scale_colour_discrete(...),
+      "fill_d" = ggplot2::scale_fill_discrete(...),
+      "colour_c" = ggplot2::scale_colour_continuous(...), # nocov
+      "fill_c" = ggplot2::scale_fill_continuous(...)
+    ))
+  }
 }
diff --git a/R/set_calmr_palette.R b/R/set_calmr_palette.R
@@ -0,0 +1,17 @@
+#' Get/set the colour/fill palette for plots
+#' @param palette A string specifying the available palettes.
+#' If NULL, returns available palettes.
+#' @return The old palette (invisibly) if palette is not NULL.
+#' Otherwise, a character vector of available palettes.
+#' @note Changes here do not affect the palette used in graphs.
+#' @export
+
+set_calmr_palette <- function(palette = NULL) {
+  avail_palettes <- c("viridis", "hue")
+  if (is.null(palette)) {
+    return(avail_palettes)
+  }
+  palette <- .assert_valid_palette(palette)
+  old <- options("calmr_palette" = palette)
+  invisible(old)
+}
diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE.html b/docs/LICENSE.html
diff --git a/docs/articles/calmr_app.html b/docs/articles/calmr_app.html
diff --git a/docs/articles/calmr_basics.html b/docs/articles/calmr_basics.html
diff --git a/docs/articles/calmr_fits.html b/docs/articles/calmr_fits.html
diff --git a/docs/articles/heidi_similarity.html b/docs/articles/heidi_similarity.html
diff --git a/docs/articles/index.html b/docs/articles/index.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -15,7 +15,7 @@ articles:
   RW1972: RW1972.html
   SM2007: SM2007.html
   using_time_models: using_time_models.html
-last_built: 2024-04-04T16:26Z
+last_built: 2024-04-07T11:45Z
 urls:
   reference: https://victornavarro.org/calmr/reference
   article: https://victornavarro.org/calmr/articles

diff --git a/docs/reference/CalmrFit-class.html b/docs/reference/CalmrFit-class.html
diff --git a/docs/reference/CalmrRSA-class.html b/docs/reference/CalmrRSA-class.html
diff --git a/docs/reference/RSA.html b/docs/reference/RSA.html
diff --git a/docs/reference/compare_models.html b/docs/reference/compare_models.html
diff --git a/docs/reference/fit_model.html b/docs/reference/fit_model.html
diff --git a/docs/reference/index.html b/docs/reference/index.html
diff --git a/docs/reference/parse_design.html b/docs/reference/parse_design.html
diff --git a/docs/reference/pati.html b/docs/reference/pati.html
diff --git a/docs/reference/run_experiment.html b/docs/reference/run_experiment.html
diff --git a/docs/search.json b/docs/search.json
diff --git a/docs/sitemap.xml b/docs/sitemap.xml
@@ -387,6 +387,9 @@
   <url>
     <loc>https://victornavarro.org/calmr/reference/RW1972.html</loc>
   </url>
+  <url>
+    <loc>https://victornavarro.org/calmr/reference/set_calmr_palette.html</loc>
+  </url>
   <url>
     <loc>https://victornavarro.org/calmr/reference/set_reward_parameters.html</loc>
   </url>

diff --git a/man/plotting_functions.Rd b/man/plotting_functions.Rd
diff --git a/man/set_calmr_palette.Rd b/man/set_calmr_palette.Rd
diff --git a/tests/testthat/test-RSA.R b/tests/testthat/test-RSA.R
@@ -40,7 +40,9 @@ test_that("rsa method works with one model", {
 })
 
 test_that("rsa method stops with models outside x", {
-  expect_error(rsa(comp, comparisons = list("HDI2020" = c("operator_switches"))))
+  expect_error(rsa(comp,
+    comparisons = list("HDI2020" = c("operator_switches"))
+  ))
 })
 
 test_that("rsa method stops with bad model outputs", {