diff --git a/DESCRIPTION b/DESCRIPTION index 90156c1..f7d12c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,6 +13,7 @@ Imports: data.table, forcats, fs, + ggplot2, instantiate, logger, mosaic, @@ -26,11 +27,11 @@ Additional_repositories: SystemRequirements: CmdStan (https://mc-stan.org/users/interfaces/cmdstan) Suggests: dplyr, - ggplot2, knitr, lubridate, rmarkdown, testthat + vdiffr VignetteBuilder: knitr LinkingTo: cpp11 diff --git a/R/biokinetics.R b/R/biokinetics.R index b353e4f..20c2091 100644 --- a/R/biokinetics.R +++ b/R/biokinetics.R @@ -276,6 +276,11 @@ biokinetics <- R6::R6Class( n_draws = n_draws, data = private$data) }, + #' @description Plot model input data with a smoothing function. + #' @return A ggplot2 object. + plot_data = function() { + plot_data(private$data) + }, #' @description View the data that is passed to the stan model, for debugging purposes. #' @return A list of arguments that will be passed to the stan model. get_stan_data = function() { diff --git a/R/plot.R b/R/plot.R index cc61250..883a763 100644 --- a/R/plot.R +++ b/R/plot.R @@ -8,6 +8,7 @@ #' @param tmax Integer. The number of time points in each simulated trajectory. Default 150. #' @param n_draws Integer. The number of trajectories to simulate. Default 2000. #' @param data Optional data.frame with columns t_since_last_exp and value. The raw data to compare to. +#' @importFrom ggplot2 ggplot aes geom_point geom_ribbon geom_line plot_prior_predictive <- function(priors, tmax = 150, n_draws = 2000, @@ -31,11 +32,9 @@ plot_prior_predictive <- function(priors, params_and_times[, mu := biokinetics_simulate_trajectory(t, t0, tp, ts, m1, m2, m3), by = c("t", "t0", "tp", "ts", "m1", "m2", "m3")] - summary <- params_and_times %>% - group_by(t) %>% - summarise(me = quantile(mu, 0.5, names = FALSE), - lo = quantile(mu, 0.025, names = FALSE), - hi = quantile(mu, 0.975, names = FALSE)) + summary <- params_and_times[, .(me = stats::quantile(mu, 0.5, names = FALSE), + lo = stats::quantile(mu, 0.025, names = FALSE), + hi = stats::quantile(mu, 0.975, names = FALSE)), by = t] plot <- ggplot(summary) + geom_line(aes(x = t, y = me)) + @@ -46,3 +45,13 @@ plot_prior_predictive <- function(priors, } plot } + +#' @importFrom ggplot2 ggplot aes facet_wrap geom_point geom_smooth guides guide_legend +plot_data <- function(data) { + validate_required_cols(data, c("t_since_last_exp", "value", "titre_type")) + ggplot(data) + + geom_point(aes(x = t_since_last_exp, y = value, colour = titre_type)) + + geom_smooth(aes(x = t_since_last_exp, y = value, colour = titre_type)) + + facet_wrap(~titre_type) + + guides(colour = guide_legend(title = "Titre type")) +} diff --git a/tests/testthat/_snaps/plots/inputdata.svg b/tests/testthat/_snaps/plots/inputdata.svg new file mode 100644 index 0000000..c0b05fd --- /dev/null +++ b/tests/testthat/_snaps/plots/inputdata.svg @@ -0,0 +1,2408 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Alpha + + + + + + + + + + +Ancestral + + + + + + + + + + +Delta + + + + + + +0 +200 +400 +600 + + + + +0 +200 +400 +600 + + + + +0 +200 +400 +600 +0 +3 +6 +9 + + + + +t_since_last_exp +value + +Titre type + + + + + + + + + + + + +Alpha +Ancestral +Delta +inputdata + + diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index 3db51f8..d01a8e1 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -39,3 +39,11 @@ test_that("Prior predictions from model are the same", { plot <- mod$plot_prior_predictive(tmax = 400, n_draws = 500) vdiffr::expect_doppelganger("priorpredictive", plot) }) + +test_that("Plotted data is are the same", { + skip_on_ci() + data <- data.table::fread(system.file("delta_full.rds", package = "epikinetics")) + mod <- biokinetics$new(data = data) + plot <- mod$plot_data() + vdiffr::expect_doppelganger("inputdata", plot) +})