From 2398227385b79502a80ef08083c707f18a042ee6 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Mon, 18 Nov 2024 11:52:23 +0000 Subject: [PATCH] add number of points to plot --- R/plot.R | 26 +- .../plots/individualtrajectories-unsum.svg | 2489 ++++++++++------- .../_snaps/plots/individualtrajectories.svg | 92 +- tests/testthat/test-plots.R | 10 +- 4 files changed, 1512 insertions(+), 1105 deletions(-) diff --git a/R/plot.R b/R/plot.R index 86fb7be..3c9269f 100644 --- a/R/plot.R +++ b/R/plot.R @@ -153,22 +153,30 @@ plot.biokinetics_individual_trajectories <- function(x, ..., data = NULL, geom_ribbon(aes(x = calendar_day, ymin = lo, ymax = hi, - group = titre_type), alpha = 0.5) + - geom_smooth( - aes(x = calendar_day, - y = me, - fill = titre_type, - colour = titre_type, - group = titre_type), - alpha = 0.5, span = 0.2) + group = titre_type), alpha = 0.5) } else { x <- x[ !is.nan(mu), .(ind_mu_sum = mean(mu)), by = c("calendar_day", "pid", "titre_type")] + count <- x[, .(count = data.table::uniqueN(pid)), by = .(calendar_day)] plot <- ggplot(x) + geom_line(aes(x = calendar_day, y = ind_mu_sum, colour = titre_type, group = interaction(titre_type, pid)), - alpha = 0.5, linewidth = 0.1) + alpha = 0.5, linewidth = 0.1) + + geom_smooth( + aes(x = calendar_day, + y = ind_mu_sum, + fill = titre_type, + colour = titre_type, + group = titre_type), + alpha = 0.5, span = 0.2) + + scale_y_continuous(sec.axis = sec_axis(~., name = "Number of data points")) + + geom_bar(data = count, aes(x = calendar_day, y = count), + stat = "identity", alpha = 0.6) + + theme(axis.ticks.y.right = element_line(alpha = 0.6), + axis.text.y.right = element_text(alpha = 0.6), + axis.title.y.right = element_text(alpha = 0.6) + ) } if (!is.null(data)) { validate_required_cols(data, c("day", "value")) diff --git a/tests/testthat/_snaps/plots/individualtrajectories-unsum.svg b/tests/testthat/_snaps/plots/individualtrajectories-unsum.svg index a4572c0..19b452f 100644 --- a/tests/testthat/_snaps/plots/individualtrajectories-unsum.svg +++ b/tests/testthat/_snaps/plots/individualtrajectories-unsum.svg @@ -21,1051 +21,1464 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -0 -500 -1000 -1500 - - - - - - - - -Jan 2021 -Jul 2021 -Jan 2022 -Jul 2022 -Date +0 +500 +1000 +1500 + + + + + + + + +0 +500 +1000 +1500 + + + + + +Jan 2021 +Apr 2021 +Jul 2021 +Oct 2021 +Jan 2022 +Date Titre (IC 50 ) - -Titre type - - - - - - -Alpha -Ancestral -Delta +Number of individuals in study + +Titre type + + + + + + + + + + + + +Alpha +Ancestral +Delta individualtrajectories-unsum diff --git a/tests/testthat/_snaps/plots/individualtrajectories.svg b/tests/testthat/_snaps/plots/individualtrajectories.svg index 2b3a4c2..e334b59 100644 --- a/tests/testthat/_snaps/plots/individualtrajectories.svg +++ b/tests/testthat/_snaps/plots/individualtrajectories.svg @@ -18,59 +18,49 @@ - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + -0 -300 -600 -900 - - - - - - - - -Jan 2021 -Jul 2021 -Jan 2022 -Jul 2022 -Date +0 +500 +1000 +1500 + + + + + + + + + +Jan 2021 +Apr 2021 +Jul 2021 +Oct 2021 +Jan 2022 +Date Titre (IC 50 ) @@ -78,19 +68,13 @@ Titre type - - - - - - Alpha Ancestral Delta -individualtrajectories +individualtrajectories diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index aec0fdc..01a2b73 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -139,8 +139,9 @@ test_that("Can plot summarised individual trajectories", { summarise = TRUE) # because these fits are so bad there are some v high upper values, so just # create these articially - trajectories[, hi := me + 100] - vdiffr::expect_doppelganger("individualtrajectories", plot(trajectories)) + trajectories[, hi:= ifelse(hi > 2000, me + 100, hi)] + vdiffr::expect_doppelganger("individualtrajectories", plot(trajectories, + max_date = lubridate::ymd("2022/01/01"))) }) test_that("Can plot un-summarised individual trajectories", { @@ -154,9 +155,10 @@ test_that("Can plot un-summarised individual trajectories", { trajectories <- mod$simulate_individual_trajectories(n_draws = 250, summarise = FALSE) # because these fits are so bad there are some v high upper values, so just - # trunbcate these + # truncate these trajectories[, mu:= ifelse(mu > 2000, 2000, mu)] - vdiffr::expect_doppelganger("individualtrajectories-unsum", plot(trajectories)) + vdiffr::expect_doppelganger("individualtrajectories-unsum", plot(trajectories, + max_date = lubridate::ymd("2022/01/01"))) }) test_that("Can plot stationary points", {