From 5cb8f7d430d74f5b612ba5538b001a276e04e626 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Mon, 14 Aug 2023 10:43:22 -0500 Subject: [PATCH 01/13] remove serodata .Rdata and .Rd files --- data/serodata.RData | Bin 635 -> 0 bytes man/serodata.Rd | 19 ------------------- 2 files changed, 19 deletions(-) delete mode 100644 data/serodata.RData delete mode 100644 man/serodata.Rd diff --git a/data/serodata.RData b/data/serodata.RData deleted file mode 100644 index f9570b146995e2ae0a1800ce4ef91888b560bfc6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 635 zcmV->0)+h^iwFP!000001MQjHZW2)xhPMTDAkj>s7hZTl8q*jf1jTCWsY5xmw6v7A zCcQHw9UGFCF*AdTSGoqJpB&@=VDiFl#j?UX9j<!o;Vo^f#=QDGk`cKs2b>$+_J%g&oNe_A|Er@eo4S&Xyh;rVI(Xx>>q-I~H%svlHOD&S*~>Jil)sxwsYo`F;sss2%& zdjY-#sUA{YeFLt67I6}h>MYe`s>AEhb?7>D1G)j-gl*aT**EHClO^IMVxaV zS>HZJzEC&^Rr2?TjQ$2LO=(J#n#uE#Yj)ZPH4!32TuqTYuV(vXqi7F2&&?KSTf2_UReOEQEiC Vmp^#AzgEA(`!{Jx*zr#v001@qL=XS~ diff --git a/man/serodata.Rd b/man/serodata.Rd deleted file mode 100644 index a0644814..00000000 --- a/man/serodata.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/serodata.R -\docType{data} -\name{serodata} -\alias{serodata} -\title{Seroprevalence data on serofoi} -\format{ -An object of class \code{"cross"}; see \code{\link[qtl]{read.cross}}. -} -\usage{ -serodata -} -\description{ -Data from a serological surveys -} -\examples{ -serodata -} -\keyword{datasets} From 37c4c456c2def9e27c6d5d06fe8c581e6d5e9c21 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Mon, 14 Aug 2023 10:43:49 -0500 Subject: [PATCH 02/13] remove R/serodata.R --- R/serodata.R | 15 --------------- 1 file changed, 15 deletions(-) delete mode 100644 R/serodata.R diff --git a/R/serodata.R b/R/serodata.R deleted file mode 100644 index 1404ed4f..00000000 --- a/R/serodata.R +++ /dev/null @@ -1,15 +0,0 @@ -#' Seroprevalence data on serofoi -#' -#' Data from a serological surveys -#' -#' @docType data -#' -#' @usage serodata -#' -#' @format An object of class \code{"cross"}; see \code{\link[qtl]{read.cross}}. -#' -#' @keywords datasets -#' -#' @examples -#' serodata -"serodata" \ No newline at end of file From 7f9f70b807d291b7aab03ae1c464324d291dc232 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Mon, 14 Aug 2023 10:54:02 -0500 Subject: [PATCH 03/13] doc: update functions documentation replacing for in examples --- R/model_comparison.R | 8 ++--- R/modelling.R | 25 +++++++-------- R/seroprevalence_data.R | 7 +++-- R/visualisation.R | 53 +++++++++++++++++--------------- man/extract_seromodel_summary.Rd | 4 +-- man/fit_seromodel.Rd | 4 +-- man/get_exposure_ages.Rd | 4 +-- man/get_exposure_matrix.Rd | 4 +-- man/get_prev_expanded.Rd | 3 +- man/get_table_rhats.Rd | 8 ++--- man/plot_foi.Rd | 9 +++--- man/plot_info_table.Rd | 10 +++--- man/plot_rhats.Rd | 10 +++--- man/plot_seromodel.Rd | 13 ++++---- man/plot_seroprev.Rd | 5 +-- man/plot_seroprev_fitted.Rd | 6 ++-- man/prepare_bin_data.Rd | 3 +- man/prepare_serodata.Rd | 4 +-- man/run_seromodel.Rd | 6 ++-- 19 files changed, 98 insertions(+), 88 deletions(-) diff --git a/R/model_comparison.R b/R/model_comparison.R index 3c6dd0ff..c2bb29c9 100644 --- a/R/model_comparison.R +++ b/R/model_comparison.R @@ -6,10 +6,10 @@ #' @return rhats table #' @examples #' \dontrun{ -#' data("serodata") -#' data_test <- prepare_serodata(serodata = serodata) -#' model_constant <- run_seromodel(serodata = data_test, -#' foi_model = "constant", +#' data(chagas2012) +#' data_test <- prepare_serodata(serodata = chagas2012) +#' model_constant <- run_seromodel(serodata = data_test, +#' foi_model = "constant", #' n_iters = 1500) #' get_table_rhats(model_object = model_constant) #' } diff --git a/R/modelling.R b/R/modelling.R index 8558f109..1da29f19 100644 --- a/R/modelling.R +++ b/R/modelling.R @@ -43,9 +43,9 @@ #' @return \code{seromodel_object}. An object containing relevant information about the implementation of the model. For further details refer to \link{fit_seromodel}. #' @examples #' \dontrun{ -#' serodata <- prepare_serodata(serodata) -#' run_seromodel (serodata, -#' foi_model = "constant") +#' serodata <- prepare_serodata(chagas2012) +#' run_seromodel (chagas2012, +#' foi_model = "constant") #' } #' @export run_seromodel <- function(serodata, @@ -114,8 +114,8 @@ run_seromodel <- function(serodata, #' @examples #' \dontrun{ -#' data("serodata") -#' serodata <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_fit <- fit_seromodel(serodata = serodata, #' foi_model = "constant") #' } @@ -255,8 +255,8 @@ fit_seromodel <- function(serodata, #' @return \code{exposure_ages}. An atomic vector with the numeration of the exposition years in serodata #' @examples #' \dontrun{ -#' data("serodata") -#' serodata <- prepare_serodata(serodata = serodata, alpha = 0.05) +#' data(chagas2012) +#' serodata <- prepare_serodata(serodata = chagas2012, alpha = 0.05) #' exposure_ages <- get_exposure_ages(serodata) #' } #' @export @@ -271,8 +271,8 @@ get_exposure_ages <- function(serodata) { #' @return \code{exposure_output}. An atomic matrix containing the expositions for each entry of \code{serodata} by year. #' @examples #' \dontrun{ -#' data("serodata") -#' serodata <- prepare_serodata(serodata = serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(serodata = chagas2012) #' exposure_matrix <- get_exposure_matrix(serodata = serodata) #' } #' @export @@ -313,8 +313,8 @@ get_exposure_matrix <- function(serodata) { #' } #' @examples #' \dontrun{ -#' data("serodata") -#' serodata <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel(serodata = serodata, #' foi_model = "constant") #' extract_seromodel_summary(seromodel_object) @@ -366,7 +366,8 @@ extract_seromodel_summary <- function(seromodel_object) { #' @return \code{prev_final}. The expanded prevalence data. This is used for plotting purposes in the \code{visualization} module. #' @examples #' \dontrun{ -#' serodata <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel(serodata = serodata, #' foi_model = "constant") #' foi <- rstan::extract(seromodel_object$fit, "foi")[[1]] diff --git a/R/seroprevalence_data.R b/R/seroprevalence_data.R index f4168cfe..8c466f26 100644 --- a/R/seroprevalence_data.R +++ b/R/seroprevalence_data.R @@ -30,8 +30,8 @@ #' } #' @examples #'\dontrun{ -#' data("serodata") -#' data_test <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' } #' @export prepare_serodata <- function(serodata = serodata, @@ -91,7 +91,8 @@ prepare_serodata <- function(serodata = serodata, #' @return data set with the binomial confidence intervals #' @examples #'\dontrun{ -#' prepare_bin_data (serodata) +#' data(chagas2012) +#' prepare_bin_data(chagas2012) #' } #' @export prepare_bin_data <- function(serodata) { diff --git a/R/visualisation.R b/R/visualisation.R index 26f7fd81..775b06eb 100644 --- a/R/visualisation.R +++ b/R/visualisation.R @@ -17,9 +17,10 @@ #' @return A ggplot object containing the seropositivity-vs-age graph of the raw data of a given seroprevalence survey with its corresponging binomial confidence interval. #' @examples #' \dontrun{ -#' data_test <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel( -#' serodata = data_test, +#' serodata = serodata, #' foi_model = "constant", #' n_iters = 1000 #') @@ -52,9 +53,9 @@ plot_seroprev <- function(serodata, #' @return A ggplot object containing the seropositivity-vs-age graph including the data, the fitted model and their corresponding confindence intervals. #' @examples #' \dontrun{ -#' data("serodata") -#' data_test <- prepare_serodata(serodata) -#' seromodel_object <- run_seromodel(serodata = data_test, +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) +#' seromodel_object <- run_seromodel(serodata = serodata, #' foi_model = "constant", #' n_iters = 1000) #' plot_seroprev_fitted(seromodel_object, size_text = 15) @@ -133,12 +134,13 @@ plot_seroprev_fitted <- function(seromodel_object, #' @return A ggplot2 object containing the Force-of-infection-vs-time including the corresponding confidence interval. #' @examples #' \dontrun{ -#' data_test <- prepare_serodata(serodata) -#' seromodel_object <- run_seromodel( -#' serodata = data_test, +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) +#' seromodel_object <- run_seromodel( +#' serodata = serodata, #' foi_model = "constant", #' n_iters = 1000 -#' ) +#' ) #' plot_foi(seromodel_object, size_text = 15) #' } #' @export @@ -228,14 +230,14 @@ plot_foi <- function(seromodel_object, #' @return The rhats-convergence plot of the selected model. #' @examples #' \dontrun{ -#' data("serodata") -#' data_test <- prepare_serodata(serodata) +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel( -#' serodata = data_test, +#' serodata = serodata, #' foi_model = "constant", #' n_iters = 1000 -#') -#' plot_rhats(seromodel_object, +#' ) +#' plot_rhats(seromodel_object, #' size_text = 15) #' } #' @export @@ -294,12 +296,13 @@ plot_rhats <- function(seromodel_object, #' @return A ggplot object with a vertical arrange containing the seropositivity, force of infection, and convergence plots. #' @examples #' \dontrun{ -#' data_test <- prepare_serodata(serodata) -#' seromodel_object <- run_seromodel( -#' serodata = data_test, -#' foi_model = "constant", -#' n_iters = 1000 -#') +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) +#' seromodel_object <- run_seromodel( +#' serodata = serodata, +#' foi_model = "constant", +#' n_iters = 1000 +#' ) #' plot_seromodel(seromodel_object, size_text = 15) #' } #' @export @@ -378,12 +381,12 @@ plot_seromodel <- function(seromodel_object, #' @return p the plot for the given table #' @examples #' \dontrun{ -#' data_test <- prepare_serodata(serodata) +#' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel( -#' serodata = data_test, -#' foi_model = "constant", -#' n_iters = 1000 -#') +#' serodata = serodata, +#' foi_model = "constant", +#' n_iters = 1000 +#' ) #' info = t(seromodel_object$model_summary) #' plot_info_table (info, size_text = 15) #' } diff --git a/man/extract_seromodel_summary.Rd b/man/extract_seromodel_summary.Rd index cd037799..106b1ca7 100644 --- a/man/extract_seromodel_summary.Rd +++ b/man/extract_seromodel_summary.Rd @@ -35,8 +35,8 @@ corresponding standar deviation. } \examples{ \dontrun{ -data("serodata") -serodata <- prepare_serodata(serodata) +data(chagas2012) +serodata <- prepare_serodata(chagas2012) seromodel_object <- run_seromodel(serodata = serodata, foi_model = "constant") extract_seromodel_summary(seromodel_object) diff --git a/man/fit_seromodel.Rd b/man/fit_seromodel.Rd index 67908578..30770ff1 100644 --- a/man/fit_seromodel.Rd +++ b/man/fit_seromodel.Rd @@ -64,8 +64,8 @@ object needs to be compiled by rstan. } \examples{ \dontrun{ -data("serodata") -serodata <- prepare_serodata(serodata) +data(chagas2012) +serodata <- prepare_serodata(chagas2012) seromodel_fit <- fit_seromodel(serodata = serodata, foi_model = "constant") } diff --git a/man/get_exposure_ages.Rd b/man/get_exposure_ages.Rd index aec51f06..3a1e2ca1 100644 --- a/man/get_exposure_ages.Rd +++ b/man/get_exposure_ages.Rd @@ -18,8 +18,8 @@ The exposition years to the disease for each individual corresponds to the time } \examples{ \dontrun{ -data("serodata") -serodata <- prepare_serodata(serodata = serodata, alpha = 0.05) +data(chagas2012) +serodata <- prepare_serodata(serodata = chagas2012, alpha = 0.05) exposure_ages <- get_exposure_ages(serodata) } } diff --git a/man/get_exposure_matrix.Rd b/man/get_exposure_matrix.Rd index 8b4f1abf..b92816f5 100644 --- a/man/get_exposure_matrix.Rd +++ b/man/get_exposure_matrix.Rd @@ -17,8 +17,8 @@ Function that generates the exposure matrix corresponding to a serological surve } \examples{ \dontrun{ -data("serodata") -serodata <- prepare_serodata(serodata = serodata) +data(chagas2012) +serodata <- prepare_serodata(serodata = chagas2012) exposure_matrix <- get_exposure_matrix(serodata = serodata) } } diff --git a/man/get_prev_expanded.Rd b/man/get_prev_expanded.Rd index a95f4899..2138efa4 100644 --- a/man/get_prev_expanded.Rd +++ b/man/get_prev_expanded.Rd @@ -23,7 +23,8 @@ of the Force-of-Infection \code{foi} for plotting an analysis purposes. } \examples{ \dontrun{ -serodata <- prepare_serodata(serodata) +data(chagas2012) +serodata <- prepare_serodata(chagas2012) seromodel_object <- run_seromodel(serodata = serodata, foi_model = "constant") foi <- rstan::extract(seromodel_object$fit, "foi")[[1]] diff --git a/man/get_table_rhats.Rd b/man/get_table_rhats.Rd index 4aac86a0..7fb2f4b8 100644 --- a/man/get_table_rhats.Rd +++ b/man/get_table_rhats.Rd @@ -18,10 +18,10 @@ This method relies in the function \link[bayesplot]{rhat} to extract the R-hat e } \examples{ \dontrun{ -data("serodata") -data_test <- prepare_serodata(serodata = serodata) -model_constant <- run_seromodel(serodata = data_test, - foi_model = "constant", +data(chagas2012) +data_test <- prepare_serodata(serodata = chagas2012) +model_constant <- run_seromodel(serodata = data_test, + foi_model = "constant", n_iters = 1500) get_table_rhats(model_object = model_constant) } diff --git a/man/plot_foi.Rd b/man/plot_foi.Rd index 6e376c70..f9f3a061 100644 --- a/man/plot_foi.Rd +++ b/man/plot_foi.Rd @@ -25,12 +25,13 @@ The x axis corresponds to the decades covered by the survey the y axis to the Fo } \examples{ \dontrun{ - data_test <- prepare_serodata(serodata) - seromodel_object <- run_seromodel( - serodata = data_test, + data(chagas2012) + serodata <- prepare_serodata(chagas2012) + seromodel_object <- run_seromodel( + serodata = serodata, foi_model = "constant", n_iters = 1000 -) + ) plot_foi(seromodel_object, size_text = 15) } } diff --git a/man/plot_info_table.Rd b/man/plot_info_table.Rd index 72ddc003..1ec2cd73 100644 --- a/man/plot_info_table.Rd +++ b/man/plot_info_table.Rd @@ -19,12 +19,12 @@ Function that generates a plot for a given table } \examples{ \dontrun{ - data_test <- prepare_serodata(serodata) + serodata <- prepare_serodata(chagas2012) seromodel_object <- run_seromodel( - serodata = data_test, - foi_model = "constant", - n_iters = 1000 -) + serodata = serodata, + foi_model = "constant", + n_iters = 1000 + ) info = t(seromodel_object$model_summary) plot_info_table (info, size_text = 15) } diff --git a/man/plot_rhats.Rd b/man/plot_rhats.Rd index 02b73f00..b1d42253 100644 --- a/man/plot_rhats.Rd +++ b/man/plot_rhats.Rd @@ -21,14 +21,14 @@ All rhats must be smaller than 1 to ensure convergence (for further details chec } \examples{ \dontrun{ -data("serodata") -data_test <- prepare_serodata(serodata) +data(chagas2012) +serodata <- prepare_serodata(chagas2012) seromodel_object <- run_seromodel( - serodata = data_test, + serodata = serodata, foi_model = "constant", n_iters = 1000 -) -plot_rhats(seromodel_object, + ) +plot_rhats(seromodel_object, size_text = 15) } } diff --git a/man/plot_seromodel.Rd b/man/plot_seromodel.Rd index 6a36f736..2a2964bd 100644 --- a/man/plot_seromodel.Rd +++ b/man/plot_seromodel.Rd @@ -30,12 +30,13 @@ the Force-of-Infection fit and the R-hat estimates plots. } \examples{ \dontrun{ -data_test <- prepare_serodata(serodata) -seromodel_object <- run_seromodel( - serodata = data_test, - foi_model = "constant", - n_iters = 1000 -) + data(chagas2012) + serodata <- prepare_serodata(chagas2012) + seromodel_object <- run_seromodel( + serodata = serodata, + foi_model = "constant", + n_iters = 1000 + ) plot_seromodel(seromodel_object, size_text = 15) } } diff --git a/man/plot_seroprev.Rd b/man/plot_seroprev.Rd index 8948decb..f61698e8 100644 --- a/man/plot_seroprev.Rd +++ b/man/plot_seroprev.Rd @@ -31,9 +31,10 @@ Function that generates the sero-positivity plot from a raw serological survey d } \examples{ \dontrun{ - data_test <- prepare_serodata(serodata) + data(chagas2012) + serodata <- prepare_serodata(chagas2012) seromodel_object <- run_seromodel( - serodata = data_test, + serodata = serodata, foi_model = "constant", n_iters = 1000 ) diff --git a/man/plot_seroprev_fitted.Rd b/man/plot_seroprev_fitted.Rd index 18740584..a7663518 100644 --- a/man/plot_seroprev_fitted.Rd +++ b/man/plot_seroprev_fitted.Rd @@ -21,9 +21,9 @@ corresponding confidence interval. } \examples{ \dontrun{ -data("serodata") -data_test <- prepare_serodata(serodata) -seromodel_object <- run_seromodel(serodata = data_test, +data(chagas2012) +serodata <- prepare_serodata(chagas2012) +seromodel_object <- run_seromodel(serodata = serodata, foi_model = "constant", n_iters = 1000) plot_seroprev_fitted(seromodel_object, size_text = 15) diff --git a/man/prepare_bin_data.Rd b/man/prepare_bin_data.Rd index a2d767a4..bcb324e8 100644 --- a/man/prepare_bin_data.Rd +++ b/man/prepare_bin_data.Rd @@ -38,6 +38,7 @@ of its corresponding seroprevalence grouped by age group. } \examples{ \dontrun{ -prepare_bin_data (serodata) +data(chagas2012) +prepare_bin_data(chagas2012) } } diff --git a/man/prepare_serodata.Rd b/man/prepare_serodata.Rd index 33b4a1de..273e7b32 100644 --- a/man/prepare_serodata.Rd +++ b/man/prepare_serodata.Rd @@ -41,7 +41,7 @@ This function adds the necessary additional variables to the given dataset \code } \examples{ \dontrun{ -data("serodata") -data_test <- prepare_serodata(serodata) +data(chagas2012) +serodata <- prepare_serodata(chagas2012) } } diff --git a/man/run_seromodel.Rd b/man/run_seromodel.Rd index becb135a..a8432187 100644 --- a/man/run_seromodel.Rd +++ b/man/run_seromodel.Rd @@ -67,8 +67,8 @@ This function runs the specified model for the Force-of-Infection \code{foi_mode } \examples{ \dontrun{ -serodata <- prepare_serodata(serodata) -run_seromodel (serodata, - foi_model = "constant") +serodata <- prepare_serodata(chagas2012) +run_seromodel (chagas2012, + foi_model = "constant") } } From 5e9fa31d12afc1e724c6f53ee5309a6d3a8bbad7 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Mon, 14 Aug 2023 11:08:41 -0500 Subject: [PATCH 04/13] doc: update README and vignettes This commit changes the removed preloaded dataset `serodata` for the identical `chagas2012`. --- README.Rmd | 12 +++++------- README.md | 16 ++++++++-------- vignettes/foi_models.Rmd | 2 -- vignettes/serofoi.Rmd | 4 ++-- 4 files changed, 15 insertions(+), 19 deletions(-) diff --git a/README.Rmd b/README.Rmd index e15802fb..65fc44b1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -15,7 +15,7 @@ knitr::opts_chunk$set( ) ``` -## *serofoi*: force-of-infection from population based serosurveys with age-disagregated data +## *serofoi*: force-of-infection from population based serosurveys with age-disagregated data @@ -47,22 +47,20 @@ remotes::install_github("epiverse-trace/serofoi") ```{r cleaning, include = FALSE, echo = TRUE} library(serofoi) -rownames(serodata) <- NULL - ``` ***serofoi*** provides a minimal serosurvey dataset, `serodata`, that can be used to test out the package. ```{r ex, include = TRUE} -# Load example serodata data included with the package -data("serodata") -head(serodata, 5) +# Load example dataset chagas2012 included with the package +data(chagas2012) +head(chagas2012, 5) ``` The function `prepare_serodata` will prepare the entry data for the use of the modelling module; this function computes the sample size, the years of birth and the binomial confidence interval for each age group in the provided dataset. A visualisation of the prepared seroprevalence data can be obtained using the function plot_seroprev: ```{r data_test, include = TRUE, out.fig.height="30%", out.width="50%", fig.align="center", message=FALSE} -serodata_test <- prepare_serodata(serodata) +serodata_test <- prepare_serodata(chagas2012) plot_seroprev(serodata_test, size_text = 15) ``` diff --git a/README.md b/README.md index 5eef2793..0b6a0862 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -## *serofoi*: force-of-infection from population based serosurveys with age-disagregated data +## *serofoi*: force-of-infection from population based serosurveys with age-disagregated data @@ -48,9 +48,9 @@ remotes::install_github("epiverse-trace/serofoi") can be used to test out the package. ``` r -# Load example serodata data included with the package -data("serodata") -head(serodata, 5) +# Load example dataset chagas2012 included with the package +data(chagas2012) +head(chagas2012, 5) #> survey total counts age_min age_max tsur country test antibody #> 1 COL-035-93 34 0 1 1 2012 COL ELISA IgG anti-T.cruzi #> 2 COL-035-93 25 0 2 2 2012 COL ELISA IgG anti-T.cruzi @@ -66,7 +66,7 @@ in the provided dataset. A visualisation of the prepared seroprevalence data can be obtained using the function plot_seroprev: ``` r -serodata_test <- prepare_serodata(serodata) +serodata_test <- prepare_serodata(chagas2012) plot_seroprev(serodata_test, size_text = 15) ``` @@ -97,10 +97,10 @@ More details on how to use ***serofoi*** can be found in the [online documentation](https://epiverse-trace.github.io/serofoi/) as package vignettes, under [**Get Started**](https://epiverse-trace.github.io/serofoi/articles/serofoi.html), -[**FoI +[**An Introduction to FoI Models**](https://epiverse-trace.github.io/serofoi/articles/foi_models.html) -and [**Use -Cases**](https://epiverse-trace.github.io/serofoi/articles/use_cases.html) +and [**Real-life Use Cases for +serofoi**](https://epiverse-trace.github.io/serofoi/articles/use_cases.html) ## Help diff --git a/vignettes/foi_models.Rmd b/vignettes/foi_models.Rmd index 2c53d6a9..e8c9a2f1 100644 --- a/vignettes/foi_models.Rmd +++ b/vignettes/foi_models.Rmd @@ -18,8 +18,6 @@ knitr::opts_chunk$set( ```{r cleaning, include = FALSE, echo = TRUE} library(serofoi) -rownames(serodata) <- NULL - ``` The current version of ***serofoi*** supports three different models for estimating the *Force-of-Infection (FoI)*, including constant and time-varying trajectories. For fitting the model to the sero-prevalence data we use a suit of bayesian models that include prior and upper prior distributions diff --git a/vignettes/serofoi.Rmd b/vignettes/serofoi.Rmd index 082e86ef..3fe42205 100644 --- a/vignettes/serofoi.Rmd +++ b/vignettes/serofoi.Rmd @@ -60,8 +60,8 @@ The integrated dataset `serodata_test` provides a minimal example of the input o ```{r model_constant, include = TRUE, echo = TRUE, results="hide", errors = FALSE, warning = FALSE, message = FALSE, fig.width=4, fig.asp=1.5, fig.align="center"} library(serofoi) # Loading and preparing data for modelling -data("serodata") -serodata_test <- prepare_serodata(serodata) +data(chagas2012) +serodata_test <- prepare_serodata(chagas2012) # Model implementation model_constant <- run_seromodel(serodata = serodata_test, foi_model = "constant") From 7465583c0d3b0c1f72792870113ce308962db977 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Mon, 14 Aug 2023 12:07:30 -0500 Subject: [PATCH 05/13] fix: minor correction to test_modelling --- tests/testthat/test_modelling.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test_modelling.R b/tests/testthat/test_modelling.R index 76494b19..edea5876 100644 --- a/tests/testthat/test_modelling.R +++ b/tests/testthat/test_modelling.R @@ -7,12 +7,11 @@ test_that("individual models", { set.seed(1234) # For reproducibility library(devtools) - library(dplyr) library(vdiffr) #----- Read and prepare data - data("serodata") - data_test <- serodata %>% prepare_serodata(alpha = 0.05) + data(chagas2012) + serodata <- prepare_serodata(chagas2012, alpha = 0.05) data_constant_path <- testthat::test_path("extdata", "prev_expanded_constant.RDS") data_tv_normal_path <- testthat::test_path("extdata", "prev_expanded_tv_normal.RDS") @@ -23,7 +22,7 @@ test_that("individual models", { #----- Test for the constant model model_name <- "constant" - model_object <- run_seromodel(serodata = data_test, + model_object <- run_seromodel(serodata = serodata, foi_model = model_name, n_iters = 1000, print_summary = FALSE) @@ -37,7 +36,7 @@ test_that("individual models", { #----- Test for the tv_normal model model_name <- "tv_normal" - model_object <- run_seromodel(serodata = data_test, + model_object <- run_seromodel(serodata = serodata, foi_model = model_name, n_iters = 1000) @@ -49,7 +48,7 @@ test_that("individual models", { #----- Test for the tv_normal_log model model_name <- "tv_normal_log" - model_object <- run_seromodel(serodata = data_test, + model_object <- run_seromodel(serodata = serodata, foi_model = model_name, n_iters = 1000) From 052c90ce33779ba34b3a8873d0067dd598d2d7ee Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 09:05:57 -0500 Subject: [PATCH 06/13] feat: add function `get_foi_central_estimates()` to the modelling module. This change is meant to simplify `fit_seromodel()`. This commit also changes the name of the stanfit object in the output of `fit_seromodel()` from `fit` to `seromodel_fit`. --- NAMESPACE | 1 + R/modelling.R | 85 +++++++++++++++++++++++++---------------------- R/visualisation.R | 22 ++++++------ 3 files changed, 58 insertions(+), 50 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f5ffc57b..13150198 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(extract_seromodel_summary) export(fit_seromodel) export(get_exposure_ages) export(get_exposure_matrix) +export(get_foi_central_estimates) export(get_prev_expanded) export(get_table_rhats) export(plot_foi) diff --git a/R/modelling.R b/R/modelling.R index 1da29f19..d3d3f129 100644 --- a/R/modelling.R +++ b/R/modelling.R @@ -146,27 +146,18 @@ fit_seromodel <- function(serodata, ) n_warmup <- floor(n_iters / 2) - if (foi_model == "tv_normal_log") { f_init <- function() { list(log_foi = rep(-3, length(exposure_ages))) - } - lower_quantile = 0.1 - upper_quantile = 0.9 - medianv_quantile = 0.5 } - + } else { f_init <- function() { list(foi = rep(0.01, length(exposure_ages))) } - lower_quantile = 0.05 - upper_quantile = 0.95 - medianv_quantile = 0.5 - } - fit <- rstan::sampling( + seromodel_fit <- rstan::sampling( model, data = stan_data, iter = n_iters, @@ -182,32 +173,9 @@ fit_seromodel <- function(serodata, chain_id = 0 # https://github.com/stan-dev/rstan/issues/761#issuecomment-647029649 ) - if (class(fit@sim$samples) != "NULL") { - loo_fit <- loo::loo(fit, save_psis = TRUE, "logLikelihood") - foi <- rstan::extract(fit, "foi", inc_warmup = FALSE)[[1]] - # foi <- rstan::extract(fit, "foi", inc_warmup = TRUE, permuted=FALSE)[[1]] - # generates central estimations - foi_cent_est <- data.frame( - year = exposure_years, - lower = apply(foi, 2, function(x) quantile(x, lower_quantile)), - - upper = apply(foi, 2, function(x) quantile(x, upper_quantile)), - - medianv = apply(foi, 2, function(x) quantile(x, medianv_quantile)) - ) - - - # generates a sample of iterations - if (n_iters >= 2000) { - foi_post_s <- dplyr::sample_n(as.data.frame(foi), size = 1000) - colnames(foi_post_s) <- exposure_years - } else { - foi_post_s <- as.data.frame(foi) - colnames(foi_post_s) <- exposure_years - } - + if (class(seromodel_fit@sim$samples) != "NULL") { seromodel_object <- list( - fit = fit, + seromodel_fit = seromodel_fit, serodata = serodata, stan_data = stan_data, exposure_years = exposure_years, @@ -225,9 +193,8 @@ fit_seromodel <- function(serodata, seromodel_object$model_summary <- extract_seromodel_summary(seromodel_object) } else { - loo_fit <- c(-1e10, 0) seromodel_object <- list( - fit = "no model", + seromodel_fit = "no model", serodata = serodata, stan_data = stan_data, exposure_years = exposure_years, @@ -287,6 +254,46 @@ get_exposure_matrix <- function(serodata) { return(exposure_output) } +#' Function that generates the central estimates for the fitted forced FoI +#' +#' @param seromodel_object Object containing the results of fitting a model by means of \link{run_seromodel}. +#' generated by means of \link{get_exposure_ages}. +#' @return \code{foi_central_estimates}. Central estimates for the fitted forced FoI +#' @examples +#' \dontrun{ +#' data(chagas2012) +#' serodata <- prepare_serodata(chagas2012) +#' seromodel_object <- fit_seromodel(serodata = serodata, +#' foi_model = "constant") +#' foi_central_estimates <- get_foi_central_estimates(seromodel_object) +#' } +#' +#' @export +get_foi_central_estimates <- function(seromodel_object) { + + if (seromodel_object$seromodel_fit@model_name == "tv_normal_log") { + lower_quantile = 0.1 + upper_quantile = 0.9 + medianv_quantile = 0.5 + } + else { + lower_quantile = 0.05 + upper_quantile = 0.95 + medianv_quantile = 0.5 + } + # extracts foi from stan fit + foi <- rstan::extract(seromodel_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] + # generates central estimations + foi_central_estimates <- data.frame( + year = seromodel_object$exposure_years, + lower = apply(foi, 2, function(x) quantile(x, lower_quantile)), + + upper = apply(foi, 2, function(x) quantile(x, upper_quantile)), + + medianv = apply(foi, 2, function(x) quantile(x, medianv_quantile)) + ) + return(foi_central_estimates) +} #' Method to extact a summary of the specified serological model object #' @@ -370,7 +377,7 @@ extract_seromodel_summary <- function(seromodel_object) { #' serodata <- prepare_serodata(chagas2012) #' seromodel_object <- run_seromodel(serodata = serodata, #' foi_model = "constant") -#' foi <- rstan::extract(seromodel_object$fit, "foi")[[1]] +#' foi <- rstan::extract(seromodel_object$seromodel_fit, "foi")[[1]] #' get_prev_expanded <- function(foi, serodata) #' } #' @export diff --git a/R/visualisation.R b/R/visualisation.R index 775b06eb..65d23866 100644 --- a/R/visualisation.R +++ b/R/visualisation.R @@ -64,10 +64,10 @@ plot_seroprev <- function(serodata, plot_seroprev_fitted <- function(seromodel_object, size_text = 6) { - if (is.character(seromodel_object$fit) == FALSE) { - if (class(seromodel_object$fit@sim$samples) != "NULL" ) { + if (is.character(seromodel_object$seromodel_fit) == FALSE) { + if (class(seromodel_object$seromodel_fit@sim$samples) != "NULL" ) { - foi <- rstan::extract(seromodel_object$fit, "foi", inc_warmup = FALSE)[[1]] + foi <- rstan::extract(seromodel_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] prev_expanded <- get_prev_expanded(foi, serodata = seromodel_object$serodata, bin_data = TRUE) prev_plot <- ggplot2::ggplot(prev_expanded) + @@ -148,14 +148,14 @@ plot_foi <- function(seromodel_object, max_lambda = NA, size_text = 25, foi_sim = NULL) { - if (is.character(seromodel_object$fit) == FALSE) { - if (class(seromodel_object$fit@sim$samples) != "NULL") { - foi <- rstan::extract(seromodel_object$fit, + if (is.character(seromodel_object$seromodel_fit) == FALSE) { + if (class(seromodel_object$seromodel_fit@sim$samples) != "NULL") { + foi <- rstan::extract(seromodel_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] #-------- This bit is to get the actual length of the foi data - foi_data <- seromodel_object$foi_cent_est + foi_data <- get_foi_central_estimates(seromodel_object = seromodel_object) #-------- foi_data$medianv[1] <- NA @@ -243,8 +243,8 @@ plot_foi <- function(seromodel_object, #' @export plot_rhats <- function(seromodel_object, size_text = 25) { - if (is.character(seromodel_object$fit) == FALSE) { - if (class(seromodel_object$fit@sim$samples) != "NULL") { + if (is.character(seromodel_object$seromodel_fit) == FALSE) { + if (class(seromodel_object$seromodel_fit@sim$samples) != "NULL") { rhats <- get_table_rhats(seromodel_object) rhats_plot <- @@ -310,8 +310,8 @@ plot_seromodel <- function(seromodel_object, max_lambda = NA, size_text = 25, foi_sim = NULL) { - if (is.character(seromodel_object$fit) == FALSE) { - if (class(seromodel_object$fit@sim$samples) != "NULL") { + if (is.character(seromodel_object$seromodel_fit) == FALSE) { + if (class(seromodel_object$seromodel_fit@sim$samples) != "NULL") { prev_plot <- plot_seroprev_fitted(seromodel_object = seromodel_object, size_text = size_text) From 7ff768a83675f1a7910ff8a7c4422b3785885975 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 09:14:48 -0500 Subject: [PATCH 07/13] fix: minor corrections to tests according to commit 052c90c --- tests/testthat/test_issue_47.R | 2 +- tests/testthat/test_modelling.R | 6 +++--- tests/testthat/test_visualisation.R | 5 ++--- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test_issue_47.R b/tests/testthat/test_issue_47.R index e46b2740..096b8d2d 100644 --- a/tests/testthat/test_issue_47.R +++ b/tests/testthat/test_issue_47.R @@ -12,7 +12,7 @@ test_that("issue 47", { # Error reproduction model_test <- run_seromodel(data_issue, foi_model = "tv_normal", print_summary = FALSE) - foi <- rstan::extract(model_test$fit, "foi", inc_warmup = FALSE)[[1]] + foi <- rstan::extract(model_test$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] age_max <- max(data_issue$age_mean_f) prev_expanded <- get_prev_expanded(foi, serodata = data_issue) diff --git a/tests/testthat/test_modelling.R b/tests/testthat/test_modelling.R index edea5876..f8662a31 100644 --- a/tests/testthat/test_modelling.R +++ b/tests/testthat/test_modelling.R @@ -27,7 +27,7 @@ test_that("individual models", { n_iters = 1000, print_summary = FALSE) - foi <- rstan::extract(model_object$fit, "foi", inc_warmup = FALSE)[[1]] + foi <- rstan::extract(model_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] prev_expanded <- get_prev_expanded(foi, serodata = model_object$serodata) prev_expanded_constant <- readRDS(data_constant_path) @@ -40,7 +40,7 @@ test_that("individual models", { foi_model = model_name, n_iters = 1000) - foi <- rstan::extract(model_object$fit, "foi", inc_warmup = FALSE)[[1]] + foi <- rstan::extract(model_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] prev_expanded <- get_prev_expanded(foi, serodata = model_object$serodata) prev_expanded_tv_normal <- readRDS(data_tv_normal_path) testthat::expect_equal(prev_expanded, prev_expanded_tv_normal, tolerance = TRUE) @@ -52,7 +52,7 @@ test_that("individual models", { foi_model = model_name, n_iters = 1000) - foi <- rstan::extract(model_object$fit, "foi", inc_warmup = FALSE)[[1]] + foi <- rstan::extract(model_object$seromodel_fit, "foi", inc_warmup = FALSE)[[1]] prev_expanded <- get_prev_expanded(foi, serodata = model_object$serodata) prev_expanded_tv_normal <- readRDS(data_tv_normal_path) testthat::expect_equal(prev_expanded, prev_expanded_tv_normal_log, tolerance = TRUE) diff --git a/tests/testthat/test_visualisation.R b/tests/testthat/test_visualisation.R index 52ef09fa..eef51cde 100644 --- a/tests/testthat/test_visualisation.R +++ b/tests/testthat/test_visualisation.R @@ -10,12 +10,11 @@ test_that("individual models", { set.seed(1234) # For reproducibility library(devtools) - library(dplyr) library(vdiffr) library(jsonlite) - data("simdata_large_epi") - simdata <- simdata_large_epi %>% prepare_serodata() + data(simdata_large_epi) + simdata <- prepare_serodata(simdata_large_epi) no_transm <- 0.0000000001 big_outbreak <- 1.5 foi_sim <- c(rep(no_transm, 32), rep(big_outbreak, 3), rep(no_transm, 15)) # 1 epidemics From 4408c1deb4a1b8131b290ba801b770a750cffc35 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 09:40:03 -0500 Subject: [PATCH 08/13] fix: change to in model_comparison --- R/model_comparison.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/model_comparison.R b/R/model_comparison.R index c2bb29c9..32825a8c 100644 --- a/R/model_comparison.R +++ b/R/model_comparison.R @@ -15,7 +15,7 @@ #' } #' @export get_table_rhats <- function(seromodel_object) { - rhats <- bayesplot::rhat(seromodel_object$fit, "foi") + rhats <- bayesplot::rhat(seromodel_object$seromodel_fit, "foi") if (any(is.nan(rhats))) { rhats[which(is.nan(rhats))] <- 0 From 6f4be9996dc58981381698e7581754552bee2e3c Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 09:42:53 -0500 Subject: [PATCH 09/13] doc: add documentation file for --- man/get_foi_central_estimates.Rd | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 man/get_foi_central_estimates.Rd diff --git a/man/get_foi_central_estimates.Rd b/man/get_foi_central_estimates.Rd new file mode 100644 index 00000000..d85285e8 --- /dev/null +++ b/man/get_foi_central_estimates.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelling.R +\name{get_foi_central_estimates} +\alias{get_foi_central_estimates} +\title{Function that generates the central estimates for the fitted forced FoI} +\usage{ +get_foi_central_estimates(seromodel_object) +} +\arguments{ +\item{seromodel_object}{Object containing the results of fitting a model by means of \link{run_seromodel}. +generated by means of \link{get_exposure_ages}.} +} +\value{ +\code{foi_central_estimates}. Central estimates for the fitted forced FoI +} +\description{ +Function that generates the central estimates for the fitted forced FoI +} +\examples{ +\dontrun{ +data(chagas2012) +serodata <- prepare_serodata(chagas2012) +seromodel_object <- fit_seromodel(serodata = serodata, + foi_model = "constant") +foi_central_estimates <- get_foi_central_estimates(seromodel_object) +} + +} From 0053a0f0cdf5289b8a1ad66b3ae82b9149ca5c4b Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 10:00:03 -0500 Subject: [PATCH 10/13] doc: minor correction to documentation --- R/modelling.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/modelling.R b/R/modelling.R index d3d3f129..aad4f9c9 100644 --- a/R/modelling.R +++ b/R/modelling.R @@ -367,7 +367,7 @@ extract_seromodel_summary <- function(seromodel_object) { #' #' This function computes the corresponding binomial confidence intervals for the obtained prevalence based on a fitting #' of the Force-of-Infection \code{foi} for plotting an analysis purposes. -#' @param foi Object containing the information of the force of infection. It is obtained from \code{rstan::extract(seromodel_object$fit, "foi", inc_warmup = FALSE)[[1]]}. +#' @param foi Object containing the information of the force of infection. It is obtained from \code{rstan::extract(seromodel_object$seromodel, "foi", inc_warmup = FALSE)[[1]]}. #' @param serodata A data frame containing the data from a seroprevalence survey. For further details refer to \link{run_seromodel}. #' @param bin_data TBD #' @return \code{prev_final}. The expanded prevalence data. This is used for plotting purposes in the \code{visualization} module. From 95a2debd09a1399912968c624355cdff0f7194ef Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 10:51:47 -0500 Subject: [PATCH 11/13] refac: updates --- R/modelling.R | 27 +++++++++++++-------------- R/visualisation.R | 4 ++-- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/R/modelling.R b/R/modelling.R index aad4f9c9..d4ca4877 100644 --- a/R/modelling.R +++ b/R/modelling.R @@ -68,7 +68,8 @@ run_seromodel <- function(serodata, foi_model, " finished running ------")) if (print_summary){ - print(t(seromodel_object$model_summary)) + model_summary <- extract_seromodel_summary(seromodel_object = seromodel_object) + print(t(model_summary)) } return(seromodel_object) } @@ -328,26 +329,24 @@ get_foi_central_estimates <- function(seromodel_object) { #' } #' @export extract_seromodel_summary <- function(seromodel_object) { - foi_model <- seromodel_object$foi_model - serodata <- seromodel_object$serodata #------- Loo estimates - - loo_fit <- seromodel_object$loo_fit + loo_fit <- loo::loo(seromodel_object$seromodel_fit, save_psis = TRUE, "logLikelihood") if (sum(is.na(loo_fit)) < 1) { lll <- as.numeric((round(loo_fit$estimates[1, ], 2))) } else { lll <- c(-1e10, 0) } + #------- model_summary <- data.frame( - foi_model = foi_model, - dataset = serodata$survey[1], - country = serodata$country[1], - year = serodata$tsur[1], - test = serodata$test[1], - antibody = serodata$antibody[1], - n_sample = sum(serodata$total), - n_agec = length(serodata$age_mean_f), - n_iter = seromodel_object$n_iters, + foi_model = seromodel_object$seromodel_fit@model_name, + dataset = unique(seromodel_object$serodata$survey), + country = unique(seromodel_object$serodata$country), + year = unique(seromodel_object$serodata$tsur), + test = unique(seromodel_object$serodata$test), + antibody = unique(seromodel_object$serodata$antibody), + n_sample = sum(seromodel_object$serodata$total), + n_agec = length(seromodel_object$serodata$age_mean_f), + n_iter = seromodel_object$seromodel_fit@sim$iter, elpd = lll[1], se = lll[2], converged = NA diff --git a/R/visualisation.R b/R/visualisation.R index 65d23866..2188a76f 100644 --- a/R/visualisation.R +++ b/R/visualisation.R @@ -324,9 +324,9 @@ plot_seromodel <- function(seromodel_object, rhats_plot <- plot_rhats(seromodel_object = seromodel_object, size_text = size_text) - + model_summary <- extract_seromodel_summary(seromodel_object = seromodel_object) summary_table <- t( - dplyr::select(seromodel_object$model_summary, + dplyr::select(model_summary, c('foi_model', 'dataset', 'elpd', 'se', 'converged'))) summary_plot <- plot_info_table(summary_table, size_text = size_text) From 6d97d33090805b861ecceafd29c6d3f361a02762 Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 10:52:43 -0500 Subject: [PATCH 12/13] refac: reduce the output of --- R/modelling.R | 23 ++--------------------- 1 file changed, 2 insertions(+), 21 deletions(-) diff --git a/R/modelling.R b/R/modelling.R index d4ca4877..36a25f80 100644 --- a/R/modelling.R +++ b/R/modelling.R @@ -180,34 +180,15 @@ fit_seromodel <- function(serodata, serodata = serodata, stan_data = stan_data, exposure_years = exposure_years, - exposure_ages = exposure_ages, - n_iters = n_iters, - n_thin = n_thin, - n_warmup = n_warmup, - foi_model = foi_model, - delta = delta, - m_treed = m_treed, - loo_fit = loo_fit, - foi_cent_est = foi_cent_est, - foi_post_s = foi_post_s + exposure_ages = exposure_ages ) - seromodel_object$model_summary <- - extract_seromodel_summary(seromodel_object) } else { seromodel_object <- list( seromodel_fit = "no model", serodata = serodata, stan_data = stan_data, exposure_years = exposure_years, - exposure_ages = exposure_ages, - n_iters = n_iters, - n_thin = n_thin, - n_warmup = n_warmup, - model = foi_model, - delta = delta, - m_treed = m_treed, - loo_fit = loo_fit, - model_summary = NA + exposure_ages = exposure_ages ) } From 78d1eefeaa280382af1cdd490f571f6d6d44bdfb Mon Sep 17 00:00:00 2001 From: ntorresd Date: Tue, 15 Aug 2023 11:00:30 -0500 Subject: [PATCH 13/13] fix(tests): change storing format of model object files from .json to .RDS and updates test_visualization accordingly --- tests/testthat/models_serialization.R | 16 ++++++------- tests/testthat/test_visualisation.R | 33 ++++++++++++--------------- 2 files changed, 23 insertions(+), 26 deletions(-) diff --git a/tests/testthat/models_serialization.R b/tests/testthat/models_serialization.R index 6306fac0..0daa2b37 100644 --- a/tests/testthat/models_serialization.R +++ b/tests/testthat/models_serialization.R @@ -1,5 +1,4 @@ library(devtools) -library(dplyr) library(serofoi) library(testthat) @@ -7,7 +6,7 @@ set.seed(1234) # For reproducibility #----- Read and prepare data data("simdata_large_epi") -simdata <- simdata_large_epi %>% prepare_serodata() +simdata <- prepare_serodata(simdata_large_epi) no_transm <- 0.0000000001 big_outbreak <- 1.5 foi_sim <- c(rep(no_transm, 32), rep(big_outbreak, 3), rep(no_transm, 15)) # 1 epidemics @@ -23,11 +22,12 @@ models_list <- lapply(models_to_run, serodata = simdata, n_iters = 1000) -model_constant_json <- jsonlite::serializeJSON(models_list[[1]]) -write_json(model_constant_json, testthat::test_path("extdata", "model_constant.json")) +saveRDS(models_list[[1]], + testthat::test_path("extdata", "model_constant.RDS")) -model_tv_normal_json <- jsonlite::serializeJSON(models_list[[2]]) -write_json(model_tv_normal_json, testthat::test_path("extdata", "model_tv_normal.json")) +saveRDS(models_list[[2]], + testthat::test_path("extdata", "model_tv_normal.RDS")) + +saveRDS(models_list[[3]], + testthat::test_path("extdata", "model_tv_normal_log.RDS")) -model_tv_normal_log_json <- jsonlite::serializeJSON(models_list[[3]]) -write_json(model_tv_normal_json, testthat::test_path("extdata", "model_tv_normal_log.json")) diff --git a/tests/testthat/test_visualisation.R b/tests/testthat/test_visualisation.R index eef51cde..896788c1 100644 --- a/tests/testthat/test_visualisation.R +++ b/tests/testthat/test_visualisation.R @@ -24,28 +24,25 @@ test_that("individual models", { size_text <- 6 max_lambda <- 1.55 - model_constant_json <- jsonlite::fromJSON(testthat::test_path("extdata", "model_constant.json")) - model_constant <- jsonlite::unserializeJSON(model_constant_json) - constant_plot <- plot_seromodel(model_constant, - size_text = size_text, - max_lambda = max_lambda, - foi_sim = foi_sim + model_constant <- readRDS(testthat::test_path("extdata", "model_constant.RDS")) + constant_plot <- plot_seromodel(seromodel_object = model_constant, + size_text = size_text, + max_lambda = max_lambda, + foi_sim = foi_sim ) - model_tv_normal_json <- fromJSON(testthat::test_path("extdata", "model_tv_normal.json")) - model_tv_normal <- jsonlite::unserializeJSON(model_tv_normal_json) - tv_normal_plot <- plot_seromodel(model_tv_normal, - size_text = size_text, - max_lambda = max_lambda, - foi_sim = foi_sim + model_tv_normal <- readRDS(testthat::test_path("extdata", "model_tv_normal.RDS")) + tv_normal_plot <- plot_seromodel(seromodel_object = model_tv_normal, + size_text = size_text, + max_lambda = max_lambda, + foi_sim = foi_sim ) - model_tv_normal_log_json <- fromJSON(testthat::test_path("extdata", "model_tv_normal_log.json")) - model_tv_normal_log <- jsonlite::unserializeJSON(model_tv_normal_log_json) - tv_normal_log_plot <- plot_seromodel(model_tv_normal_log, - size_text = size_text, - max_lambda = max_lambda, - foi_sim = foi_sim + model_tv_normal_log <- readRDS(testthat::test_path("extdata", "model_tv_normal_log.RDS")) + tv_normal_log_plot <- plot_seromodel(seromodel_object = model_tv_normal_log, + size_text = size_text, + max_lambda = max_lambda, + foi_sim = foi_sim ) plot_arrange <- cowplot::plot_grid(constant_plot,