test_that("circa_single works", { tau <- 15 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 ) ) 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. fit_tau <- extract_model_coefs(out_rhythmic_free_tau$fit)["tau", ] tau_est <- fit_tau["estimate"] tau_ll <- tau_est - 1.96 * fit_tau["std_error"] tau_ul <- tau_est + 1.96 * fit_tau["std_error"] expect_true(tau < tau_ul & tau > tau_ll) # period estimate is approx well estimated to be close to tau (ln 5) # assess whether decay on amplitude per-hour is modelled well when period is parameterized alpha_decay_in <- 0.01 tau_in <- 16 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 ) ) }) fit_alpha_decay <- extract_model_coefs(out_alpha_decay$fit)["alpha_decay", ] alpha_decay_est <- fit_alpha_decay["estimate"] alpha_decay_ll <- alpha_decay_est - 1.96 * fit_alpha_decay["std_error"] alpha_decay_ul <- alpha_decay_est + 1.96 * fit_alpha_decay["std_error"] expect_true(alpha_decay_in < alpha_decay_ul & alpha_decay_in > alpha_decay_ll) }) ### make test to capture output and test that running with/without suppress_all works to suppress messages to console test_that("suppress_all works", { y <- structure( list( time = c( 1L, 1L, 1L, 1L, 5L, 5L, 9L, 9L, 13L, 13L, 17L, 17L, 17L, 21L, 21L, 21L ), value = c( 6.46491702175632, 6.37210528510888, 6.75505623236344, 6.4457897862926, 6.63766950190431, 6.48725138475295, 6.40819847507183, 6.42253808100338, 6.37486222182972, 6.51868394085349, 6.41506838906571, 6.40449437273951, 6.47273627195726, 6.76905314588271, 6.59233676207294, 6.44481187866212 ) ), class = "data.frame", row.names = c(NA, -16L) ) withr::with_seed(1, { output <- capture.output( circa_single(x = y, col_time = "time", col_outcome = "value", return_figure = FALSE), type = "message" ) 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 test_that("weights work", { # all weights should be 1 df <- make_data(phi1 = 6) df <- df[df$group == "g1", ] out <- circa_single( x = df, col_time = "time", col_outcome = "measure" ) expect_true(all(out$fit$weights == 1)) # all weights should not be 1 sw <- runif(n = nrow(df)) out2 <- circa_single( x = df, col_time = "time", col_outcome = "measure", weights = sw ) expect_false(all(out2$fit$weights == 1)) # weights must be same length as nrow(x) sw2 <- c(sw, 1) expect_error( circa_single( x = df, col_time = "time", col_outcome = "measure", weights = sw2 ) ) # weights must not contain NA sw3 <- sw sw3[1] <- NA expect_error( circa_single( x = df, col_time = "time", col_outcome = "measure", weights = sw3 ) ) # weights must not be negative sw4 <- sw sw4[1] <- -1 expect_error( circa_single( x = df, col_time = "time", col_outcome = "measure", weights = sw4, timeout_n = 1 ) ) })