Title: | Simple Dengue Test and Vaccinate Cost Thresholds |
---|---|
Description: | Provides the mathematical model described by "Serostatus Testing & Dengue Vaccine Cost-Benefit Thresholds" in <doi:10.1098/rsif.2019.0234>. Using the functions in the package, that analysis can be repeated using sample life histories, either synthesized from local seroprevalence data using other functions in this package (as in the manuscript) or from some other source. The package provides a vignette which walks through the analysis in the publication, a function to generate a project skeleton for such an analysis, and a shiny app to run scenarios. |
Authors: | Carl A. B. Pearson [aut, cre] , Kaja M. Abbas [aut] , Samuel Clifford [aut] , Stefan Flasche [aut] , Thomas J. Hladish [aut] |
Maintainer: | Carl A. B. Pearson <[email protected]> |
License: | MIT + file LICENSE |
Version: | 0.1.3 |
Built: | 2024-10-07 04:02:41 UTC |
Source: | https://gitlab.com/cabp_lshtm/denvax |
Creates an ROI estimation project.
build.project(targetdir, overwrite = FALSE, copy_pub = TRUE)
build.project(targetdir, overwrite = FALSE, copy_pub = TRUE)
targetdir |
path to enclosing directory. If this directory does not exist, will attempt to create it (recursively) |
overwrite |
overwrite existing files corresponding to the project skeleton elements? |
copy_pub |
copy the 'pub/' folder (which contains the analyses from the publication) |
This function sets up the skeleton of an analysis to go from seroprevalence data to the ROI estimation surface.
That skeleton uses a series of separate scripts for each analytical step (fitting, simulation, analysis, and application),
connected via the command line build tool make
(NOTE: this assumes GNU make; if you have a different one, you may need
to modify the code). This approach allows clean substitution for various stages (e.g.,
using a different model to generate life histories). The following files are created:
the dependencies for various analysis stages; NOTE: this (and the file in 'pub/') assumes GNU make.
brief notes about project parts
script for fitting seroprevalence data
script for generating synthetic populations
script for converting life histories into probability coefficients for ROI calculation
a quick example start-to-finish analysis
the precise analysis used in the publication
logical, indicating error free creation of the project skeleton; there may still be other warnings
require(denvax) tardir <- tempdir() # replace with desired target build.project(tardir) list.files(tardir, recursive = TRUE)
require(denvax) tardir <- tempdir() # replace with desired target build.project(tardir) list.files(tardir, recursive = TRUE)
Provides the mathematical model described by "Serostatus Testing & Dengue Vaccine Cost-Benefit Thresholds" in <doi:10.1098/rsif.2019.0234>. Using the functions in the package, that analysis can be repeated using sample life histories, either synthesized from local seroprevalence data using other functions in this package (as in the manuscript) or from some other source. The package provides a vignette which walks through the analysis in the publication, as well as a function to generate a project skeleton for such an analysis.
denvax
functionsserofit
fits serosurvey data against two-risk model
synthetic.pop
using parameter fit data, generate a sample population
nPxA
estimate dengue infection outcome probabilities based on a synthetic population
ROIcoeffs
using population outcome probabilities, compute ROI equation coefficients
ROI
compute ROIs from setting coefficients and cost scenarios
build.project
create a template project for estimating ROIs
These functions provide several standardized wrappers to the
scale_continuous
functions, simplifying the creation
of consistent plots.
Note, these are only functional if 'ggplot2' is installed; otherwise these methods simply issue a warning.
scale_x_startAge( name = "Initial Age for Routine Testing", expand = ggplot2::expand_scale(add = 0.5), breaks = function(xlim) seq(ceiling(xlim[1]), floor(xlim[2])), ... ) scale_y_endAge( name = "Maximum Age for Testing", expand = ggplot2::expand_scale(add = 0.5), ... ) scale_y_numTests( name = "Maximum # of Tests", breaks = function(lims) seq(round(lims[1]), round(lims[2]), by = 1), expand = ggplot2::expand_scale(add = 0.5), ... ) scale_x_log10tau( name = expression(tau * ", Test Cost Fraction (log scale)"), labels = function(b) sprintf("%0.2f", 10^b), expand = ggplot2::expand_scale(), ... ) scale_y_nu( name = expression(nu * ", Vaccine Cost Fraction"), labels = function(b) sprintf("%0.1f", b), expand = ggplot2::expand_scale(), ... ) scale_linetype_ROIlvl( name = "ROI Limits", drop = FALSE, values = c(`0` = "dotted", `0.1` = "dotdash", `0.25` = "longdash", `0.5` = "solid"), ... ) scale_color_ROIsign( name = "ROI Direction", breaks = c(1, 0, -1), drop = FALSE, labels = c(`-1` = "Negative", `0` = "Neutral", `1` = "Positive"), values = c(`-1` = "firebrick", `0` = "black", `1` = "dodgerblue"), ... ) scale_fill_ROI( name = "ROI", limits = c(-1, 2), breaks = seq(-1, 2, by = 0.5), na.value = "#3A3A98", ... ) rescale_x_Tcost( S, name = "Per Test Cost (USD)", labels = function(b) b * S, ... ) rescale_y_Vcost( S, name = "Vaccine Cost (USD)", labels = function(b) b * S, ... )
scale_x_startAge( name = "Initial Age for Routine Testing", expand = ggplot2::expand_scale(add = 0.5), breaks = function(xlim) seq(ceiling(xlim[1]), floor(xlim[2])), ... ) scale_y_endAge( name = "Maximum Age for Testing", expand = ggplot2::expand_scale(add = 0.5), ... ) scale_y_numTests( name = "Maximum # of Tests", breaks = function(lims) seq(round(lims[1]), round(lims[2]), by = 1), expand = ggplot2::expand_scale(add = 0.5), ... ) scale_x_log10tau( name = expression(tau * ", Test Cost Fraction (log scale)"), labels = function(b) sprintf("%0.2f", 10^b), expand = ggplot2::expand_scale(), ... ) scale_y_nu( name = expression(nu * ", Vaccine Cost Fraction"), labels = function(b) sprintf("%0.1f", b), expand = ggplot2::expand_scale(), ... ) scale_linetype_ROIlvl( name = "ROI Limits", drop = FALSE, values = c(`0` = "dotted", `0.1` = "dotdash", `0.25` = "longdash", `0.5` = "solid"), ... ) scale_color_ROIsign( name = "ROI Direction", breaks = c(1, 0, -1), drop = FALSE, labels = c(`-1` = "Negative", `0` = "Neutral", `1` = "Positive"), values = c(`-1` = "firebrick", `0` = "black", `1` = "dodgerblue"), ... ) scale_fill_ROI( name = "ROI", limits = c(-1, 2), breaks = seq(-1, 2, by = 0.5), na.value = "#3A3A98", ... ) rescale_x_Tcost( S, name = "Per Test Cost (USD)", labels = function(b) b * S, ... ) rescale_y_Vcost( S, name = "Vaccine Cost (USD)", labels = function(b) b * S, ... )
name |
the scale name (default value provided) |
expand |
the scale expansion (default value provided) |
breaks |
the tick mark locations (default provided for '...numTests') |
... |
see |
labels |
the tick mark labels (default provided for '...log10tau') |
drop |
include missing levels in legend? (default value provided for '...ROIlvl' and '...ROIsign') |
values |
key values for levels (default value provided for '...ROIlvl' and '...ROIsign') |
limits |
the ROI range for fill colors (default value provided for '...ROI') |
na.value |
the fill color when outside of the limits (default value provided for '...ROI') |
S |
the scaling factor (cost of a Secondary dengue infection) for test and vaccination cost scales, when x is terms of tau (test cost fraction), and y is in terms of nu (vaccine cost fraction) |
Provides the shiny app associated with
<doi:10.6084/m9.figshare.11695155>.
Only works if shiny
and ggplot2
packages installed.
denvaxApp(...)
denvaxApp(...)
... |
see |
does not return; interrupt R to stop the shiny app.
## Not run: denvax::denvaxApp() ## End(Not run)
## Not run: denvax::denvaxApp() ## End(Not run)
From "Symptomatic Dengue in Children in 10 Asian and Latin American Countries", Table 4.
lazou2016
lazou2016
a data.frame (data.table, if installed) with 20 rows and 4 columns:
character, common country name (all Peru for this data)
character, the bounding ages for the sample; format: lower age '-' upper age
integer, the number of samples
integer, the number of seropositive samples
https://doi.org/10.1056/NEJMoa1503877
require(denvax); require(ggplot2) data(lazou2016) ggplot(lazou2016) + aes(Age, Seropositive/Number*100, color = Country) + geom_point() + labs(y="Seropositive %", x="Age Group") + lims(y=c(0,100)) + theme_minimal()
require(denvax); require(ggplot2) data(lazou2016) ggplot(lazou2016) + aes(Age, Seropositive/Number*100, color = Country) + geom_point() + labs(y="Seropositive %", x="Age Group") + lims(y=c(0,100)) + theme_minimal()
From "Epidemiology of Dengue Virus in Iquitos, Peru 1999 to 2005: Interepidemic and Epidemic Patterns of Transmission", combining information from Fig. 2 and Fig. 3. The data from Fig. 3 were extracted using https://automeris.io/WebPlotDigitizer/
morrison2010
morrison2010
a data.frame (data.table, if installed) with 13 rows and 4 columns:
character, common country name (all Peru for this data)
integer, the age category
integer, the number of samples
integer, the number of seropositive samples
https://doi.org/10.1371/journal.pntd.0000670
require(denvax) data(morrison2010) with(morrison2010, plot(Age, Seropositive/Number*100, ylab="% Seropositive", ylim=c(0,100)) )
require(denvax) data(morrison2010) with(morrison2010, plot(Age, Seropositive/Number*100, ylab="% Seropositive", ylim=c(0,100)) )
Compute the nPx(A), C(A) proportions from a population of life histories
nPxA(lifehistory)
nPxA(lifehistory)
lifehistory |
a matrix with rows (sample individuals) and columns (outcome in year of life); see synthetic.pop return value |
computes the relevant nPx(A) and C(A): the probabilities of the various life trajectories, by age. See <doi:10.1098/rsif.2019.0234>, SI section II.A (Cost Benefit Equations: Definitions)
a data.frame
(data.table
, if available) with columns
integer; the reference year of life, from 1 to dim(lifehistory)[2]
numeric; probability of 0 lifetime infections
numeric; probability of 1 or more lifetime infections
numeric; probability of 2 or more lifetime infections
numeric; probability of 0 infections at age A, and 1 lifetime infection
numeric; probability of 0 infections at age A, and 1 or more lifetime infections
numeric; probability of 0 infections at age A, and 2 or more lifetime infections
numeric; probability of 1 infection at age A, and 1 or more lifetime infections
numeric; probability of 1 infection at age A, and 2 or more lifetime infections
numeric; probability of 1 or more infections at age A, and 1 or more lifetime infections
numeric; probability of 2 or more infections at age A, and 2 or more lifetime infections
numeric; probability of converting from seronegative to seropositive between age A and A+1
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) m2010lh with(m2010lh, plot(A, p0_2p*100, type="l", xlab="Age", ylab="%", ylim = c(0, 100), main="Individuals w/ No Infections,\nbut that will have 2" ) )
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) m2010lh with(m2010lh, plot(A, p0_2p*100, type="l", xlab="Age", ylab="%", ylim = c(0, 100), main="Individuals w/ No Infections,\nbut that will have 2" ) )
Compute the ROI surfaces given test and vaccine cost fractions.
ROI( rcoeffs, nus = seq(0.3, 0.9, by = 0.05), taus = 10^seq(-2, -0.5, by = 0.05) )
ROI( rcoeffs, nus = seq(0.3, 0.9, by = 0.05), taus = 10^seq(-2, -0.5, by = 0.05) )
rcoeffs |
a data.frame with the ROI surface coefficients from ROIcoeffs |
nus |
the series of normalized vaccine costs to use for ROI calcs |
taus |
the series of normalized test costs to use for ROI calcs |
tabulates ROI
a 'data.frame' ('data.table', if available) with columns:
numeric, the normalized vaccine cost used
numeric, the normalized test cost used
character, either "ordinal" or "binary" corresponding to the type of test
integer; the age when routine test-then-vaccinate strategy starts (from As
)
integer; the maximum number of tests for routine test-then-vaccinate strategy (from Ls
)
numeric; the intervention cost (as a fraction of second infection cost)
numeric; the difference in health outcome cost (as a fraction of second infection cost) minus 'cost'; positive values indicate positive net benefit
numeric; return on investment: 'benefit' over 'cost'
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) L <- 5 rc <- ROIcoeffs(m2010lh, As=5:10, Ls=L) rois <- ROI(rc, nus = 0.5, taus = 0.01) srois <- subset(rois, mechanism == "binary") mrois <- matrix(srois$roi, nrow = L) contour(x=unique(srois$L), y=unique(srois$A), z=mrois, xlab = "Max # of Tests", ylab = "Initial Age", main="ROI Contour" )
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) L <- 5 rc <- ROIcoeffs(m2010lh, As=5:10, Ls=L) rois <- ROI(rc, nus = 0.5, taus = 0.01) srois <- subset(rois, mechanism == "binary") mrois <- matrix(srois$roi, nrow = L) contour(x=unique(srois$L), y=unique(srois$A), z=mrois, xlab = "Max # of Tests", ylab = "Initial Age", main="ROI Contour" )
Compute the Return on Investment (ROI) surface coefficients from population probabilities
ROIcoeffs(probabilities, As = 5:20, Ls = (diff(range(As)) + 1):1)
ROIcoeffs(probabilities, As = 5:20, Ls = (diff(range(As)) + 1):1)
probabilities |
a |
As |
the starting age(s) to consider |
Ls |
the maximum number of tests for each age; should either be an integer per age or a single integer for all ages.
The default behavior computes the number of tests (for each age) that makes the maximum of 'As' the maximum testing age
Note: results will also be provided for shorter testing intervals, as the intermediate coefficients are calculated as part
of computing the value at the maximum |
computes the coefficients for the economic calculations
a data.frame
(data.table
, if available) with columns:
integer; the age when routine test-then-vaccinate strategy starts (from As
)
integer; the maximum number of tests for routine test-then-vaccinate strategy (from Ls
)
numeric; the fraction of individuals participating in this strategy that get vaccinated
numeric; the (additive) reduction in vacfrac
if using the ordinal test
numeric; the proportion experiencing second infection costs
numeric; the F/S cost fraction term, when comparing vaccination with and without testing
numeric; the S term, when comparing vaccination with and without testing
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) rc <- ROIcoeffs(m2010lh, As=5:10, Ls=5) pp <- par() par(mfrow=c(1, 2)) rcs <- subset(rc, A==10 & L < 11) with(rcs, plot( L, aveTests, type="l", xlab="Max # of Tests Allowed", ylab="Ave # of Tests Administered", main="Starting @ Age 10", ylim=c(1, 3) )) rcs <- subset(rc, A==5 & L < 11) with(rcs, plot( L, aveTests, type="l", xlab="Max # of Tests Allowed", ylab="", main="Starting @ Age 5", ylim=c(1, 3) )) par(pp)
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time m2010lh <- nPxA(m2010pop) rc <- ROIcoeffs(m2010lh, As=5:10, Ls=5) pp <- par() par(mfrow=c(1, 2)) rcs <- subset(rc, A==10 & L < 11) with(rcs, plot( L, aveTests, type="l", xlab="Max # of Tests Allowed", ylab="Ave # of Tests Administered", main="Starting @ Age 10", ylim=c(1, 3) )) rcs <- subset(rc, A==5 & L < 11) with(rcs, plot( L, aveTests, type="l", xlab="Max # of Tests Allowed", ylab="", main="Starting @ Age 5", ylim=c(1, 3) )) par(pp)
Model fitting for serological data
serofit( seropositive, N, age.min = use.default(seq_along(seropositive), "age.min"), age.max = use.default(age.min, "age.max") )
serofit( seropositive, N, age.min = use.default(seq_along(seropositive), "age.min"), age.max = use.default(age.min, "age.max") )
seropositive |
the number of seropositive samples for each age group; length(seropositive) must be at least 3 |
N |
the total number of samples for each age group; length(N) must equal length(seropositive) |
age.min |
the low age in age groups; defaults to '1:length(seropositive)', i.e. assumes the seropositive data corresponds to yearly cohorts starting at age 1. |
age.max |
the upper age in age groups; defaults to 'age.min', i.e. assumes each category corresponds to a single year |
Fits a constant force of infection, two-risk category model using seroprevalence survey data. i.e.:
$$ P_+(A) = p_H * (1-(1-f_H)^A) + (1-p_H) * (1-(1-f_L)^A) $$
This probability is fit to the seroprevalence by age category data,
using maximum likelihood and optim
.
a list of best-fit parameters, all numeric values:
force of infection, for the high risk group
force of infection, for the low risk group
the proportion of the population at high risk
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) if (requireNamespace("data.table", quietly = TRUE)) { data(lazou2016) # has counts by age range, instead of counts for every year # this example uses `data.table`` functions to simplify processing # several groups at once lazou2016[,{ agerange <- data.table::tstrsplit(Age, "-") serofit( sero = Seropositive, N = Number, age.min = as.integer(agerange[[1]]), age.max = as.integer(agerange[[2]]) ) }, by = Country] }
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) if (requireNamespace("data.table", quietly = TRUE)) { data(lazou2016) # has counts by age range, instead of counts for every year # this example uses `data.table`` functions to simplify processing # several groups at once lazou2016[,{ agerange <- data.table::tstrsplit(Age, "-") serofit( sero = Seropositive, N = Number, age.min = as.integer(agerange[[1]]), age.max = as.integer(agerange[[2]]) ) }, by = Country] }
Compute synthetic population trajectories from model parameters
synthetic.pop(pars, runs = 100, popsize = 1000, maxAge = 70, rngseed = NULL)
synthetic.pop(pars, runs = 100, popsize = 1000, maxAge = 70, rngseed = NULL)
pars |
a list with elements 'f_H', 'f_L', and 'p_H'; see serofit return value |
runs |
the number of different serotype timelines to simulate |
popsize |
the number of individuals to sample for each run |
maxAge |
the length of each lifetime |
rngseed |
an optional seed for the random number generator |
Using fitted parameters for a two-risk, constant force of infection model, simulate a dengue annual exposures model for the requested number of serotype series ('runs') and individuals ('popsize'). The resulting matrix is a collection of integers, 0-4. 0 indicates no infection, 1-4 infection by the corresponding serotype.
a matrix of integers 0-4, rows 'runs*popsize' x columns 'maxAge'
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time head(m2010pop)
require(denvax); data(morrison2010) # has counts by age fit <- with(morrison2010, serofit(sero=Seropositive, N=Number, age.min=Age)) m2010pop <- synthetic.pop(fit, runs = 10, popsize = 10) # small sample size for example run time head(m2010pop)