avoid setting seeds and update 'size' to 'linewidth'

DESCRIPTION

@@ -21,7 +21,8 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Imports: 
     ggplot2 (>= 2.2.1),
-    stats
+    stats,
+    withr
 Suggests: 
     testthat (>= 3.0.0),
     nlme,

R/circa_single.R

@@ -151,7 +151,7 @@ circa_single <- function(x,
       )
     if (data_rhythmic) {
       fig_out <- p +
-        ggplot2::stat_function(fun = eq, size = 1) +
+        ggplot2::stat_function(fun = eq, linewidth = 1) +
         ggplot2::labs(subtitle = "Data is rhythmic", x = "time (hours)")
     } else {
       fig_out <- p +

R/circa_single_mixed.R

@@ -23,6 +23,7 @@
 #' @export
 #'
 #' @examples
+#' \donttest{
 #' set.seed(42)
 #' mixed_data <- function(n) {
 #'   counter <- 1
@@ -50,7 +51,7 @@
 #'   x = df, col_time = "time", col_outcome = "measure",
 #'   col_id = "id", randomeffects = c("k"), weights = sw
 #' )
-#'
+#' }
 circa_single_mixed <- function(x,
                                col_time,
                                col_outcome,
@@ -190,7 +191,7 @@ circa_single_mixed <- function(x,
   if (return_figure) {
     if (data_rhythmic) {
       fig_out <- ggplot2::ggplot(x, ggplot2::aes(time, measure)) +
-        ggplot2::stat_function(fun = eq, size = 1) +
+        ggplot2::stat_function(fun = eq, linewidth = 1) +
         ggplot2::geom_point() +
         ggplot2::xlim(
           min(floor(x$time / period) * period),

R/circacompare.R

@@ -199,8 +199,8 @@ circacompare <- function(x,
   eval(parse(text = eq_expression$g2))
 
   fig_out <- ggplot2::ggplot(x, ggplot2::aes(time, measure)) +
-    ggplot2::stat_function(ggplot2::aes(colour = group_1_text), fun = eq_1, size = 1) +
-    ggplot2::stat_function(ggplot2::aes(colour = group_2_text), fun = eq_2, size = 1) +
+    ggplot2::stat_function(ggplot2::aes(colour = group_1_text), fun = eq_1, linewidth = 1) +
+    ggplot2::stat_function(ggplot2::aes(colour = group_2_text), fun = eq_2, linewidth = 1) +
     ggplot2::geom_point(ggplot2::aes(colour = group)) +
     ggplot2::scale_colour_manual(
       breaks = c(group_1_text, group_2_text),

R/circacompare_mixed.R

@@ -24,6 +24,7 @@
 #'
 #' @examples
 #' # Generate some data with within-id correlation for phase-shift (phi1)
+#' \donttest{
 #' set.seed(99)
 #' phi1_in <- 3.15
 #'
@@ -62,6 +63,7 @@
 #'   control = list(grouped_params = c("phi"), random_params = c("phi1")),
 #'   weights = sw
 #' )
+#' }
 #'
 circacompare_mixed <- function(x,
                                col_time,
@@ -265,8 +267,8 @@ circacompare_mixed <- function(x,
   eval(parse(text = eq_expression$g2))
 
   fig_out <- ggplot2::ggplot(x, ggplot2::aes(time, measure)) +
-    ggplot2::stat_function(ggplot2::aes(colour = group_1_text), fun = eq_1, size = 1) +
-    ggplot2::stat_function(ggplot2::aes(colour = group_2_text), fun = eq_2, size = 1) +
+    ggplot2::stat_function(ggplot2::aes(colour = group_1_text), fun = eq_1, linewidth = 1) +
+    ggplot2::stat_function(ggplot2::aes(colour = group_2_text), fun = eq_2, linewidth = 1) +
     ggplot2::geom_point(ggplot2::aes(colour = group)) +
     ggplot2::scale_colour_manual(
       breaks = c(group_1_text, group_2_text),

R/make_data.R

@@ -20,7 +20,19 @@
 #' data <- make_data(k1 = 3, alpha1 = 4, phi1 = 6)
 make_data <- function(k = 0, k1 = 3, alpha = 10, alpha1 = 4, phi = 0, phi1 = 3.15, tau = 24, hours = 48, noise_sd = 0.1, seed = NULL) {
   if (!is.null(seed)) {
-    set.seed(seed)
+    withr::with_seed(seed, {
+      return(make_data(
+        k = k,
+        k1 = k1,
+        alpha = alpha,
+        alpha1 = alpha1,
+        phi = phi,
+        phi1 = phi1,
+        tau = tau,
+        hours = hours,
+        noise_sd = noise_sd
+      ))
+    })
   }
   g1 <- data.frame(
     time = rep(NA, hours),

tests/testthat/test-circa_single.R

@@ -1,28 +1,26 @@
 test_that("circa_single works", {
-  set.seed(42)
   tau <- 15
-  data_rhythmic <- make_data(k1 = 0, alpha1 = 0, phi = pi, phi1 = 0, noise_sd = 1)
-  out_rhythmic <- circa_single(x = data_rhythmic, col_time = "time", col_outcome = "measure")
-
-  data_rhythmic$time <- data_rhythmic$time / 24 * tau
-  out_rhythmic_free_tau <-
-    circa_single(
-      x = data_rhythmic, col_time = "time", col_outcome = "measure",
-      period = NA,
-      control = list(
-        main_params = c("k", "alpha", "phi", "tau"),
-        period_min = tau - 5,
-        period_max = tau + 5
+  withr::with_seed(42, {
+
+    data_rhythmic <- make_data(k1 = 0, alpha1 = 0, phi = pi, phi1 = 0, noise_sd = 1)
+    out_rhythmic <- circa_single(x = data_rhythmic, col_time = "time", col_outcome = "measure")
+
+    data_rhythmic$time <- data_rhythmic$time / 24 * tau
+    out_rhythmic_free_tau <-
+      circa_single(
+        x = data_rhythmic, col_time = "time", col_outcome = "measure",
+        period = NA,
+        control = list(
+          main_params = c("k", "alpha", "phi", "tau"),
+          period_min = tau - 5,
+          period_max = tau + 5
+        )
       )
-    )
-
-
-  # out_rhythmic_free_tau$plot + ggplot2::geom_vline(xintercept=out_rhythmic_free_tau$summary[5, 'value'])
-
-  data_arrhythmic <- make_data(alpha = 0)
-  data_arrhythmic <- data_arrhythmic[data_arrhythmic$group == "g1", ]
-  out_arrhythmic <- circa_single(x = data_arrhythmic, col_time = "time", col_outcome = "measure")
 
+    data_arrhythmic <- make_data(alpha = 0)
+    data_arrhythmic <- data_arrhythmic[data_arrhythmic$group == "g1", ]
+    out_arrhythmic <- circa_single(x = data_arrhythmic, col_time = "time", col_outcome = "measure")
+  })
   expect_true(class(out_rhythmic) == "list") # no errors when running circa_single()
   expect_true(out_rhythmic$summary[1, 2] < 0.01) # amplitude_p for rhythmic data is small
   expect_true(out_arrhythmic$summary[1, 2] > 0.05) # amplitude_p for arrhythmic data is large.
@@ -37,22 +35,23 @@ test_that("circa_single works", {
   # assess whether decay on amplitude per-hour is modelled well when period is parameterized
   alpha_decay_in <- 0.01
   tau_in <- 16
-  df <- make_data(k = 5, k1 = 0, alpha = 20, alpha1 = 0, phi = 2, phi1 = 0, hours = 96, noise_sd = 1)
-  df$time <- df$time / 24 * tau_in
-  df$measure <- df$measure * exp(-alpha_decay_in * (df$time))
-  out_alpha_decay <- circa_single(
-    x = df,
-    col_time = "time",
-    col_outcome = "measure",
-    period = NA,
-    control = list(
-      main_params = c("k", "alpha", "phi", "tau"),
-      decay_params = c("alpha"),
-      period_min = 12,
-      period_max = 20
+  withr::with_seed(1, {
+    df <- make_data(k = 5, k1 = 0, alpha = 20, alpha1 = 0, phi = 2, phi1 = 0, hours = 96, noise_sd = 1)
+    df$time <- df$time / 24 * tau_in
+    df$measure <- df$measure * exp(-alpha_decay_in * (df$time))
+    out_alpha_decay <- circa_single(
+      x = df,
+      col_time = "time",
+      col_outcome = "measure",
+      period = NA,
+      control = list(
+        main_params = c("k", "alpha", "phi", "tau"),
+        decay_params = c("alpha"),
+        period_min = 12,
+        period_max = 20
+      )
     )
-  )
-  out_alpha_decay
+  })
 
   fit_alpha_decay <- extract_model_coefs(out_alpha_decay$fit)["alpha_decay", ]
   alpha_decay_est <- fit_alpha_decay["estimate"]
@@ -80,22 +79,22 @@ test_that("suppress_all works", {
   class = "data.frame", row.names = c(NA, -16L)
   )
 
-  set.seed(1)
-  output <- capture.output(
-    {
-      circa_single(x = y, col_time = "time", col_outcome = "value", return_figure = FALSE)
-    },
-    type = "message"
-  )
-  expect_true(length(output) > 1)
+  withr::with_seed(1, {
+    output <- capture.output(
+      circa_single(x = y, col_time = "time", col_outcome = "value", return_figure = FALSE),
+      type = "message"
+    )
 
-  output <- capture.output(
-    {
-      circa_single(x = y, col_time = "time", col_outcome = "value", return_figure = FALSE, suppress_all = TRUE)
-    },
-    type = "message"
-  )
-  expect_true(length(output) == 0)
+
+    output_suppressed <- capture.output(
+      circa_single(x = y, col_time = "time", col_outcome = "value", return_figure = FALSE, suppress_all = TRUE),
+      type = "message"
+    )
+
+  })
+
+  expect_true(length(output) > 1)
+  expect_true(length(output_suppressed) == 0)
 })
 
 ### make test that weights are used correctly and malformatted weights are detected