prevalence/0000755000175000017500000000000014246475402012540 5ustar nileshnileshprevalence/MD50000644000175000017500000000452714246475402013060 0ustar nileshnileshda0a818b60bcfa6403723dc3bca86473 *DESCRIPTION f52af7f69b85582c7aae8583e686ad4f *NAMESPACE 6b27c31239dc2c145094b485fc504c24 *NEWS 6fbef1198d48e00c6b8175d10983f8ed *R/R2JAGS.R 7b8575089e9a66813f6f5e517e5cfd9f *R/betaExpert.R 6a95a8924882a96a7e589cd32043a003 *R/betaPERT.R b0f0bd3c3efe1724f284fa46bdb25775 *R/checkBinPrior.R 01f9ddba8cfde94388eed57d696079e2 *R/checkInput.R 3fae330cfcbb99bbe00ea9d387614b5d *R/checkSeSp.R b04eca082bb8257f9f9f46c2c7091af0 *R/ciLevel.R 4e485f421edb700d31364bc30ca3f3d0 *R/define-functions.R 0d48a08efc9d15365fa410cc8548b3ab *R/dist2list.R 0f18f98ae13e1106342a0096a2a9d613 *R/plot-methods-coda.R ef7b5c875019984c50dd27fd63a1b790 *R/plot-methods.R 7f7f9903684e067590e377d04de36322 *R/print-methods.R 000f087342e4b48c6c7fbdc6e769103d *R/propCI-agresticoull.R 7240c8b6ccc36162cc9373d852244f4b *R/propCI-exact.R 4818714ffb662c7dcae7923cc0755848 *R/propCI-jeffreys.R b95e0b3f1a6f26841f723a2ba03d4d15 *R/propCI-wald.R c74da327dcb021d071f9beb1f8cc3393 *R/propCI-wilson.R b1b9a38e3d4d68fd842d2e45e7fa4b17 *R/propCI.R ef57600a024364a931ed558a9950dfff *R/truePrev.R c2ab00885ae5f538010117c0c74b322b *R/truePrevBinom.R 9fff0edc2af11f89c477c32e010796ff *R/truePrevMulti-helper.R 563f82abca8b05798ea14c414b5f5029 *R/truePrevMulti-main.R 63a93423b4d24a96bd9152dafe4a4a4f *R/truePrevPools.R 5a0f60086fd96dd84fb9c15eceff083b *R/wrap.R 32b841aee16ee8c9fa98fb859bc75af1 *R/writeSeSp.R 95d225058502c8609f7def7619c4464e *R/zzz.R baea07820d32de8652bfd9daf91e6fc9 *README.md d71ed6cc8825a585f4775d1825faeb43 *inst/CITATION 4af2379901001f87e253f47443bb66e5 *man/betaExpert.Rd 518b74cda30df2fcea3708e2646e42e9 *man/betaPERT.Rd 4a3b30baf6216d68e38ea687ca748779 *man/convert-methods.Rd e8a2bab968d779de0224db9ddf5d42b9 *man/define.Rd b7c9b860e5c71343df6f572e54b53737 *man/plot-methods-coda.Rd 9e57823828279534301c9d3690df80ed *man/plot-methods.Rd d57ff0489510073303060ffed82929c4 *man/prev-class.Rd 9884174a49d1e07d3716bfc14abf1fe7 *man/prevalence-package.Rd 7ab924b5591bafa44dfb3d37a4d50e0e *man/print-methods.Rd 2f40813bb9d1f87b5f983dd597d10176 *man/propCI.Rd 8ab606a50850fe7450a0541742bd107f *man/show-methods.Rd bb15f34a90b2ae8301fc504629d58227 *man/summary-methods.Rd c03136fe05c65c41cf7ee9c9bef5c095 *man/truePrev.Rd 2bb0240db978405059a4bd6768f5a529 *man/truePrevMulti.Rd c8e0b502a6d3bf545f309aaccfd4b22e *man/truePrevMulti2.Rd 98880bb317cc2037d488d07c7a9b819c *man/truePrevPools.Rd prevalence/DESCRIPTION0000644000175000017500000000341114246475402014245 0ustar nileshnileshPackage: prevalence Type: Package Title: Tools for Prevalence Assessment Studies Version: 0.4.1 Date: 2022-06-03 Authors@R: c(person("Brecht", "Devleesschauwer", role = c("aut", "cre"), email = "brechtdv@gmail.com"), person("Paul", "Torgerson", role = "aut"), person("Johannes", "Charlier", role = "aut"), person("Bruno", "Levecke", role = "aut"), person("Nicolas", "Praet", role = "aut"), person("Sophie", "Roelandt", role = "aut"), person("Suzanne", "Smit", role = "aut"), person("Pierre", "Dorny", role = "aut"), person("Dirk", "Berkvens", role = "aut"), person("Niko", "Speybroeck", role = "aut")) Author: Brecht Devleesschauwer [aut, cre], Paul Torgerson [aut], Johannes Charlier [aut], Bruno Levecke [aut], Nicolas Praet [aut], Sophie Roelandt [aut], Suzanne Smit [aut], Pierre Dorny [aut], Dirk Berkvens [aut], Niko Speybroeck [aut] Maintainer: Brecht Devleesschauwer BugReports: https://github.com/brechtdv/prevalence/issues Description: The prevalence package provides Frequentist and Bayesian methods for prevalence assessment studies. IMPORTANT: the truePrev functions in the prevalence package call on JAGS (Just Another Gibbs Sampler), which therefore has to be available on the user's system. JAGS can be downloaded from . Depends: R (>= 4.0.0) Imports: methods, utils, stats, graphics, grDevices, coda, rjags SystemRequirements: JAGS (>= 4.0.0) (see https://mcmc-jags.sourceforge.io/) License: GPL (>= 2) URL: http://prevalence.cbra.be/ LazyLoad: yes NeedsCompilation: no Packaged: 2022-06-03 21:00:31 UTC; BrDe394 Repository: CRAN Date/Publication: 2022-06-03 21:20:02 UTC prevalence/README.md0000644000175000017500000000414714246472252014025 0ustar nileshnilesh## prevalence [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/prevalence)](https://cran.r-project.org/package=prevalence) [![Cranlogs Downloads](http://cranlogs.r-pkg.org/badges/grand-total/prevalence)](https://cran.r-project.org/package=prevalence) The prevalence package provides Frequentist and Bayesian methods useful in prevalence assessment studies. Several methods are available for estimating True Prevalence (TP) from Apparent Prevalence (AP). #### Available functions
propCIDerive confidence intervals for a prevalence estimate
truePrevEstimate TP from AP obtained by testing individual samples with a single test
truePrevMultiEstimate TP from AP obtained by testing individual samples with multiple tests, using a conditional probability scheme
truePrevMulti2Estimate TP from AP obtained by testing individual samples with multiple tests, using a covariance scheme
truePrevPoolsEstimate TP from AP obtained by testing pooled samples
betaPERTCalculate the parameters of a Beta-PERT distribution
betaExpertCalculate the parameters of a Beta distribution based on expert opinion
#### Install To download and install the latest released version from [CRAN](https://cran.r-project.org/package=prevalence): ```r install.packages("prevalence") ``` To download and install the latest development version from GitHub: ```r devtools::install_github("brechtdv/prevalence") ``` **IMPORTANT**: the truePrev functions in the prevalence package call on JAGS (Just Another Gibbs Sampler), which therefore has to be available on the user's system. JAGS can be downloaded from http://mcmc-jags.sourceforge.net/. #### More Function `truePrev` is also available as an online Shiny application: https://cbra.shinyapps.io/truePrev/ More information and tutorials are available at http://prevalence.cbra.be/ prevalence/man/0000755000175000017500000000000014246462542013314 5ustar nileshnileshprevalence/man/print-methods.Rd0000644000175000017500000000240614246462542016402 0ustar nileshnilesh\name{print-methods} \docType{methods} \alias{print-methods} \alias{print,prev-method} \title{Methods for Function \code{print} in Package \pkg{prevalence}} \description{Print objects of class \code{prev}} \usage{\S4method{print}{prev}(x, conf.level = 0.95, dig = 3, \dots)} \arguments{ \item{x}{An object of class \code{prev}} \item{conf.level}{Confidence level to be used in credibility interval} \item{dig}{Number of decimal digits to print} \item{\dots}{Other arguments to pass to the \code{print} function} } \section{Methods}{ \describe{ \item{\code{signature(x = "prev")}}{Print mean, median, mode, standard deviation and credibility interval of estimated true prevalence, sensitivities and specificities. In addition, print multivariate \link[coda:gelman.diag]{Brooks-Gelman-Rubin statistic} (or univariate BGR statistic with corresponding upper confidence limit in case of a single stochastic node). BGR values substantially above 1 indicate lack of convergence. For \code{prev} objects created by \code{\link{truePrevMulti}}, the Bayes-P statistic is also printed. Bayes-P should be as close to 0.5 as possible.} } } \seealso{ \code{\link{prev-class}}\cr \code{\link[coda:gelman.diag]{gelman.diag}} } \keyword{methods} prevalence/man/truePrevMulti2.Rd0000644000175000017500000002263514246467210016521 0ustar nileshnilesh\name{truePrevMulti2} \alias{truePrevMulti2} \title{Estimate true prevalence from individuals samples using multiple tests -- covariance scheme} \description{ Bayesian estimation of true prevalence from apparent prevalence obtained by applying \emph{multiple} tests to \emph{individual} samples. \code{\link{truePrevMulti2}} implements and extends the approach described by Dendukuri and Joseph (2001), which uses a multinomial distribution to model observed test results, and in which conditional dependence between tests is modelled through covariances. } \usage{ truePrevMulti2(x, n, prior, nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) } \arguments{ \item{x}{Vector of apparent test results; see 'Details' below} \item{n}{The total sample size} \item{prior}{The prior distributions; see 'Details' below} \item{nchains}{The number of chains used in the estimation process; must be \eqn{\ge 2}} \item{burnin}{The number of discarded model iterations; defaults to 10,000} \item{update}{The number of withheld model iterations; defaults to 10,000} \item{verbose}{Logical flag, indicating if JAGS process output should be printed to the R console; defaults to \code{FALSE}} } \details{ \code{\link{truePrevMulti2}} calls on \pkg{JAGS} via the \pkg{\link[rjags:rjags]{rjags}} package to estimate true prevalence from apparent prevalence in a Bayesian framework. \code{\link{truePrevMulti2}} fits a multinomial model to the apparent test results obtained by testing individual samples with a given number of tests. To see the actual fitted model, see the model slot of the \code{\link[prevalence:prev-class]{prev}}-object.\cr The vector of apparent tests results, \code{x}, must contain the number of samples corresponding to each combination of test results. To see how this vector is defined for the number of tests \code{h} at hand, use \code{\link{define_x}}. Argument \code{prior} consists of prior distributions for: \itemize{ \item{True Prevalence: \code{TP}} \item{SEnsitivity of each individual test: vector \code{SE}} \item{SPecificity of each individual test: vector \code{SP}} \item{Conditional covariance of all possible test combinations given a truly positive disease status: vector \code{a}} \item{Conditional covariance of all possible test combinations given a truly negative disease status: vector \code{b}} } To see how \code{prior} is defined for the number of tests \code{h} at hand, use \code{\link{define_prior2}}.\cr The values of \code{prior} can be specified in two ways, referred to as BUGS-style and list-style, respectively. See also below for some examples.\cr For BUGS-style specification, the values of \code{prior} should be given between curly brackets (i.e., \code{{}}), separated by line breaks. Priors can be specified to be deterministic (i.e., fixed), using the \code{<-} operator, or stochastic, using the \code{~} operator. In the latter case, the following distributions can be used: \itemize{ \item{\strong{Uniform: }}{\code{dunif(min, max)}} \item{\strong{Beta: }}{\code{dbeta(alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{dpert(min, mode, max)}} } Alternatively, priors can be specified in a \emph{named} \code{list()} as follows: \itemize{ \item{\strong{Fixed: }}{\code{list(dist = "fixed", par)}} \item{\strong{Uniform: }}{\code{list(dist = "uniform", min, max)}} \item{\strong{Beta: }}{\code{list(dist = "beta", alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{list(dist = "pert", method, a, m, b, k)}\cr \code{'method'} must be \code{"classic"} or \code{"vose"};\cr \code{'a'} denotes the pessimistic (minimum) estimate, \code{'m'} the most likely estimate, and \code{'b'} the optimistic (maximum) estimate;\cr \code{'k'} denotes the scale parameter.\cr See \code{\link{betaPERT}} for more information on Beta-PERT parameterization.} \item{\strong{Beta-Expert: }}{\code{list(dist = "beta-expert", mode, mean, lower, upper, p)}\cr \code{'mode'} denotes the most likely estimate, \code{'mean'} the mean estimate;\cr \code{'lower'} denotes the lower bound, \code{'upper'} the upper bound;\cr \code{'p'} denotes the confidence level of the expert.\cr Only \code{mode} or \code{mean} should be specified; \code{lower} and \code{upper} can be specified together or alone.\cr See \code{\link{betaExpert}} for more information on Beta-Expert parameterization.} } } \value{ An object of class \code{\link[prevalence:prev-class]{prev}}. } \note{ Markov chain Monte Carlo sampling in \code{truePrevMulti2} is performed by \pkg{JAGS (Just Another Gibbs Sampler)} through the \pkg{\link[rjags:rjags]{rjags}} package. JAGS can be downloaded from \url{https://mcmc-jags.sourceforge.io/}. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \references{ \itemize{ \item{Dendukuri N, Joseph L (2001) Bayesian approaches to modeling the conditional dependence between multiple diagnostic tests. \emph{Biometrics} \strong{57}:158-167} } } \seealso{ \code{\link{define_x}}: how to define the vector of apparent test results \code{x}\cr \code{\link{define_prior2}}: how to define \code{prior}\cr \pkg{\link[coda:mcmc]{coda}} for various functions that can be applied to the \code{prev@mcmc} object\cr \code{\link{truePrevMulti}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a conditional probability scheme\cr \code{\link{truePrev}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with a single test\cr \code{\link{truePrevPools}}: estimate true prevalence from apparent prevalence obtained by testing \emph{pooled} samples\cr \code{\link{betaPERT}}: calculate the parameters of a Beta-PERT distribution\cr \code{\link{betaExpert}}: calculate the parameters of a Beta distribution based on expert opinion } \examples{ \dontrun{ ## ===================================================== ## ## 2-TEST EXAMPLE: Strongyloides ## ## ----------------------------------------------------- ## ## Two tests were performed on 162 humans ## ## -> T1 = stool examination ## ## -> T2 = serology test ## ## Expert opinion generated the following priors: ## ## -> SE1 ~ dbeta( 4.44, 13.31) ## ## -> SP1 ~ dbeta(71.25, 3.75) ## ## -> SE2 ~ dbeta(21.96, 5.49) ## ## -> SP2 ~ dbeta( 4.10, 1.76) ## ## The following results were obtained: ## ## -> 38 samples T1+,T2+ ## ## -> 2 samples T1+,T2- ## ## -> 87 samples T1-,T2+ ## ## -> 35 samples T1-,T2- ## ## ===================================================== ## ## how is the 2-test model defined? define_x(2) define_prior2(2) ## fit Strongyloides 2-test model ## a first model assumes conditional independence ## -> set covariance terms to zero strongy_indep <- truePrevMulti2( x = c(38, 2, 87, 35), n = 162, prior = { TP ~ dbeta(1, 1) SE[1] ~ dbeta( 4.44, 13.31) SP[1] ~ dbeta(71.25, 3.75) SE[2] ~ dbeta(21.96, 5.49) SP[2] ~ dbeta( 4.10, 1.76) a[1] <- 0 b[1] <- 0 }) ## show model results strongy_indep ## fit same model using 'list-style' strongy_indep <- truePrevMulti2( x = c(38, 2, 87, 35), n = 162, prior = list( TP = list(dist = "beta", alpha = 1, beta = 1), SE1 = list(dist = "beta", alpha = 4.44, beta = 13.31), SP1 = list(dist = "beta", alpha = 71.25, beta = 3.75), SE2 = list(dist = "beta", alpha = 21.96, beta = 5.49), SP2 = list(dist = "beta", alpha = 4.10, beta = 1.76), a1 = 0, b1 = 0 ) ) ## show model results strongy_indep ## fit Strongyloides 2-test model ## a second model allows for conditional dependence ## -> a[1] is the covariance between T1 and T2, given D+ ## -> b[1] is the covariance between T1 and T2, given D- ## -> a[1] and b[1] can range between +/- 2^-h, ie, (-.25, .25) strongy <- truePrevMulti2( x = c(38, 2, 87, 35), n = 162, prior = { TP ~ dbeta(1, 1) SE[1] ~ dbeta( 4.44, 13.31) SP[1] ~ dbeta(71.25, 3.75) SE[2] ~ dbeta(21.96, 5.49) SP[2] ~ dbeta( 4.10, 1.76) a[1] ~ dunif(-0.25, 0.25) b[1] ~ dunif(-0.25, 0.25) }) ## explore model structure str(strongy) # overall structure str(strongy@par) # structure of slot 'par' str(strongy@mcmc) # structure of slot 'mcmc' strongy@model # fitted model strongy@diagnostics # DIC, BGR and Bayes-P values ## standard methods print(strongy) summary(strongy) par(mfrow = c(2, 2)) plot(strongy) # shows plots of TP by default plot(strongy, "SE[1]") # same plots for SE1 plot(strongy, "SE[2]") # same plots for SE2 plot(strongy, "SP[1]") # same plots for SP1 plot(strongy, "SP[2]") # same plots for SP2 plot(strongy, "a[1]") # same plots for a[1] plot(strongy, "b[1]") # same plots for b[1] ## coda plots of all parameters par(mfrow = c(2, 4)); densplot(strongy, col = "red") par(mfrow = c(2, 4)); traceplot(strongy) par(mfrow = c(2, 4)); gelman.plot(strongy) par(mfrow = c(2, 4)); autocorr.plot(strongy) }}prevalence/man/plot-methods-coda.Rd0000644000175000017500000000313014246462542017123 0ustar nileshnilesh\name{plot-methods-coda} \docType{methods} \alias{plot-methods-coda} \alias{densplot-methods} \alias{densplot,prev-method} \alias{traceplot-methods} \alias{traceplot,prev-method} \alias{gelman.plot-methods} \alias{gelman.plot,prev-method} \alias{autocorr.plot-methods} \alias{autocorr.plot,prev-method} \title{Plotting functions from package \pkg{coda}} \description{ Different plotting functions from package \pkg{coda} have been made available as method to class \code{prev} } \usage{ \S4method{densplot}{prev}(x, exclude_fixed = TRUE, \dots) \S4method{traceplot}{prev}(x, exclude_fixed = TRUE, \dots) \S4method{autocorr.plot}{prev}(x, exclude_fixed = TRUE, chain = 1, \dots) } \arguments{ \item{x}{An object of class \code{prev}} \item{exclude_fixed}{Should fixed parameters be excluded from plotting? defaults to \code{TRUE}} \item{chain}{Which chain to plot in \code{autocorr.plot}; defaults to 1} \item{\dots}{Other arguments to pass to the specific plot function.} } \section{Methods}{ \describe{ \item{\code{signature(x = "prev")}}{ Show \link[coda:densplot]{density}, \link[coda:traceplot]{trace}, \link[coda:gelman.plot]{Brooks-Gelman-Rubin} and \link[coda:autocorr.plot]{autocorrelation} plots. } } } \seealso{ \code{\link{prev-class}}\cr \code{\link{plot-methods}}\cr \code{\link[coda:densplot]{densplot}}, \code{\link[coda:traceplot]{traceplot}}, \code{\link[coda:gelman.plot]{gelman.plot}}, \code{\link[coda:autocorr.plot]{autocorr.plot}} } \keyword{methods} prevalence/man/truePrev.Rd0000644000175000017500000001360614246467542015432 0ustar nileshnilesh\name{truePrev} \alias{truePrev} \title{Estimate true prevalence from individuals samples} \description{ Bayesian estimation of true prevalence from apparent prevalence obtained by testing \emph{individual} samples. } \usage{ truePrev(x, n, SE = 1, SP = 1, prior = c(1, 1), nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) } \arguments{ \item{x}{The apparent number of positive samples} \item{n}{The sample size} \item{SE, SP}{The prior distribution for sensitivity (SE) and specificity SP); see 'Details' below for specification of these distributions} \item{prior}{The parameters of the prior Beta distribution for true prevalence; defaults to \code{c(1, 1)}} \item{nchains}{The number of chains used in the estimation process; \code{'n'} must be \eqn{\ge 2}} \item{burnin}{The number of discarded model iterations; defaults to 10,000} \item{update}{The number of withheld model iterations; defaults to 10,000} \item{verbose}{Logical flag, indicating if JAGS process output should be printed to the R console; defaults to \code{FALSE}} } \details{ \code{truePrev} calls on \pkg{JAGS}/\pkg{\link[rjags:rjags]{rjags}} to estimate the true prevalence from the apparent prevalence in a Bayesian framework. The default model, in BUGS language, is given below. To see the actual fitted model, see the model slot of the \link[prevalence:prev-class]{prev}-object.\cr \preformatted{ model { x ~ dbin(AP, n) AP <- SE * TP + (1 - SP) * (1 - TP) # SE ~ user-defined (see below) # SP ~ user-defined (see below) TP ~ dbeta(prior[1], prior[2]) } } The test sensitivity (\code{SE}) and specificity (\code{SP}) can be specified, independently, as one of \code{"fixed"}, \code{"uniform"}, \code{"beta"}, \code{"pert"}, or \code{"beta-expert"}, with \code{"fixed"} as the default. Distribution parameters can be specified in a \emph{named} \code{list()} as follows: \itemize{ \item{\strong{Fixed: }}{\code{list(dist = "fixed", par)}} \item{\strong{Uniform: }}{\code{list(dist = "uniform", min, max)}} \item{\strong{Beta: }}{\code{list(dist = "beta", alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{list(dist = "pert", method, a, m, b, k)}\cr \code{'method'} must be \code{"classic"} or \code{"vose"};\cr \code{'a'} denotes the pessimistic (minimum) estimate, \code{'m'} the most likely estimate, and \code{'b'} the optimistic (maximum) estimate;\cr \code{'k'} denotes the scale parameter.\cr See \code{\link{betaPERT}} for more information on Beta-PERT parametrization.} \item{\strong{Beta-Expert: }}{\code{list(dist = "beta-expert", mode, mean, lower, upper, p)}\cr \code{'mode'} denotes the most likely estimate, \code{'mean'} the mean estimate;\cr \code{'lower'} denotes the lower bound, \code{'upper'} the upper bound;\cr \code{'p'} denotes the confidence level of the expert.\cr Only \code{mode} or \code{mean} should be specified; \code{lower} and \code{upper} can be specified together or alone.\cr See \code{\link{betaExpert}} for more information on Beta-Expert parametrization.} } For Uniform, Beta and Beta-PERT distributions, BUGS-style short-hand notation is also allowed: \itemize{ \item{\strong{Uniform: }}{\code{~dunif(min, max)}} \item{\strong{Beta: }}{\code{~dbeta(alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{~dpert(min, mode, max)}} }} \value{ An object of class \code{\link[prevalence:prev-class]{prev}}. } \note{ Markov chain Monte Carlo sampling in \code{truePrev} is performed by \pkg{JAGS (Just Another Gibbs Sampler)} through the \pkg{\link[rjags:rjags]{rjags}} package. JAGS can be downloaded from \url{https://mcmc-jags.sourceforge.io/}. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \references{ \itemize{ \item{Speybroeck N, Devleesschauwer B, Joseph L, Berkvens D (2013) Misclassification errors in prevalence estimation: Bayesian handling with care. \emph{Int J Public Health} \strong{58}:791-795} \item{Online Shiny application: \url{https://cbra.shinyapps.io/truePrev/}} } } \seealso{ \pkg{\link[coda:mcmc]{coda}} for various functions that can be applied to the \code{prev@mcmc} object\cr \code{\link{truePrevMulti}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a conditional probability scheme\cr \code{\link{truePrevMulti2}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a covariance scheme\cr \code{\link{truePrevPools}}: estimate true prevalence from apparent prevalence obtained by testing \emph{pooled} samples\cr \code{\link{betaPERT}}: calculate the parameters of a Beta-PERT distribution\cr \code{\link{betaExpert}}: calculate the parameters of a Beta distribution based on expert opinion } \examples{ ## Taenia solium cysticercosis in Nepal ## 142 positives out of 742 pigs sampled ## Model SE and SP based on literature data ## Sensitivity ranges uniformly between 60% and 100% ## Specificity ranges uniformly between 75% and 100% #> BUGS-style: truePrev(x = 142, n = 742, SE = ~dunif(0.60, 1.00), SP = ~dunif(0.75, 1.00)) #> list-style: SE <- list(dist = "uniform", min = 0.60, max = 1.00) SP <- list(dist = "uniform", min = 0.75, max = 1.00) truePrev(x = 142, n = 742, SE = SE, SP = SP) ## Model SE and SP based on expert opinions ## Sensitivity lies in between 60% and 100%; most likely value is 90% ## Specificity is with 95% confidence larger than 75%; most likely value is 90% SE <- list(dist = "pert", a = 0.60, m = 0.90, b = 1.00) SP <- list(dist = "beta-expert", mode = 0.90, lower = 0.75, p = 0.95) truePrev(x = 142, n = 742, SE = SE, SP = SP) ## Model SE and SP as fixed values (each 90%) truePrev(x = 142, n = 742, SE = 0.90, SP = 0.90) } prevalence/man/prev-class.Rd0000644000175000017500000000511014246462542015657 0ustar nileshnilesh\name{prev-class} \Rdversion{1.1} \docType{class} \alias{prev-class} \title{Class \code{"prev"}} \description{ The \code{"prev"} class represents output from Bayesian true prevalence estimation models. } \section{Objects from the Class}{ Objects of class \code{"prev"} are created by \code{\link{truePrev}}, \code{\link{truePrevMulti}}, \code{\link{truePrevMulti2}} and \code{\link{truePrevPools}}. } \section{Slots}{ Objects of class \code{"prev"} contain the following four slots: \describe{ \item{\code{par}:}{ A list of input parameters } \item{\code{model}:}{ The fitted Bayesian model, in BUGS language (S3 class \code{"prevModel"}) } \item{\code{mcmc}:}{ A list, with one element per chain, of the simulated true prevalences, sensitivities and specificities } \item{\code{diagnostics}:}{ A list with elements for the Deviance Information Criterion (\code{$DIC}), the Brooks-Gelman-Rubin statistic (\code{$BGR}), and in the case of \code{\link{truePrevMulti}} and \code{\link{truePrevMulti2}}, the Bayes-P statistic (\code{$bayesP}) } } } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \seealso{ \code{\link{truePrev}}, \code{\link{truePrevMulti}}, \code{\link{truePrevMulti2}}, \code{\link{truePrevPools}}\cr \code{\link{show-methods}}, \code{\link{print-methods}}, \code{\link{summary-methods}}, \code{\link{convert-methods}}, \code{\link{plot-methods}}, \code{\link{plot-methods-coda}} } \examples{ ## Taenia solium cysticercosis in Nepal SE <- list(dist = "uniform", min = 0.60, max = 1.00) SP <- list(dist = "uniform", min = 0.75, max = 1.00) TP <- truePrev(x = 142, n = 742, SE = SE, SP = SP) ## Summarize estimates per chain summary(TP) ## Diagnostic plots par(mfrow = c(2, 2)) plot(TP) ## Generic plots from package coda par(mfrow = c(1, 1)) densplot(TP) traceplot(TP) gelman.plot(TP) autocorr.plot(TP) ## Use 'slotNames()' to see the slots of object TP slotNames(TP) ## Every slot can be accessed using the '@' operator ## Use 'str()' to see the structure of each object str(TP@par) # input parameters str(TP@model) # fitted model str(TP@mcmc) # simulated TP, SE, SP str(TP@diagnostics) # DIC and BGR (and bayesP) ## Each element of TP@mcmc inherits from coda class 'mcmc.list' ## List all available methods for this class methods(class = "mcmc.list") ## List all available functions in the coda package library(help = "coda") ## Highest Posterior Density interval, from coda package coda::HPDinterval(TP@mcmc$TP) } \keyword{classes} prevalence/man/define.Rd0000644000175000017500000001151314246462542015036 0ustar nileshnilesh\name{define} \alias{define_x} \alias{define_prior} \alias{define_prior2} \title{Definition of \code{truePrevMulti} and \code{truePrevMulti2} model} \description{ These utility functions generate definitions for the test results and priors used by \code{\link{truePrevMulti}} and \code{\link{truePrevMulti2}}. } \usage{ define_x(h) define_prior(h) define_prior2(h) } \arguments{ \item{h}{ Number of tests } } \details{ The vector of apparent tests results, \code{x}, must contain the number of samples corresponding to each combination of test results. The models assume that the first value corresponds to the number of samples that tested positive on all tests and that the last value corresponds to the number of samples that tested negative on all tests.\cr Function \code{\link{truePrevMulti}} estimates true prevalence from individual samples tested with \code{h} tests, using the approach of Berkvens et al. (2006). The prior in the multinomial model consists of a vector \code{theta}, which holds values for the true prevalence (TP), the sensitivity and specificity of the first test (SE1, SP1), and the conditional dependencies between the results of the subsequent tests and the preceding one(s). \code{\link{define_prior}} generates the definition of \code{prior} for \code{h} tests. Function \code{\link{truePrevMulti2}} implements and extends the approach described by Dendukuri and Joseph (2001), which uses a multinomial distribution to model observed test results, and in which conditional dependence between tests is modelled through covariances. Argument \code{prior} consists of prior distributions for: \itemize{ \item{True Prevalence: \code{TP}} \item{SEnsitivity of each individual test: vector \code{SE}} \item{SPecificity of each individual test: vector \code{SP}} \item{Conditional covariance of all possible test combinations given a truly positive disease status: vector \code{a}} \item{Conditional covariance of all possible test combinations given a truly negative disease status: vector \code{b}} } \code{\link{define_prior2}} generates the definition of \code{prior} for \code{h} tests. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \references{ \itemize{ \item{Berkvens D, Speybroeck N, Praet N, Adel A, Lesaffre E (2006) Estimating disease prevalence in a Bayesian framework using probabilistic constraints. \emph{Epidemiology} \strong{17}:145-153} \item{Dendukuri N, Joseph L (2001) Bayesian approaches to modeling the conditional dependence between multiple diagnostic tests. \emph{Biometrics} \strong{57}:158-167} } } \seealso{ \code{\link{truePrevMulti}}, \code{\link{truePrevMulti2}} } \examples{ ## how is a 2-test model defined? define_x(2) # Definition of the apparent test results, 'x', for 2 tests: # x[1] : T1-,T2- # x[2] : T1-,T2+ # x[3] : T1+,T2- # x[4] : T1+,T2+ define_prior(2) # Conditional probability scheme # Definition of the prior, 'theta', for 2 tests: # theta[1] : P(D+) = TP # theta[2] : P(T1+|D+) = SE1 # theta[3] : P(T1-|D-) = SP1 # theta[4] : P(T2+|D+,T1+) # theta[5] : P(T2+|D+,T1-) # theta[6] : P(T2-|D-,T1-) # theta[7] : P(T2-|D-,T1+) define_prior2(2) # Covariance scheme # Definition of the prior for 2 tests: # TP : True Prevalence # SE[1] : Sensitity T1 # SE[2] : Sensitity T2 # SP[1] : Specificity T1 # SP[2] : Specificity T2 # a[1] : Covariance(T1,T2|D+) # b[1] : Covariance(T1,T2|D-) ## how is a 3-test model defined? define_x(3) # Definition of the apparent test results, 'x', for 3 tests: # x[1] : T1-,T2-,T3- # x[2] : T1-,T2-,T3+ # x[3] : T1-,T2+,T3- # x[4] : T1-,T2+,T3+ # x[5] : T1+,T2-,T3- # x[6] : T1+,T2-,T3+ # x[7] : T1+,T2+,T3- # x[8] : T1+,T2+,T3+ define_prior(3) # Conditional probability scheme # Definition of the prior, 'theta', for 3 tests: # theta[1] : P(D+) = TP # theta[2] : P(T1+|D+) = SE1 # theta[3] : P(T1-|D-) = SP1 # theta[4] : P(T2+|D+,T1+) # theta[5] : P(T2+|D+,T1-) # theta[6] : P(T2-|D-,T1-) # theta[7] : P(T2-|D-,T1+) # theta[8] : P(T3+|D+,T1+,T2+) # theta[9] : P(T3+|D+,T1+,T2-) # theta[10] : P(T3+|D+,T1-,T2+) # theta[11] : P(T3+|D+,T1-,T2-) # theta[12] : P(T3-|D-,T1-,T2-) # theta[13] : P(T3-|D-,T1-,T2+) # theta[14] : P(T3-|D-,T1+,T2-) # theta[15] : P(T3-|D-,T1+,T2+) define_prior2(3) # Covariance scheme # Definition of the prior for 3 tests: # TP : True Prevalence # SE[1] : Sensitity T1 # SE[2] : Sensitity T2 # SE[3] : Sensitity T3 # SP[1] : Specificity T1 # SP[2] : Specificity T2 # SP[3] : Specificity T3 # a[1] : Covariance(T1,T2|D+) # a[2] : Covariance(T1,T3|D+) # a[3] : Covariance(T2,T3|D+) # a[4] : Covariance(T1,T2,T3|D+) # b[1] : Covariance(T1,T2|D-) # b[2] : Covariance(T1,T3|D-) # b[3] : Covariance(T2,T3|D-) # b[4] : Covariance(T1,T2,T3|D-) } prevalence/man/show-methods.Rd0000644000175000017500000000101514246462542016221 0ustar nileshnilesh\name{show-methods} \docType{methods} \alias{show-methods} \alias{show,prev-method} \title{Methods for Function \code{show} in Package \pkg{prevalence}} \description{Show objects of class \code{prev}} \usage{\S4method{show}{prev}(object)} \arguments{ \item{object}{An object of class \code{prev}} } \section{Methods}{ \describe{ \item{\code{signature(object = "prev")}}{ Corresponds to \code{print(object)} } } } \seealso{ \code{\link{prev-class}} } \keyword{methods} prevalence/man/plot-methods.Rd0000644000175000017500000000212614246462542016223 0ustar nileshnilesh\name{plot-methods} \docType{methods} \alias{plot-methods} \alias{plot,prev-method} \alias{plot,prev,ANY-method} \title{Methods for Function \code{plot} in Package \pkg{prevalence}} \description{Plot objects of class \code{prev}} \usage{\S4method{plot}{prev,ANY}(x, y = NULL, \dots)} \arguments{ \item{x}{An object of class \code{prev}} \item{y}{Which parameter to plot? Defaults to \code{NULL}, in which case TP will be used} \item{\dots}{Other arguments to pass to the \code{plot} function} } \section{Methods}{ \describe{ \item{\code{signature(x = "prev", y = "ANY")}}{ Show \code{\link[prevalence:densplot-methods]{density}}, \code{\link[prevalence:traceplot-methods]{trace}}, \code{\link[prevalence:gelman.plot-methods]{Brooks-Gelman-Rubin}} and \code{\link[prevalence:autocorr.plot-methods]{autocorrelation}} plots. } } } \seealso{ \code{\link{prev-class}}\cr \code{\link{densplot-methods}}, \code{\link{traceplot-methods}}, \code{\link{gelman.plot-methods}}, \code{\link{autocorr.plot-methods}} } \keyword{methods} prevalence/man/truePrevMulti.Rd0000644000175000017500000002544714246467277016460 0ustar nileshnilesh\name{truePrevMulti} \alias{truePrevMulti} \title{Estimate true prevalence from individuals samples using multiple tests -- conditional probability scheme} \description{ Bayesian estimation of true prevalence from apparent prevalence obtained by applying \emph{multiple} tests to \emph{individual} samples. \code{\link{truePrevMulti}} implements the approach described by Berkvens et al. (2006), which uses a multinomial distribution to model observed test results, and in which conditional dependence between tests is modelled through conditional probabilities. } \usage{ truePrevMulti(x, n, prior, nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) } \arguments{ \item{x}{Vector of apparent test results; see 'Details' below} \item{n}{The total sample size} \item{prior}{The prior distribution for \code{theta}; see 'Details' below} \item{nchains}{The number of chains used in the estimation process; must be \eqn{\ge 2}} \item{burnin}{The number of discarded model iterations; defaults to 10,000} \item{update}{The number of withheld model iterations; defaults to 10,000} \item{verbose}{Logical flag, indicating if JAGS process output should be printed to the R console; defaults to \code{FALSE}} } \details{ \code{\link{truePrevMulti}} calls on \pkg{JAGS} via the \pkg{\link[rjags:rjags]{rjags}} package to estimate true prevalence from apparent prevalence in a Bayesian framework. \code{\link{truePrevMulti}} fits a multinomial model to the apparent test results obtained by testing individual samples with a given number of tests. To see the actual fitted model, see the model slot of the \code{\link[prevalence:prev-class]{prev}}-object.\cr The vector of apparent tests results, \code{x}, must contain the number of samples corresponding to each combination of test results. To see how this vector is defined for the number of tests \code{h} at hand, use \code{\link{define_x}}. The prior in the multinomial model consists of a vector \code{theta}, which holds values for the true prevalence (TP), the sensitivity and specificity of the first test (SE1, SP1), and the conditional dependencies between the results of the subsequent tests and the preceding one(s). To see how this vector is defined for the number of tests \code{n} at hand, use \code{\link{define_prior}}.\cr The values of \code{prior} can be specified in two ways, referred to as BUGS-style and list-style, respectively. See also below for some examples.\cr For BUGS-style specification, the values of \code{theta} should be given between curly brackets (i.e., \code{{}}), separated by line breaks. \code{theta} values can be specified to be deterministic (i.e., fixed), using the \code{<-} operator, or stochastic, using the \code{~} operator. In the latter case, the following distributions can be used: \itemize{ \item{\strong{Uniform: }}{\code{dunif(min, max)}} \item{\strong{Beta: }}{\code{dbeta(alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{dpert(min, mode, max)}} } Alternatively, \code{theta} values can be specified in a \emph{named} \code{list()} as follows: \itemize{ \item{\strong{Fixed: }}{\code{list(dist = "fixed", par)}} \item{\strong{Uniform: }}{\code{list(dist = "uniform", min, max)}} \item{\strong{Beta: }}{\code{list(dist = "beta", alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{list(dist = "pert", method, a, m, b, k)}\cr \code{'method'} must be \code{"classic"} or \code{"vose"};\cr \code{'a'} denotes the pessimistic (minimum) estimate, \code{'m'} the most likely estimate, and \code{'b'} the optimistic (maximum) estimate;\cr \code{'k'} denotes the scale parameter.\cr See \code{\link{betaPERT}} for more information on Beta-PERT parameterization.} \item{\strong{Beta-Expert: }}{\code{list(dist = "beta-expert", mode, mean, lower, upper, p)}\cr \code{'mode'} denotes the most likely estimate, \code{'mean'} the mean estimate;\cr \code{'lower'} denotes the lower bound, \code{'upper'} the upper bound;\cr \code{'p'} denotes the confidence level of the expert.\cr Only \code{mode} or \code{mean} should be specified; \code{lower} and \code{upper} can be specified together or alone.\cr See \code{\link{betaExpert}} for more information on Beta-Expert parameterization.} } } \value{ An object of class \code{\link[prevalence:prev-class]{prev}}. } \note{ Markov chain Monte Carlo sampling in \code{truePrevMulti} is performed by \pkg{JAGS (Just Another Gibbs Sampler)} through the \pkg{\link[rjags:rjags]{rjags}} package. JAGS can be downloaded from \url{https://mcmc-jags.sourceforge.io/}. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \references{ \itemize{ \item{Berkvens D, Speybroeck N, Praet N, Adel A, Lesaffre E (2006) Estimating disease prevalence in a Bayesian framework using probabilistic constraints. \emph{Epidemiology} \strong{17}:145-153} \item{Habib I, Sampers I, Uyttendaele M, De Zutter L, Berkvens D (2008) A Bayesian modelling framework to estimate \emph{Campylobacter} prevalence and culture methods sensitivity: application to a chicken meat survey in Belgium. \emph{J Appl Microbiol} \strong{105}:2002-2008} \item{Geurden T, Berkvens D, Casaert S, Vercruysse J, Claerebout E (2008) A Bayesian evaluation of three diagnostic assays for the detection of \emph{Giardia duodenalis} in symptomatic and asymptomatic dogs. \emph{Vet Parasitol} \strong{157}:14-20} } } \seealso{ \code{\link{define_x}}: how to define the vector of apparent test results \code{x}\cr \code{\link{define_prior}}: how to define the vector of \code{theta} values in \code{prior}\cr \pkg{\link[coda:mcmc]{coda}} for various functions that can be applied to the \code{prev@mcmc} object\cr \code{\link{truePrevMulti2}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a covariance scheme\cr \code{\link{truePrev}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with a single test\cr \code{\link{truePrevPools}}: estimate true prevalence from apparent prevalence obtained by testing \emph{pooled} samples\cr \code{\link{betaPERT}}: calculate the parameters of a Beta-PERT distribution\cr \code{\link{betaExpert}}: calculate the parameters of a Beta distribution based on expert opinion } \examples{ \dontrun{ ## ===================================================== ## ## 2-TEST EXAMPLE: Campylobacter ## ## ----------------------------------------------------- ## ## Two tests were performed on 656 chicken meat samples ## ## -> T1 = enrichment culture ## ## -> T2 = direct plating ## ## The following assumption were made: ## ## -> TP is larger than 45\% and smaller than 80\% ## ## -> SE1 must lie within 24\% and 50\% ## ## -> SP1 and SP2 both equal 100\% ## ## -> beta(30, 12) describes P(T2+|D+,T1+) ## ## The following results were obtained: ## ## -> 113 samples T1+,T2+ ## ## -> 46 samples T1+,T2- ## ## -> 156 samples T1-,T2+ ## ## -> 341 samples T1-,T2- ## ## ===================================================== ## ## how is the 2-test model defined? define_x(2) define_prior(2) ## fit campylobacter 2-test model campy <- truePrevMulti( x = c(113, 46, 156, 341), n = 656, prior = { theta[1] ~ dunif(0.45, 0.80) theta[2] ~ dunif(0.24, 0.50) theta[3] <- 1 theta[4] ~ dbeta(30, 12) theta[5] ~ dbeta(1, 1) theta[6] <- 1 theta[7] <- 1 } ) ## fit same model using 'list-style' campy <- truePrevMulti( x = c(113, 46, 156, 341), n = 656, prior = list( theta1 = list(dist = "uniform", min = 0.45, max = 0.80), theta2 = list(dist = "uniform", min = 0.24, max = 0.50), theta3 = 1, theta4 = list(dist = "beta", alpha = 30, beta = 12), theta5 = list(dist = "beta", alpha = 1, beta = 1), theta6 = 1, theta7 = 1 ) ) ## show model results campy ## explore model structure str(campy) # overall structure str(campy@par) # structure of slot 'par' str(campy@mcmc) # structure of slot 'mcmc' campy@model # fitted model campy@diagnostics # DIC, BGR and Bayes-P values ## standard methods print(campy) summary(campy) par(mfrow = c(2, 2)) plot(campy) # shows plots of TP by default plot(campy, "SE1") # same plots for SE1 plot(campy, "SE2") # same plots for SE2 ## coda plots of TP, SE1, SE2 par(mfrow = c(1, 3)) densplot(campy, col = "red") traceplot(campy) gelman.plot(campy) autocorr.plot(campy) ## ===================================================== ## ## 3-TEST EXAMPLE: Giardia ## ## ----------------------------------------------------- ## ## Three tests were performed on stools from 272 dogs ## ## -> T1 = immunofluorescence assay ## ## -> T2 = direct microscopy ## ## -> T3 = SNAP immunochromatography ## ## The following assumption were made: ## ## -> TP is smaller than 20\% ## ## -> SE1 must be higher than 80\% ## ## -> SP1 must be higher than 90\% ## ## The following results were obtained: ## ## -> 6 samples T1+,T2+,T3+ ## ## -> 4 samples T1+,T2+,T3- ## ## -> 12 samples T1+,T2-,T3+ ## ## -> 12 samples T1+,T2-,T3- ## ## -> 1 sample T1-,T2+,T3+ ## ## -> 14 samples T1-,T2+,T3- ## ## -> 3 samples T1-,T2-,T3+ ## ## -> 220 samples T1-,T2-,T3- ## ## ===================================================== ## ## how is the 3-test model defined? define_x(3) define_prior(3) ## fit giardia 3-test model giardia <- truePrevMulti( x = c(6, 4, 12, 12, 1, 14, 3, 220), n = 272, prior = { theta[1] ~ dunif(0.00, 0.20) theta[2] ~ dunif(0.90, 1.00) theta[3] ~ dunif(0.80, 1.00) theta[4] ~ dbeta(1, 1) theta[5] ~ dbeta(1, 1) theta[6] ~ dbeta(1, 1) theta[7] ~ dbeta(1, 1) theta[8] ~ dbeta(1, 1) theta[9] ~ dbeta(1, 1) theta[10] ~ dbeta(1, 1) theta[11] ~ dbeta(1, 1) theta[12] ~ dbeta(1, 1) theta[13] ~ dbeta(1, 1) theta[14] ~ dbeta(1, 1) theta[15] ~ dbeta(1, 1) } ) ## show model results giardia ## coda densplots par(mfcol = c(2, 4)) densplot(giardia, col = "red") }}prevalence/man/propCI.Rd0000644000175000017500000000603414246462542015002 0ustar nileshnilesh\name{propCI} \alias{propCI} \title{Calculate confidence intervals for prevalences and other proportions} \description{ The \code{propCI} function calculates five types of confidence intervals for proportions: \itemize{ \item{Wald interval (= Normal approximation interval, asymptotic interval)} \item{Agresti-Coull interval (= adjusted Wald interval)} \item{Exact interval (= Clopper-Pearson interval)} \item{Jeffreys interval (= Bayesian interval)} \item{Wilson score interval} } } \usage{ propCI(x, n, method = "all", level = 0.95, sortby = "level") } \arguments{ \item{x}{Number of successes (positive samples)} \item{n}{Number of trials (sample size)} \item{method}{Confidence interval calculation method; see details} \item{level}{Confidence level for confidence intervals} \item{sortby}{Sort results by \code{"level"} or \code{"method"}} } \details{ Five methods are available for calculating confidence intervals. For convenience, synonyms are allowed. Please refer to the PDF version of the manual for proper formatting of the below formulas. \describe{ \item{\code{"agresti.coull", "agresti-coull", "ac"}}{ \deqn{\tilde{n} = n + z_{1-\frac{\alpha}{2}}^2} \deqn{\tilde{p} = \frac{1}{\tilde{n}}(x + \frac{1}{2} z_{1-\frac{\alpha}{2}}^2)} \deqn{\tilde{p} \pm z_{1-\frac{\alpha}{2}} \sqrt{\frac{\tilde{p}(1-\tilde{p})}{\tilde{n}}}} } \item{\code{"exact", "clopper-pearson", "cp"}}{ \deqn{(Beta(\frac{\alpha}{2}; x, n - x + 1), Beta(1 - \frac{\alpha}{2}; x + 1, n - x))} } \item{\code{"jeffreys", "bayes"}}{ \deqn{(Beta(\frac{\alpha}{2}; x + 0.5, n - x + 0.5), Beta(1 - \frac{\alpha}{2}; x + 0.5, n - x + 0.5))} } \item{\code{"wald", "asymptotic", "normal"}}{ \deqn{p \pm z_{1-\frac{\alpha}{2}} \sqrt{\frac{p(1-p)}{n}}} } \item{\code{"wilson"}}{ \deqn{ \frac{p + \frac{z_{1-\frac{\alpha}{2}}^2}{2n} \pm z_{1-\frac{\alpha}{2}} \sqrt{\frac{p(1-p)}{n} + \frac{z_{1-\frac{\alpha}{2}}^2}{4n^2}}} {1 + \frac{z_{1-\frac{\alpha}{2}}^2}{n}} } } } } \note{ In case the observed prevalence equals 0\% (ie, \code{x == 0}), an upper one-sided confidence interval is returned. In case the observed prevalence equals 100\% (ie, \code{x == n}), a lower one-sided confidence interval is returned. In all other cases, two-sided confidence intervals are returned. } \value{ Data frame with seven columns: \item{x }{Number of successes (positive samples)} \item{n }{Number of trials (sample size)} \item{p }{Proportion of successes (prevalence)} \item{method }{Confidence interval calculation method} \item{level }{Confidence level} \item{lower }{Lower confidence limit} \item{upper }{Upper confidence limit} } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \examples{ ## All methods, 95% confidence intervals propCI(x = 142, n = 742) ## Wald-type 90%, 95% and 99% confidence intervals propCI(x = 142, n = 742, method = "wald", level = c(0.90, 0.95, 0.99)) } \keyword{prevalence} \keyword{confidence interval} prevalence/man/prevalence-package.Rd0000644000175000017500000000435114246467405017326 0ustar nileshnilesh\name{prevalence-package} \alias{prevalence-package} \alias{prevalence} \docType{package} \title{Tools for prevalence assessment studies} \description{ The \pkg{prevalence} package provides Frequentist and Bayesian methods useful in prevalence assessment studies. Visit \url{http://prevalence.cbra.be/} for more information and tutorials. } \details{ \tabular{ll}{ Package: \tab prevalence\cr Type: \tab Package\cr Version: \tab 0.4.1\cr Date: \tab 2022-06-03\cr BugReports: \tab \url{https://github.com/brechtdv/prevalence/issues}\cr Depends: \tab R (>= 4.0.0), rjags, coda, methods\cr SystemRequirements: \tab JAGS (>= 3.2.0) (see \url{https://mcmc-jags.sourceforge.io/})\cr License: \tab GNU >= 2\cr } Available functions in the \pkg{prevalence} package: \tabular{ll}{ \code{\link{propCI}} \tab Derive confidence intervals for an apparent prevalence estimate\cr \code{\link{truePrev}} \tab Estimate TP from AP obtained by testing individual samples with a single test\cr \code{\link{truePrevMulti}} \tab Estimate TP from AP obtained by testing individual samples with multiple tests, using a conditional probability scheme\cr \code{\link{truePrevMulti2}} \tab Estimate TP from AP obtained by testing individual samples with multiple tests, using a covariance scheme\cr \code{\link{truePrevPools}} \tab Estimate TP from AP obtained by testing pooled samples\cr \code{\link{betaPERT}} \tab Calculate the parameters of a Beta-PERT distribution\cr \code{\link{betaExpert}} \tab Calculate the parameters of a Beta distribution based on expert opinion } \strong{IMPORTANT}: the \code{truePrev} functions in the \pkg{prevalence} package call on \pkg{JAGS (Just Another Gibbs Sampler)}, through the \pkg{\link[rjags:rjags]{rjags}} package. Therefore, JAGS has to be installed on the user's system.\cr\cr JAGS can be downloaded from \url{https://mcmc-jags.sourceforge.io/} } \author{ \strong{Creator, Maintainer}\cr Brecht Devleesschauwer <\email{brechtdv@gmail.com}>\cr\cr \strong{Contributors}\cr Paul Torgerson, Johannes Charlier, Bruno Levecke, Nicolas Praet, Sophie Roelandt, Suzanne Smit, Pierre Dorny, Dirk Berkvens, Niko Speybroeck } \keyword{package} prevalence/man/convert-methods.Rd0000644000175000017500000000262314246462542016727 0ustar nileshnilesh\name{convert-methods} \docType{methods} \alias{convert-methods} \alias{as.matrix-methods} \alias{as.matrix,prev-method} \title{Methods for Function \code{as.matrix} in Package \pkg{prevalence}} \description{Convert objects of class \code{prev} to matrix} \usage{\S4method{as.matrix}{prev}(x, iters = FALSE, chains = FALSE)} \arguments{ \item{x}{An object of class \code{prev}} \item{iters}{Logical flag, indicating whether a column should be added for iteration number; defaults to \code{FALSE}} \item{chains}{Logical flag, indicating whether a column should be added for chain number; defaults to \code{FALSE}} } \section{Methods}{ \describe{ \item{\code{signature(x = "prev")}}{ Convert objects of class \code{prev} to \code{\link{matrix}} } } } \seealso{ \code{\link{prev-class}} } \examples{\dontrun{ ## Taenia solium cysticercosis 1-test model cysti <- truePrev(x = 142, n = 742, SE = ~dunif(0.60, 1.00), SP = ~dunif(0.75, 1.00)) head(as.matrix(cysti)) ## Campylobacter 2-test model campy <- truePrevMulti( x = c(113, 46, 156, 341), n = 656, prior = { theta[1] ~ dunif(0.45, 0.80) theta[2] ~ dunif(0.24, 0.50) theta[3] <- 1 theta[4] ~ dbeta(30, 12) theta[5] ~ dbeta(1, 1) theta[6] <- 1 theta[7] <- 1 } ) head(as.matrix(campy, iters = TRUE, chains = TRUE)) }} \keyword{methods} prevalence/man/truePrevPools.Rd0000644000175000017500000001422514246467172016444 0ustar nileshnilesh\name{truePrevPools} \alias{truePrevPools} \title{Estimate true prevalence from pooled samples} \description{ Bayesian estimation of true prevalence from apparent prevalence obtained by testing \emph{pooled} samples. } \usage{ truePrevPools(x, n, SE = 1, SP = 1, prior = c(1, 1), nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) } \arguments{ \item{x}{The vector of indicator variables, indicating whether a pool was positive (\code{"1"}) or negative (\code{"0"})} \item{n}{The vector of pool sizes} \item{SE, SP}{The prior distribution for sensitivity (SE) and specificity (SP); see 'Details' below for specification of these distributions} \item{prior}{The parameters of the prior Beta distribution for true prevalence; defaults to \code{c(1, 1)}} \item{nchains}{The number of chains used in the estimation process; \code{nchains} must be \eqn{\ge 2}} \item{burnin}{The number of discarded model iterations; defaults to 10,000} \item{update}{The number of withheld model iterations; defaults to 10,000} \item{verbose}{Logical flag, indicating if JAGS process output should be printed to the R console; defaults to \code{FALSE}} } \details{ \code{truePrevPools} calls on \pkg{JAGS}/\pkg{\link[rjags:rjags]{rjags}} to estimate the true prevalence from the apparent prevalence in a Bayesian framework. The default model, in BUGS language, is given below. To see the actual fitted model, see the model slot of the \link[prevalence:prev-class]{prev}-object.\cr \preformatted{ model { for (i in 1:N) { x[i] ~ dbern(AP[i]) AP[i] <- SEpool[i] * (1 - pow(1 - TP, n[i])) + (1 - SPpool[i]) * pow(1 - TP, n[i]) SEpool[i] <- 1 - (pow(1 - SE, n[i] * TP) * pow(SP, n[i] * (1 - TP))) SPpool[i] <- pow(SP, n[i]) } # SE ~ user-defined (see below) # SP ~ user-defined (see below) TP ~ dbeta(prior[1], prior[2]) } } The test sensitivity (\code{SE}) and specificity (\code{SP}) can be specified by the user, independently, as one of \code{"fixed"}, \code{"uniform"}, \code{"beta"}, \code{"pert"}, or \code{"beta-expert"}, with \code{"fixed"} as the default. Note that \code{SE} and \code{SP} must correspond to the test characteristics for testing individual samples; \code{truePrevPools} will calculate \code{SEpool} and \code{SPpool}, the sensitivity and specificitiy for testing pooled samples, based on Boelaert et al. (2000). Distribution parameters can be specified in a \emph{named} \code{list()} as follows: \itemize{ \item{\strong{Fixed: }}{\code{list(dist = "fixed", par)}} \item{\strong{Uniform: }}{\code{list(dist = "uniform", min, max)}} \item{\strong{Beta: }}{\code{list(dist = "beta", alpha, beta)}} \item{\strong{PERT: }}{\code{list(dist = "pert", method, a, m, b, k)}\cr \code{'method'} must be \code{"classic"} or \code{"vose"};\cr \code{'a'} denotes the pessimistic (minimum) estimate, \code{'m'} the most likely estimate, and \code{'b'} the optimistic (maximum) estimate;\cr \code{'k'} denotes the scale parameter.\cr See \code{\link{betaPERT}} for more information on Beta-PERT parametrization.} \item{\strong{Beta-Expert: }}{\code{list(dist = "beta-expert", mode, mean, lower, upper, p)}\cr \code{'mode'} denotes the most likely estimate, \code{'mean'} the mean estimate;\cr \code{'lower'} denotes the lower bound, \code{'upper'} the upper bound;\cr \code{'p'} denotes the confidence level of the expert.\cr Only \code{mode} or \code{mean} should be specified; \code{lower} and \code{upper} can be specified together or alone.\cr See \code{\link{betaExpert}} for more information on Beta-Expert parameterization.} } For Uniform, Beta and Beta-PERT distributions, BUGS-style short-hand notation is also allowed: \itemize{ \item{\strong{Uniform: }}{\code{~dunif(min, max)}} \item{\strong{Beta: }}{\code{~dbeta(alpha, beta)}} \item{\strong{Beta-PERT: }}{\code{~dpert(min, mode, max)}} }} \value{ An object of class \link[prevalence:prev-class]{prev}. } \note{ Markov chain Monte Carlo sampling in \code{truePrevPools} is performed by \pkg{JAGS (Just Another Gibbs Sampler)} through the \pkg{\link[rjags:rjags]{rjags}} package. JAGS can be downloaded from \url{https://mcmc-jags.sourceforge.io/}. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \references{ \itemize{ \item{Speybroeck N, Williams CJ, Lafia KB, Devleesschauwer B, Berkvens D (2012) Estimating the prevalence of infections in vector populations using pools of samples. \emph{Med Vet Entomol} \strong{26}:361-371} \item{Boelaert F, Walravens K, Biront P, Vermeersch JP, Berkvens D, Godfroid J (2000) Prevalence of paratuberculosis (Johne's disease) in the Belgian cattle population. \emph{Vet Microbiol} \strong{77}:269-281} }} \seealso{ \pkg{\link[coda:mcmc]{coda}} for various functions that can be applied to the \code{prev@mcmc} object\cr \code{\link{truePrev}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with a single test\cr \code{\link{truePrevMulti}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a conditional probability scheme\cr \code{\link{truePrevMulti2}}: estimate true prevalence from apparent prevalence obtained by testing \emph{individual} samples with multiple tests, using a covariance scheme\cr \code{\link{betaPERT}}: calculate the parameters of a Beta-PERT distribution\cr \code{\link{betaExpert}}: calculate the parameters of a Beta distribution based on expert opinion } \examples{ ## Sandflies in Aurabani, Nepal, 2007 pool_results <- c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0) pool_sizes <- c(2, 1, 6, 10, 1, 7, 1, 4, 1, 3) ## Sensitivity ranges uniformly between 60% and 95% ## Specificity is considered to be 100% #> BUGS-style: truePrevPools(x = pool_results, n = pool_sizes, SE = ~dunif(0.60, 0.95), SP = 1) #> list-style: SE <- list(dist = "uniform", min = 0.60, max = 0.95) truePrevPools(x = pool_results, n = pool_sizes, SE = SE, SP = 1) } prevalence/man/betaExpert.Rd0000644000175000017500000000724414246467131015714 0ustar nileshnilesh\name{betaExpert} \alias{betaExpert} \alias{print.betaExpert} \alias{plot.betaExpert} \title{Calculate the parameters of a Beta distribution based on expert information} \description{ The \code{\link{betaExpert}} function fits a (standard) Beta distribution to expert opinion. The expert provides information on a best-guess estimate (mode or mean), and an uncertainty range: \itemize{ \item{The parameter value is with \code{100*p\%} certainty greater than \code{lower}} \item{The parameter value is with \code{100*p\%} certainty smaller than \code{upper}} \item{The parameter value lies with \code{100*p\%} in between \code{lower} and \code{upper}} } } \usage{ betaExpert(best, lower, upper, p = 0.95, method = "mode") \method{print}{betaExpert}(x, conf.level = .95, \dots) \method{plot}{betaExpert}(x, y, \dots) } \arguments{ \item{best}{Best-guess estimate; see argument \code{method}} \item{lower}{Lower uncertainty limit} \item{upper}{Upper uncertainty limit} \item{p}{Expert's certainty level} \item{method}{Does best-guess estimate correspond to the \code{mode} or to the \code{mean}? Defaults to \code{mode}} \item{x}{Object of class \code{betaExpert}} \item{y}{Currently not implemented} \item{conf.level}{Confidence level used in printing quantiles of resulting Beta distribution} \item{\dots}{Other arguments to pass to function \code{print} and \code{plot}} } \details{ The methodology behind the \code{\link{betaExpert}} function is presented by Branscum et al. (2005) and implemented in the \emph{BetaBuster} software, written by Chun-Lung Su.\cr\cr The parameters of a standard Beta distribution are calculated based on a best-guess estimate and a 100(\eqn{p})\% uncertainty range, defined by a lower and/or upper limit. The \code{betaExpert} function uses minimization (\code{\link{optimize}}) to derive \eqn{\alpha} and \eqn{\beta} from this best guess and lower and/or upper limit. The resulting distribution is a standard 2-parameter Beta distribution: Beta(\eqn{\alpha}, \eqn{\beta}). } \value{ A list of class \code{"betaExpert"}: \item{alpha }{Parameter \eqn{\alpha} (shape1) of the Beta distribution} \item{beta }{Parameter \eqn{\beta} (shape2) of the Beta distribution} The \code{print} method for \code{"betaExpert"} additionally calculates the mean, median, mode, variance and range of the corresponding Beta distribution. } \references{ Branscum AJ, Gardner IA, Johnson WO (2005) Estimation of diagnostic-test sensitivity and specificity through Bayesian modeling. \emph{Prev Vet Med} \strong{68}:145-163. } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \seealso{ Package \pkg{\href{https://cran.r-project.org/package=rriskDistributions}{rriskDistributions}}, which provides a collection of functions for fitting distributions to given data or by known quantiles.\cr \code{\link{betaPERT}}, for modelling a generalized Beta distribution based on expert opinion } \examples{ ## Most likely value (mode) is 90% ## Expert states with 95% certainty that true value is larger than 70% betaExpert(best = 0.90, lower = 0.70, p = 0.95) ## Most likely value (mode) is 0% ## Expert states with 95% certainty that true value is smaller than 40% betaExpert(best = 0, upper = 0.40, p = 0.95) ## Most likely value (mode) is 80% ## Expert states with 90% certainty that true value lies in between 40% and 90% betaExpert(best = 0.80, lower = 0.40, upper = 0.90, p = 0.90) ## Mean value is assumed to be 80% ## Expert states with 90% certainty that true value lies in between 40% and 90% betaExpert(best = 0.80, lower = 0.40, upper = 0.90, p = 0.90, method = "mean") } \keyword{Expert} prevalence/man/betaPERT.Rd0000644000175000017500000001155414246467114015217 0ustar nileshnilesh\name{betaPERT} \alias{betaPERT} \alias{print.betaPERT} \alias{plot.betaPERT} \title{Calculate the parameters of a Beta-PERT distribution} \description{ The Beta-PERT methodology allows to parametrize a generalized Beta distribution based on expert opinion regarding a pessimistic estimate (minimum value), a most likely estimate (mode), and an optimistic estimate (maximum value). The \code{betaPERT} function incorporates two methods of calculating the parameters of a Beta-PERT distribution, designated \code{"classic"} and \code{"vose"}. } \usage{ betaPERT(a, m, b, k = 4, method = c("classic", "vose")) \method{print}{betaPERT}(x, conf.level = .95, \dots) \method{plot}{betaPERT}(x, y, \dots) } \arguments{ \item{a}{Pessimistic estimate (Minimum value)} \item{m}{Most likely estimate (Mode)} \item{b}{Optimistic estimate (Maximum value)} \item{k}{Scale parameter} \item{method}{\code{"classic"} or \code{"vose"}; see details below} \item{x}{Object of class \code{betaPERT}} \item{y}{Currently ignored} \item{conf.level}{Confidence level used in printing quantiles of resulting Beta-PERT distribution} \item{\dots}{Other arguments to pass to function \code{print} and \code{plot}} } \details{ The Beta-PERT methodology was developed in the context of Program Evaluation and Review Technique (PERT). Based on a pessimistic estimate (minimum value), a most likely estimate (mode), and an optimistic estimate (maximum value), typically derived through expert elicitation, the parameters of a Beta distribution can be calculated. The Beta-PERT distribution is used in stochastic modeling and risk assessment studies to reflect uncertainty regarding specific parameters. Different methods exist in literature for defining the parameters of a Beta distribution based on PERT. The two most common methods are included in the \code{BetaPERT} function: \describe{ \item{\strong{Classic}: }{The standard formulas for mean, standard deviation, \eqn{\alpha} and \eqn{\beta}, are as follows: \deqn{mean = \frac{a + k*m + b}{k + 2}}{mean = (a + k*m + b) / (k + 2)} \deqn{sd = \frac{b - a}{k + 2}}{sd = (b - a) / (k + 2)} \deqn{\alpha = \frac{mean - a}{b - a} * \left\{ (mean - a) * \frac{b - mean}{sd^{2}} - 1 \right\} }{ \alpha = \{ (mean - a) / (b - a) \} * \{ (mean - a) * (b - mean) / sd^{2} - 1 \} } \deqn{\beta = \alpha * \frac{b - mean}{mean - a}}{\beta = \alpha * (b - mean) / (mean - a)} The resulting distribution is a 4-parameter Beta distribution: Beta(\eqn{\alpha}, \eqn{\beta}, a, b).\cr } \item{\strong{Vose}: }{Vose (2000) describes a different formula for \eqn{\alpha}: \deqn{(mean - a) * \frac{2 * m - a - b}{(m - mean) * (b - a)}}{(mean - a) * (2 * m - a - b) / \{ (m - mean) * (b - a) \}} Mean and \eqn{\beta} are calculated using the standard formulas; as for the classical PERT, the resulting distribution is a 4-parameter Beta distribution: Beta(\eqn{\alpha}, \eqn{\beta}, a, b).\cr\cr Note: If \eqn{m = mean}, \eqn{\alpha} is calculated as \eqn{1 + k/2}, in accordance with the \pkg{mc2d} package (see 'Note').\cr } } } \value{ A list of class \code{"betaPERT"}: \item{alpha }{Parameter \eqn{\alpha} (shape1) of the Beta distribution} \item{beta }{Parameter \eqn{\beta} (shape2) of the Beta distribution} \item{a }{Pessimistic estimate (Minimum value)} \item{m }{Most likely estimate (Mode)} \item{b }{Optimistic estimate (Maximum value)} \item{method }{Applied method} Available generic functions for class \code{"betaPERT"} are \code{print} and \code{plot}. } \references{ \describe{ \item{\strong{Classic}: }{ Malcolm DG, Roseboom JH, Clark CE, Fazar W (1959) Application of a technique for research and development program evaluation. \emph{Oper Res} \strong{7}(5):646-669. } \item{\strong{Vose}: }{ David Vose. \emph{Risk analysis, a quantitative guide, 2nd edition.} Wiley and Sons, 2000.\cr \href{http://vosesoftware.com/ModelRiskHelp/index.htm\#Distributions/Continuous_distributions/PERT_distribution.htm}{PERT distribution in \emph{ModelRisk} (Vose software)} } } } \author{ Brecht Devleesschauwer <\email{brechtdv@gmail.com}> } \note{ The \pkg{\href{https://cran.r-project.org/package=mc2d}{mc2d}} package provides the probability density function, cumulative distribution function, quantile function and random number generation function for the PERT distribution, parametrized by the \code{"vose"} method. } \seealso{ \code{\link{betaExpert}}, for modelling a standard Beta distribution based on expert opinion } \examples{ ## The value of a parameter of interest is believed to lie between 0 and 50 ## The most likely value is believed to be 10 # Classical PERT betaPERT(a = 0, m = 10, b = 50, method = "classic") # Vose parametrization betaPERT(a = 0, m = 10, b = 50, method = "vose") } \keyword{Expert} \keyword{PERT} prevalence/man/summary-methods.Rd0000644000175000017500000000136014246462542016741 0ustar nileshnilesh\name{summary-methods} \docType{methods} \alias{summary-methods} \alias{summary,prev-method} \title{Methods for Function \code{summary} in Package \pkg{prevalence}} \description{Summarize objects of class \code{prev}} \usage{\S4method{summary}{prev}(object, conf.level)} \arguments{ \item{object}{An object of class \code{prev}} \item{conf.level}{Confidence level to be used in credibility intervals} } \section{Methods}{ \describe{ \item{\code{signature(object = "prev")}}{ Obtain mean, median, mode, standard deviation, variance, credibility interval and number of samples for each chain separately and for all chains combined. } } } \seealso{ \code{\link{prev-class}}\cr } \keyword{methods} prevalence/R/0000755000175000017500000000000014246462542012742 5ustar nileshnileshprevalence/R/propCI-jeffreys.R0000644000175000017500000000022414246462542016072 0ustar nileshnileshpropCI_jeffreys <- function(x, n, l){ lw <- qbeta(l[1], x + .5, n - x + .5) up <- qbeta(l[2], x + .5, n - x + .5) return(c(lw, up)) }prevalence/R/writeSeSp.R0000644000175000017500000000220114246462542015005 0ustar nileshnileshwriteSeSp <- function(f, x){ out <- character() if (x$d[1] == "pert"){ pertK <- ifelse(is.null(x$p[4]), 4, x$p[4]) pertM <- x$d[2] betaPERT <- betaPERT(a = x$p[1], m = x$p[2], b = x$p[3], k = pertK, method = pertM) if (pertM == "branscum"){ distSpec <- paste0("~ dbeta(", betaPERT$alpha, ", ", betaPERT$beta, ")") } else { fp <- paste0(gsub("\\]", "", gsub("\\[", "", f)), "p") dif <- betaPERT$b - betaPERT$a distSpec1 <- paste0("<- ", fp, " * ", dif, " + ", betaPERT$a) distSpec2 <- paste0("~ dbeta(", betaPERT$alpha, ", ", betaPERT$beta, ")") out <- c(out, paste(f, distSpec1)) out <- c(out, paste(fp, distSpec2)) } } if (x$d[1] == "fixed"){ distSpec <- paste0("<- ", x$p) out <- c(out, paste(f, distSpec)) } if (x$d[1] == "uniform"){ distSpec <- paste0("~ dunif(", x$p[1], ", ", x$p[2], ")") out <- c(out, paste(f, distSpec)) } if (x$d[1] == "beta"){ distSpec <- paste0("~ dbeta(", x$p[1], ", ", x$p[2], ")") out <- c(out, paste(f, distSpec)) } return(out) }prevalence/R/propCI-agresticoull.R0000644000175000017500000000112614246462542016754 0ustar nileshnileshpropCI_agresticoull <- function(x, n, l){ if (x == 0){ t <- n + qnorm(2 * l[3]) ^ 2 p <- (x + .5 * (qnorm(2 * l[3])) ^ 2) / t lw <- 0 up <- p - qnorm(2 * l[3]) * sqrt(p * (1 - p) / t) } else if (x == n){ t <- n + qnorm(2 * l[3]) ^ 2 p <- (x + .5 * (qnorm(2 * l[3])) ^ 2) / t lw <- p + qnorm(2 * l[3]) * sqrt(p * (1 - p) / t) up <- 1 } else{ t <- n + qnorm(l[3]) ^ 2 p <- (x + .5 * (qnorm(l[3])) ^ 2) / t lw <- p + qnorm(l[3]) * sqrt(p * (1 - p) / t) up <- p - qnorm(l[3]) * sqrt(p * (1 - p) / t) } return(c(lw, up)) }prevalence/R/truePrevBinom.R0000644000175000017500000000403514246462542015670 0ustar nileshnileshtruePrevBinom <- function(x, n, Se, Sp, prior, nchains, burnin, update, verbose){ ## create model model <- character() model[1] <- "model {" model[2] <- "x ~ dbin(AP, n)" model[3] <- "AP <- SE * TP + (1 - SP) * (1 - TP)" model <- c(model, writeSeSp("SE", Se)) model <- c(model, writeSeSp("SP", Sp)) model <- c(model, paste0("TP ~ dbeta(", prior[1], ", ", prior[2], ")")) model <- c(model, "}") class(model) <- "prevModel" ## create data data <- list(x = x, n = n) ## generate inits inits <- NULL ## get results! if (verbose) cat("JAGS progress:\n\n") JAGSout <- R2JAGS(model = model, data = data, inits = inits, nchains = nchains, burnin = burnin, update = update, nodes = c("TP", "SE", "SP"), verbose = verbose) mcmc.list <- JAGSout$mcmc.list class(mcmc.list) <- c("list", "mcmc.list") nodes <- colnames(mcmc.list[[1]]) # extract node names mcmc.list_list <- list() # initiate list for (i in seq_along(nodes)) # assign nodes mcmc.list_list[[i]] <- mcmc.list[, i] names(mcmc.list_list) <- nodes # assign node names mcmc.list_list <- mcmc.list_list[c("TP", "SE", "SP")] # reorder elements ## define diagnostics # deviance information criterion DIC <- JAGSout$dic # brooks-gelman-rubin diagnostic # exclude fixed nodes exclude <- which(apply(mcmc.list[[1]], 2, sd) == 0) if (length(exclude) > 0) { BGR <- gelman.diag(mcmc.list[, -exclude]) } else { BGR <- gelman.diag(mcmc.list) } ## create new 'prev' object out <- new("prev", par = list(x = x, n = n, SE = Se, SP = Sp, prior = prior, nchains = nchains, burnin = burnin, update = update, inits = inits), model = model, mcmc = mcmc.list_list, diagnostics = list(DIC = DIC, BGR = BGR)) return(out) }prevalence/R/checkSeSp.R0000644000175000017500000001465414246462542014747 0ustar nileshnileshcheckSeSp <- function(x, type = "prob") { distr <- NULL param <- NULL if (length(x) > 6) warning("Too many parameters specified") if (length(x) == 1) { distr <- "fixed" ## probability is constrained in (0,1) if (type == "prob" && (x < 0 | x > 1)) stop("Parameter 'par' of fixed distribution must be", " numeric value between 0 and 1") ## covariance is constrained in +/- 2^-h if (is.numeric(type) && (abs(x) > 2^-type)) stop("Parameter 'par' of fixed distribution must be", " numeric value between +/-", 2^-type) param <- x } else { distr <- x$dist } if (is.list(x) && length(unlist(x)) > length(x)) stop("Parameters cannot be specified as vectors") if (is.null(distr)) stop("No distribution specified") if (!is.character(distr)) stop("Invalid distribution specified") distr <- tolower(distr) if (!any(c("fixed", "uniform", "pert", "beta", "beta-expert") == distr)) stop("Distribution must be", " 'fixed', 'uniform', 'pert', 'beta' or 'beta-expert'") ## Fixed distribution if (distr == "fixed" & is.null(param)) { if (length(x) > 2) warning("A fixed distribution requires only 1 parameter") if (is.null(x$par)) stop("Parameter 'par' not specified") ## probability is constrained in (0,1) if (type == "prob" && (x$par < 0 | x$par > 1)) stop("Parameter 'par' of fixed distribution must be", " numeric value between 0 and 1") ## covariance is constrained in +/- 2^-h if (is.numeric(type) && (abs(x$par) > 2^-type)) stop("Parameter 'par' of fixed distribution must be", " numeric value between +/-", 2^-type) param <- x$par } ## Uniform distribution if (distr == "uniform") { if (length(x) > 3) warning("A uniform distribution requires only 2 parameters") if (length(x) < 3) warning("A uniform distribution requires 2 parameters") if (is.null(x$min)) stop("Parameter 'min' not specified") if (is.null(x$max)) stop("Parameter 'max' not specified") if (x$min > x$max) stop("'min' of uniform distribution cannot be larger than 'max'") ## probability is constrained in (0,1) if (type == "prob" && (any(c(x$min, x$max) < 0) | any(c(x$min, x$max) > 1))) stop("Parameters of uniform distribution must be", " numeric values between 0 and 1") ## covariance is constrained in +/- 2^-h if (is.numeric(type) && any(abs(c(x$min, x$max)) > 2^-type)) stop("Parameters of uniform distribution must be", " numeric values between +/-", 2^-type) param <- c(x$min, x$max) } ## Beta distribution if (distr == "beta") { ## covariance is constrained in +/- 2^-h if (is.numeric(type)) stop("Beta distribution not allowed for covariance parameters") if (length(x) > 3) warning("A beta distribution requires only 2 parameters") if (length(x) < 3) warning("A beta distribution requires 2 parameters") if (is.null(x$alpha)) stop("Parameter 'alpha' not specified") if (is.null(x$beta)) stop("Parameter 'beta' not specified") if (any(c(x$alpha, x$beta) <= 0)) stop("Parameters of beta distribution must be", " numeric values larger than 0") param <- c(x$alpha, x$beta) } ## Beta-Expert distribution if (distr == "beta-expert") { ## covariance is constrained in +/- 2^-h if (is.numeric(type)) stop("Beta-Expert distribution not allowed for covariance parameters") if (is.null(x$mode) & is.null(x$mean)) stop("At least 'mode' or 'mean' must be specified") if (!is.null(x$mode) & !is.null(x$mean)) stop("'mode' and 'mean' cannot both be specified") method <- c("mode", "mean")[c(!is.null(x$mode), !is.null(x$mean))] best <- ifelse(method == "mode", x$mode, x$mean) if (is.null(x$lower) & is.null(x$upper)) stop("At least 'lower' or 'upper' must be specified") if (is.null(x$p)) stop("Parameter 'p' not specified") target <- c(x$lower, x$upper)[c(!is.null(x$lower), !is.null(x$upper))] ## probability is constrained in (0,1) if (type == "prob" && (any(c(best, x$p, x$target) < 0) | any(c(best, x$p, x$target) > 1))) stop("Parameters of beta-expert distribution must be", " numeric values between 0 and 1") if (!is.null(x$lower)) if (x$lower > x$m) stop("'lower' cannot be larger than 'm'") if (!is.null(x$upper)) if (x$upper < x$m) stop("'upper' cannot be smaller than 'm'") if (!is.null(x$lower) & !is.null(x$upper)) if (x$lower > x$upper) stop("'lower' cannot be larger than 'upper'") distr <- "beta" if (is.null(x$upper)) { param <- betaExpert(best = best, method = method, lower = x$lower, p = x$p) } else if (is.null(x$lower)) { param <- betaExpert(best = best, method = method, upper = x$upper, p = x$p) } else { param <- betaExpert(best = best, method = method, lower = x$lower, upper = x$upper, p = x$p) } } ## Beta-PERT distribution if (distr == "pert") { if (length(x) > 6) warning("A PERT distribution requires maximum 5 parameters") if (length(x) < 4) warning("A PERT distribution requires at least 3 parameters") if (is.null(x$a)) stop("Parameter 'a' not specified") if (is.null(x$m)) stop("Parameter 'm' not specified") if (is.null(x$b)) stop("Parameter 'b' not specified") ## probability is constrained in (0,1) if (type == "prob" && (any(c(x$a, x$m, x$b) < 0) | any(c(x$a, x$m, x$b) > 1))) stop("Parameters of PERT distribution must be", " numeric values between 0 and 1") ## covariance is constrained in +/- 2^-h if (is.numeric(type) && any(abs(c(x$a, x$m, x$b)) > 2^-type)) stop("Parameters of PERT distribution must be", " numeric values between +/-", 2^-type) if (x$a > x$m) stop("'a' of PERT distribution cannot be larger than 'm'") if (x$m > x$b) stop("'m' of PERT distribution cannot be larger than 'b'") pertK <- ifelse(is.null(x$k), 4, x$k) pertM <- ifelse(is.null(x$method), "classic", x$method) param <- c(x$a, x$m, x$b, pertK) distr <- c(distr, pertM) } return(list(d = distr, p = as.numeric(param))) }prevalence/R/propCI-wilson.R0000644000175000017500000000133014246462542015567 0ustar nileshnileshpropCI_wilson <- function(x, n, l){ p <- x/n c <- l[2] - l[1] if (x == 0){ z <- qnorm(c) z_sq <- z ^ 2 ci <- c(0, (p + z_sq / (2 * n) + z * sqrt(p * (1 - p) / n + z_sq / (4 * n^2))) / (1 + z_sq / n)) } else if (x == n){ z <- qnorm(c) z_sq <- z ^ 2 ci <- c((p + z_sq / (2 * n) - z * sqrt(p * (1 - p) / n + z_sq / (4 * n^2))) / (1 + z_sq / n), 1) } else{ z <- qnorm(l[1]) z_sq <- z ^ 2 ci <- (p + z_sq / (2 * n) + c(1, -1) * z * sqrt(p * (1 - p) / n + z_sq / (4 * n^2))) / (1 + z_sq / n) } return(ci) } prevalence/R/betaExpert.R0000644000175000017500000000523614246462542015176 0ustar nileshnileshbetaExpert <- function(best, lower, upper, p = 0.95, method = "mode"){ ## check presence if (missing(best)) stop("'best' is missing") if (missing(lower) & missing(upper)) stop("at least 'lower' or 'upper' must be specified") ## check input values: range(0,1) checkInput(best, "best", range = c(0, 1)) checkInput(p, "p", range = c(0, 1)) if (!missing(lower)) checkInput(lower, "lower", range = c(0, 1), minEq = 0) if (!missing(upper)) checkInput(upper, "upper", range = c(0, 1), maxEq = 1) ## check input values: order if (!missing(lower)) if (lower > best) stop("'lower' cannot be greater than 'best'") if (!missing(upper)) if (upper < best) stop("'upper' cannot be smaller than 'best'") if (!missing(lower) & !missing(upper)) # useless?? if (lower > upper) stop("'lower' cannot be greater than 'upper'") ## functions to optimize ~ mode f_mode <- function(x, mode, p, target){ return( sum( (qbeta(p = p, shape1 = x, shape2 = (x * (1 - mode) + 2 * mode - 1) / mode) - target) ^ 2 )) } f_mode_zero <- function(x, p, target){ return((qbeta(p = p, shape1 = 1, shape2 = x) - target) ^ 2) } f_mode_one <- function(x, p, target){ return((qbeta(p = p, shape1 = x, shape2 = 1) - target) ^ 2) } ## functions to optimize ~ mean f_mean <- function(x, mean, p, target){ return( sum( (qbeta(p = p, shape1 = x, shape2 = (x * (1 - mean)) / mean) - target) ^ 2 )) } ## define 'target' and 'p' if (!missing(lower) & missing(upper)){ target <- lower p <- 1 - p } else if (!missing(upper) & missing(lower)){ target <- upper } else if (!missing(upper) & !missing(lower)){ target <- c(lower, upper) p <- c(0, p) + (1 - p) / 2 } ## derive a and b (=shape1 and shape2) if (method == "mode"){ if (best == 0){ a <- 1 b <- optimize(f_mode_zero, c(0, 1000), p = p, target = target)$minimum } else if (best == 1) { a <- optimize(f_mode_one, c(0, 1000), p = p, target = target)$minimum b <- 1 } else { a <- optimize(f_mode, c(0, 1000), mode = best, p = p, target = target)$minimum b <- (a * (1 - best) + 2 * best - 1) / best } } else if (method == "mean"){ a <- optimize(f_mean, c(0, 1000), mean = best, p = p, target = target)$minimum b <- (a * (1 - best)) / best } ## create 'out' dataframe out <- list(alpha = a, beta = b) class(out) <- "betaExpert" ## return 'out' return(out) }prevalence/R/ciLevel.R0000644000175000017500000000033014246462542014444 0ustar nileshnileshciLevel <- function(x, n, p){ if (x == 0){ level <- c(0, p) } else if (x == n){ level <- c(1 - p, 1) } else { level <- c((1 - p) / 2, 1 - (1 - p) / 2) } return(c(level, (1 - p) / 2)) }prevalence/R/checkInput.R0000644000175000017500000000333514246462542015166 0ustar nileshnileshcheckInput <- function(x, name, class, length, value, range, min, max, minEq, maxEq){ ## check class (note: 'integer' is treated as dominant class) if (!missing(class)) if (any(class == "integer")){ if (any(class(x) != "integer") & (any(class(x) != "numeric") || any(x%%1 != 0))) stop(paste("'", name, "' must be of class integer", sep = "")) } else { if (!any(class(x) == class)) stop(paste("'", name, "' must be of class ", paste(class, collapse = " OR "), sep = "")) } ## check length if (!missing(length)) if (length(x) != length) stop(paste("'", name, "' must be of length ", length, sep = "")) ## check value if (!missing(value)){ test <- logical() for (i in seq_along(x)) test[i] <- !any(value == x[i]) if (any(test)) stop(paste("'", name, "' cannot take values other than ", paste(value, collapse = " OR "), sep = "")) } ## check range if (!missing(range)) if (any(x < range[1]) || any(x > range[2])) stop(paste("'", name, "' cannot take values outside (", range[1], ",", range[2], ")", sep = "")) ## check min if (!missing(min)) if (any(x < min)) stop(paste("'", name, "' cannot be smaller than ", min, sep = "")) ## check max if (!missing(max)) if (any(x > max)) stop(paste("'", name, "' cannot be larger than ", max, sep = "")) ## check maxEq if (!missing(maxEq)) if (any(x >= maxEq)) stop(paste("'", name, "' must be smaller than ", maxEq, sep = "")) ## check minEq if (!missing(minEq)) if (any(x <= minEq)) stop(paste("'", name, "' must be larger than ", minEq, sep = "")) } prevalence/R/zzz.R0000644000175000017500000001600314246462542013722 0ustar nileshnilesh##= Define S4 classes ===================================================== setOldClass("prevModel") # virtual S3 class setOldClass("mcmc.list") # virtual S3 class setClass("prev", representation( par = "list", model = "prevModel", mcmc = "list", diagnostics = "list")) ##= Define S4 methods ===================================================== setMethod("show", "prev", function(object) print(object) ) setMethod("print", "prev", function(x, conf.level = 0.95, dig = 3, ...) { ## guess which function generated 'x' multi <- is.null(x@par$SE) ## get summary statistics from 'summary()' stats <- summary(x, conf.level) if (!is.list(stats)) stats <- list(stats) summary_row <- x@par$nchains + 1 out <- t(sapply(stats, function(x) x[summary_row, c(1:4, 6:7)])) if (multi) { h <- log(length(x@par$x), 2) method <- ifelse(x@par$prior[[1]][[1]] == "TP", "covariance", "conditional") rownames(out) <- switch(method, conditional = c(" TP", paste0(rep(c("SE", "SP"), times = h), rep(seq(h), each = 2))), covariance = get_nodes(h)) } ## get BGR statistic BGR <- x@diagnostics$BGR ## if multinomial, get bayesP if (multi) bayesP <- x@diagnostics$bayesP ## print 'out' dataframe print(round(out, dig), ...) ## print diagnostic information # if only one node: mpsrf == NULL if (is.null(BGR$mpsrf)) { cat("\nBGR statistic = ", round(BGR[[1]][, 1], 4), " (upper CL = ", round(BGR[[1]][, 2], 4), ")\n", sep = "") cat("BGR values substantially above 1 indicate lack of convergence\n") # if multiple nodes } else { cat("\nMultivariate BGR statistic = ", round(BGR$mpsrf, 4), "\n", sep = "") cat("BGR values substantially above 1 indicate lack of convergence\n") } if (multi && method == "conditional") { cat("Bayes-P statistic =", round(bayesP, 2), "\n") cat("Bayes-P values substantially different from 0.5", "indicate lack of convergence\n") } } ) setMethod("summary", "prev", function(object, conf.level = 0.95) { ## derive lower and upper confidence level if (sum(object@par$x) == 0) { p <- c(0, conf.level) } else if (ifelse(length(object@par$x) == 1, object@par$x == object@par$n, sum(object@par$x) == length(object@par$x))) { p <- c(1 - conf.level, 1) } else { p <- c((1 - conf.level) / 2, 1 - (1 - conf.level) / 2) } ciLabel <- paste0(100 * p, "%") ## guess which function generated 'object' multi <- is.null(object@par$SE) if (multi) { nodes <- names(object@mcmc)[-length(names(object@mcmc))] } else { nodes <- names(object@mcmc) } stat_list <- vector("list", length(nodes)) names(stat_list) <- nodes for (node in seq_along(nodes)) { ## define 'stats' matrix n <- object@par$nchains stats <- matrix(ncol = 8, nrow = n + 1) colnames(stats) <- list("mean", "median", "mode", "sd", "var", ciLabel[1], ciLabel[2], "samples") dimnames(stats)[[1]] <- c(paste(rep("chain", n), seq(n)), "all chains") ## extract mcmc samples for this node mcmc <- object@mcmc[[node]] ## calculate summary statistics per chain for (i in seq(object@par$nchains)) { stats[i, 1] <- mean(mcmc[[i]], na.rm = TRUE) stats[i, 2] <- median(mcmc[[i]], na.rm = TRUE) if (var(mcmc[[i]]) > 0) { d <- density(mcmc[[i]], na.rm = TRUE) stats[i, 3] <- d$x[which.max(d$y)] } else { stats[i, 3] <- mcmc[[i]][1] } stats[i, 4] <- sd(mcmc[[i]], na.rm = TRUE) stats[i, 5] <- var(mcmc[[i]], na.rm = TRUE) stats[i, 6] <- quantile(mcmc[[i]], probs = p[1], na.rm = TRUE) stats[i, 7] <- quantile(mcmc[[i]], probs = p[2], na.rm = TRUE) stats[i, 8] <- length(mcmc[[i]]) } ## calculate overall summary statistics y <- unlist(mcmc) i <- i + 1 stats[i, 1] <- mean(y, na.rm = TRUE) stats[i, 2] <- median(y, na.rm = TRUE) if (var(y) > 0) { d <- density(y, na.rm = TRUE) stats[i, 3] <- d$x[which.max(d$y)] } else { stats[i, 3] <- y[1] } stats[i, 4] <- sd(y, na.rm = TRUE) stats[i, 5] <- var(y, na.rm = TRUE) stats[i, 6] <- quantile(y, probs = p[1], na.rm = TRUE) stats[i, 7] <- quantile(y, probs = p[2], na.rm = TRUE) stats[i, 8] <- length(y) stat_list[[node]] <- stats } ## return resulting 'stat' list return(stat_list) } ) setMethod("plot", "prev", function(x, y = NULL, ...) { ## define 'y' if missing if (missing(y)) y <- "TP" ## define 'ask' ask_old <- par("ask") ask_new <- ifelse(prod(par("mfrow")) == 4, FALSE, TRUE) devAskNewPage(ask_new) on.exit(devAskNewPage(ask_old)) ## guess which function generated 'x' multi <- is.null(x@par$SE) if (multi) { h <- log2(length(x@par$x)) if (length(x@mcmc) == 1 + length(get_nodes(h))) { choices <- get_nodes(h) } else { choices <- c("TP", paste0(rep(c("SE", "SP"), each = h), seq(h))) } y <- match.arg(y, choices) mcmc <- x@mcmc[[y]] } else { choices <- c("TP", "SE", "SP") y <- match.arg(y, choices) mcmc <- x@mcmc[[y]] } ## 4 plots of_y <- ifelse(ask_new, paste("of", y), "") cex.main <- ifelse(ask_new, 1.2, 1) line <- ifelse(ask_new, 1.5, 1) densplot(mcmc, main = "", ylab = "density", ask = FALSE) title(main = paste("Density", of_y), cex.main = cex.main, line = line) traceplot(mcmc, main = "", ylab = "prevalence", ask = FALSE) title(main = paste("Trace", of_y), cex.main = cex.main, line = line) gelman.plot(mcmc, ask = TRUE, auto.layout = FALSE) title(main = expression(symbol("\250")), col.main = "white", cex.main = 5) title(main = paste("BGR plot", of_y), cex.main = cex.main, line = line) autocorr.plot(mcmc[[1]], ask = TRUE, auto.layout = FALSE) title(main = expression(symbol("\250")), col.main = "white", cex.main = 5) title(main = paste("Autocorrelation", of_y), cex.main = cex.main, line = line) if (!ask_new) title(y, outer = TRUE, line = -1.5) } ) setMethod("as.matrix", "prev", function(x, iters = FALSE, chains = FALSE) { ## convert MCMC to matrix mx <- sapply(x@mcmc, unlist) ## add iteration numbers if (iters) mx <- cbind(ITER = rep(seq(x@par$update), x@par$nchains), mx) ## add chain numbers if (chains) mx <- cbind(CHAIN = rep(seq(x@par$nchains), each = x@par$update), mx) ## return matrix return(mx) } ) prevalence/R/R2JAGS.R0000644000175000017500000000200714246462542014014 0ustar nileshnileshR2JAGS <- function(model, data, nchains, inits, burnin, nodes, update, verbose){ ## Disable JAGS progress bars old.pb <- options("jags.pb") on.exit(options(old.pb)) options(jags.pb = "none") ## Format model wrap(model) ## Define inits if (any(inits == "random")) inits <- NULL ## Define & Initialize model mod <- jags.model(file = "modelTempFile.txt", data = data, #inits = inits, n.chains = nchains, n.adapt = 1000, quiet = !verbose) ## Delete 'modelTempFile.txt' unlink("modelTempFile.txt") ## Burn-in update(mod, n.iter = burnin, progress.bar = "none") ## Samples samples <- coda.samples(mod, nodes, n.iter = update, thin = 1, progress.bar = "none") ## Deviance dic <- dic.samples(mod, n.iter = update, thin = 1, type = "pD", progress.bar = "none") ## Return results return(list(mcmc.list = samples, dic = dic)) }prevalence/R/define-functions.R0000644000175000017500000001100514246462542016322 0ustar nileshnilesh###=========================================================================# ### 'DEFINE' FUNCTIONS ###=========================================================================# ###=========================================================================# ###== FUNCTIONS ============================================================# ###-- define_x ........................ define observed test results ###-- define_prior .................... define prior for cond prob scheme ###-- define_prior2 ................... define prior for covariance scheme ## -------------------------------------------------------------------------# ## Define observed test results --------------------------------------------# define_x <- function(h) { ## check if h is defined if (missing(h)) stop("The number of tests 'h' is not defined") ## check if h is defined correctly if (is.null(h) || is.na(h) || is.infinite(h)) stop("The number of tests 'h' is not defined") if (is.character(h)) stop("The number of tests 'h' must be a numeric value") checkInput(h, "h", class = "integer", min = 1) ## print title test <- ifelse(h == 1, "test:", "tests:") cat("Definition of the apparent test results, 'x', for", h, test) ## define test status for all APs status <- matrix(nrow = 2 ^ h, ncol = h) for (i in seq(h)) { status[, i] <- rep(c("+", "-"), each = 2 ^ (h - i), times = 2 ^ (i - 1)) } ## paste output T <- character(2 ^ h) for (i in seq(2 ^ h)) T[i] <- paste0("T", seq(h), status[i, ], ",", collapse = "") out <- paste0("\nx[", seq(2^h), "] : ", sapply(T, substr, start = 1, stop = nchar(T) - 1)) cat(out, "\n") } ## -------------------------------------------------------------------------# ## Define prior for conditional probability scheme -------------------------# define_prior <- function(h) { ## check if h is defined if (missing(h)) stop("The number of tests 'h' is not defined") ## check if h is defined correctly if (is.null(h) || is.na(h) || is.infinite(h)) stop("The number of tests 'h' is not defined") if (is.character(h)) stop("The number of tests 'h' must be a numeric value") checkInput(h, "h", class = "integer", min = 1) ## print title test <- ifelse(h == 1, "test:", "tests:") cat("Conditional probability scheme\n") cat("Definition of the prior, 'theta', for", h, test, "\n") ## print theta[1-3] cat("theta[1] : P(D+) = TP\n") cat("theta[2] : P(T1+|D+) = SE1\n") cat("theta[3] : P(T1-|D-) = SP1\n") ## print remaining thetas, if needed if (h > 1) { t <- 4 for (i in 2:h) { N <- 2 ^ i # number of thetas for test i for (k in seq(N)) { D <- ifelse(k <= (N/2), "+", "-") # true disease status T <- ifelse(k <= (N/2), "+", "-") # current test status out <- paste0("P(T", i, T, "|D", D) for (j in seq(i-1)) { select <- rep(c("+", "-"), each = (2^(i-j-1)), times = (2^(j-1))) select <- c(select, rev(select)) out <- paste0(out, ",T", j, select[k]) } cat(paste("theta[", t, "] : ", out, ")\n", sep = "")) t <- t + 1 } } } } ## -------------------------------------------------------------------------# ## Define prior for covariance scheme --------------------------------------# define_prior2 <- function(h) { ## check if h is defined if (missing(h)) stop("The number of tests 'h' is not defined") ## check if h is defined correctly if (is.null(h) || is.na(h) || is.infinite(h)) stop("The number of tests 'h' is not defined") if (is.character(h)) stop("The number of tests 'h' must be a numeric value") checkInput(h, "h", class = "integer", min = 1) ## print title test <- ifelse(h == 1, "test:", "tests:") cat("Covariance scheme\n") cat("Definition of the prior for", h, test, "\n") ## define node labels nodes <- get_nodes(h) ## define node names n_test <- rev(seq(h, 2)) n_comb <- choose(h, n_test) cov <- character() for (i in seq_along(n_test)) cov <- c(cov, apply(combn(h, n_test[i]), 2, paste, collapse = ",T")) names <- c(" True Prevalence", paste0("Sensitity T", seq(h)), paste0("Specificity T", seq(h)), paste0(" Covariance(", paste0("T", cov), "|D+)"), paste0(" Covariance(", paste0("T", cov), "|D-)")) ## print labels and names for (i in seq_along(nodes)) { cat(nodes[i], ":", names[i], "\n") } }prevalence/R/truePrevMulti-main.R0000644000175000017500000002641714246462542016650 0ustar nileshnilesh###=========================================================================# ### TRUE PREVALENCE FROM MULTIPLE TESTS / main functions ###=========================================================================# ###=========================================================================# ###== FUNCTIONS ============================================================# ###-- truePrevMulti ................... user interface for cond prob scheme ###-- truePrevMulti2 .................. user interface for covariance scheme ###-- truePrevMultinom_conditional .... create model for cond prob scheme ###-- truePrevMultinom_covariance ..... create model for covariance scheme ## -------------------------------------------------------------------------# ## User interface for conditional probability scheme -----------------------# truePrevMulti <- function(x, n, prior, nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) { ## check x and n if (missing(x)) stop("'x' is missing") if (missing(n)) stop("'n' is missing") checkInput(x, "x", class = "integer", min = 0) checkInput(n, "n", class = "integer", minEq = 0) if (sum(x) != n) stop("'x' does not sum to 'n'") if ((log(length(x), 2) %% 1 != 0) | length(x) < 4) { stop("'x' is not correctly specified; see ?define_x") } ## check prior if (missing(prior)) stop("'prior' is missing") prior <- checkMultiPrior_conditional(substitute(prior)) ## check nchains, burnin & update checkInput(nchains, "nchains", class = "integer", min = 2) checkInput(burnin, "burnin", class = "integer", min = 1) checkInput(update, "update", class = "integer", min = 1) ## check options checkInput(verbose, "verbose", class = "logical") ## get output out <- truePrevMultinom_conditional(x, n, prior, nchains, burnin, update, verbose) ## return output return(out) } ## -------------------------------------------------------------------------# ## User interface for covariance scheme ------------------------------------# truePrevMulti2 <- function(x, n, prior, nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) { ## check x and n if (missing(x)) stop("'x' is missing") if (missing(n)) stop("'n' is missing") checkInput(x, "x", class = "integer", min = 0) checkInput(n, "n", class = "integer", minEq = 0) if (sum(x) != n) stop("'x' does not sum to 'n'") if ((log(length(x), 2) %% 1 != 0) | length(x) < 4) { stop("'x' is not correctly specified; see ?define_x") } ## check prior if (missing(prior)) stop("'prior' is missing") prior <- checkMultiPrior_covariance(substitute(prior), log2(length(x))) ## check nchains, burnin & update checkInput(nchains, "nchains", class = "integer", min = 2) checkInput(burnin, "burnin", class = "integer", min = 1) checkInput(update, "update", class = "integer", min = 1) ## check options checkInput(verbose, "verbose", class = "logical") ## get output out <- truePrevMultinom_covariance(x, n, prior, nchains, burnin, update, verbose) ## return output return(out) } ## -------------------------------------------------------------------------# ## Create model for conditional probability scheme -------------------------# truePrevMultinom_conditional <- function(x, n, prior, nchains, burnin, update, verbose) { ## create model h <- log(length(x), 2) # number of tests ntheta <- 2 ^ (h + 1) - 1 # number of thetas model <- character() ## write model initiation model[1] <- "model {" model[2] <- paste0("x[1:", 2 ^ h, "] ~ dmulti(AP[1:", 2 ^ h, "], n)") ## write AP[] definitions in terms of theta[] s <- multiModel_select(h) # define theta construct for SE/SP p <- multiModel_probs(s) # define AP[.] in terms of theta[.] model <- c(model, "", p, "") ## write theta[] prior for (i in seq(ntheta)) model <- c(model, writeSeSp(paste0("theta[", i, "]"), prior[[i]])) ## write bayesP definition bayesP <- c(paste0("x2[1:", (2^h), "] ~ dmulti(AP[1:", (2^h), "], n)"), paste0("for (i in 1:", (2^h), ") {"), "d1[i] <- x[i] * log(max(x[i],1) / (AP[i]*n))", "d2[i] <- x2[i] * log(max(x2[i],1) / (AP[i]*n))", "}", "G0 <- 2 * sum(d1[])", "Gt <- 2 * sum(d2[])", "bayesP <- step(G0 - Gt)") model <- c(model, "", bayesP) ## write SE[]/SP[] definition model <- c(model, "", multiModel_SeSp(h)) ## close model model <- c(model, "}") ## define model class class(model) <- "prevModel" ## create data data <- list(x = x, n = n) ## generate inits inits <- NULL ## get results! if (verbose) cat("JAGS progress:\n\n") nodes <- paste0(c("SE", "SP"), rep(seq(h), each = 2)) nodes <- c("TP", nodes, "bayesP") JAGSout <- R2JAGS(model = model, data = data, inits = inits, nchains = nchains, burnin = burnin, update = update, nodes = nodes, verbose = verbose) ## define mcmc samples mcmc.list <- JAGSout$mcmc.list class(mcmc.list) <- c("list", "mcmc.list") names <- colnames(mcmc.list[[1]]) mcmc.list_list <- list() order <- c(length(names) - 1, c(t(cbind(1:h, 1:h+h))), length(names)) for (i in seq_along(names)) mcmc.list_list[[i]] <- mcmc.list[, order[i]] names(mcmc.list_list) <- names[order] ## define diagnostics # deviance information criterion DIC <- JAGSout$dic # bayes-p bayesP <- mean(unlist(mcmc.list_list$bayesP)) # brooks-gelman-rubin diagnostic # exclude bayes-p and fixed nodes exclude <- c(which(colnames(mcmc.list[[1]]) == "bayesP"), which(apply(mcmc.list[[1]], 2, sd) == 0)) BGR <- gelman.diag(mcmc.list[, -exclude]) ## define output out <- new("prev", par = list(x = x, n = n, prior = prior, nchains = nchains, burnin = burnin, update = update, inits = inits), model = model, mcmc = mcmc.list_list, diagnostics = list(DIC = DIC, BGR = BGR, bayesP = bayesP)) ## return output return(out) } ## -------------------------------------------------------------------------# ## Create model for covariance scheme --------------------------------------# truePrevMultinom_covariance <- function(x, n, prior, nchains, burnin, update, verbose) { ## number of tests h <- log(length(x), 2) ## number of priors n_priors <- 1 + (2 * h) + (2 * sum(choose(h, seq(h, 2)))) ## define model vector model <- character() ## write model initiation model[1] <- "model {" model[2] <- paste0("x[1:", 2 ^ h, "] ~ dmulti(AP[1:", 2 ^ h, "], n)") ## write prob_se[], prob_sp[] s <- multiModel_select(h)[[1]] prob_se <- paste0("prob_se[", seq(nrow(s)), "] <-") for (i in seq(nrow(s))) { ## first element prob_se[i] <- paste(prob_se[i], paste(ifelse(s[i, ] == 1, paste0("SE[", seq(ncol(s)), "]"), paste0("(1 - SE[", seq(ncol(s)), "])")), collapse = " * ")) ## define index for 'a' a <- c(1, 0) ## h - 2 elements if (h > 2) { for (k in seq((h - 2), 1)) { se <- apply(t(apply(combn(h, k), 1, rev)), 2, function(x) { paste(ifelse(s[i, x] == 1, paste0("SE[", x, "]"), paste0("(1 - SE[", x, "])")), collapse = " * ") }) sign <- apply(t(apply(combn(h, k), 1, rev)), 2, function(x) prod(2 * s[i, -x] - 1)) # convert (1,0) to (1,-1) a[2] <- a[2] + choose(h, k) prob_se[i] <- paste0(prob_se[i], paste( paste0(ifelse(sign == 1, " + ", " - "), "a[", seq(a[1], a[2]), "] * ", se), collapse = "")) a[1] <- a[2] + 1 } } ## final element prob_se[i] <- paste(prob_se[i], paste0(ifelse(prod(2 * s[i, ] - 1) == 1, "+ ","- "), "a[", a[1], "]")) } prob_sp <- gsub("SE", "SP", prob_se) prob_sp <- gsub("prob_se", "prob_sp", prob_sp) prob_sp <- gsub("a", "b", prob_sp) for (i in seq_along(prob_sp)) { prob_sp[i] <- gsub(paste0("prob_sp[", i ,"]"), paste0("prob_sp[", 1 + length(prob_sp) - i ,"]"), fixed = TRUE, prob_sp[i]) } model <- c(model, "", prob_se, "", prob_sp, "") ## write definition of AP and constraints model <- c(model, paste0("for (i in 1:", 2 ^ h, ") {"), "AP[i] <- TP * prob_se[i] + (1 - TP) * prob_sp[i]", "", write_constraint("AP", 1, 1), write_constraint("AP", 2, 2), write_constraint("prob_se", 1, 3), write_constraint("prob_se", 2, 4), write_constraint("prob_sp", 1, 5), write_constraint("prob_sp", 2, 6), "}", "") ## write prior priors <- get_nodes(h) for (i in seq(n_priors)) { model <- c(model, writeSeSp(prior[[i]][[1]], prior[[i]][[2]])) } ## write Bayes-P definition model <- c(model, "", write_bayesP(h)) ## close model model <- c(model, "}") ## define model class class(model) <- "prevModel" ## create data data <- list(x = x, x2 = x, n = n, O1 = rep(1, 2 ^ h), O2 = rep(0, 2 ^ h), O3 = rep(1, 2 ^ h), O4 = rep(0, 2 ^ h), O5 = rep(1, 2 ^ h), O6 = rep(0, 2 ^ h)) ## generate inits inits <- NULL ## get results! if (verbose) cat("JAGS progress:\n\n") nodes <- c("TP", "SE", "SP", "a", "b", "bayesP") JAGSout <- R2JAGS(model = model, data = data, inits = inits, nchains = nchains, burnin = burnin, update = update, nodes = nodes, verbose = verbose) ## define mcmc samples mcmc.list <- JAGSout$mcmc.list class(mcmc.list) <- c("list", "mcmc.list") names <- colnames(mcmc.list[[1]]) if (h == 2) { names[which(names == "a")] <- "a[1]" names[which(names == "b")] <- "b[1]" } mcmc.list_list <- list() order <- match(c(priors, "bayesP"), names) for (i in seq_along(names)) mcmc.list_list[[i]] <- mcmc.list[, order[i]] names(mcmc.list_list) <- names[order] ## define diagnostics # deviance information criterion DIC <- JAGSout$dic # bayes-p bayesP <- mean(unlist(mcmc.list_list$bayesP)) # brooks-gelman-rubin diagnostic # exclude bayes-p and fixed nodes exclude <- c(which(colnames(mcmc.list[[1]]) == "bayesP"), which(apply(mcmc.list[[1]], 2, sd) == 0)) BGR <- gelman.diag(mcmc.list[, -exclude]) ## define output out <- new("prev", par = list(x = x, n = n, prior = prior, nchains = nchains, burnin = burnin, update = update, inits = inits), model = model, mcmc = mcmc.list_list, diagnostics = list(DIC = DIC, BGR = BGR, bayesP = bayesP)) ## return output return(out) } prevalence/R/truePrevPools.R0000644000175000017500000000664614246462542015732 0ustar nileshnileshtruePrevPools <- function(x, n, SE = 1, SP = 1, prior = c(1, 1), nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) { ## check x and n if (missing(x)) stop("'x' is missing") if (missing(n)) stop("'n' is missing") checkInput(x, "x", class = "integer", value = c(0, 1)) checkInput(n, "n", class = "integer", minEq = 0) if (length(x) > 1 & length(n) == 1) n <- rep(n, length(x)) if (length(x) != length(n)) stop("'x' and 'n' must be of same length") if (length(x) == 1) stop("\"truePrevPools\" requires at least 2 pools") ## check SE & SP checkInput(SE, "SE", class = c("formula", "list", "numeric")) checkInput(SP, "SP", class = c("formula", "list", "numeric")) Se <- checkBinPrior(SE) Sp <- checkBinPrior(SP) ## check prior checkInput(prior, "prior", class = "numeric", length = 2, minEq = 0) ## check nchains, burnin & update checkInput(nchains, "nchains", class = "integer", min = 2) checkInput(burnin, "burnin", class = "integer", min = 1) checkInput(update, "update", class = "integer", min = 1) ## check options checkInput(verbose, "verbose", class = "logical") ## create model model <- character() model[1] <- "model {" model[2] <- "for (i in 1:N) {" model[3] <- "x[i] ~ dbern(AP[i])" model[4] <- paste("AP[i] <- SEpool[i] * (1 - pow(1 - TP, n[i])) +", "(1 - SPpool[i]) * pow(1 - TP, n[i])") model[5] <- paste("SEpool[i] <- 1 - (pow(1 - SE, n[i] * TP) *", "pow(SP, n[i] * (1 - TP)))") model[6] <- "SPpool[i] <- pow(SP, n[i])" model[7] <- "}" model <- c(model, writeSeSp("SE", Se)) model <- c(model, writeSeSp("SP", Sp)) model <- c(model, paste0("TP ~ dbeta(", prior[1], ", ", prior[2], ")")) model <- c(model, "}") class(model) <- "prevModel" ## create data data <- list(x = x, n = n, N = length(n)) ## create inits inits <- NULL ## get results! if (verbose) cat("JAGS progress:\n\n") JAGSout <- R2JAGS(model = model, data = data, inits = inits, nchains = nchains, burnin = burnin, update = update, nodes = c("SE", "SP", "TP"), verbose = verbose) mcmc.list <- JAGSout$mcmc.list class(mcmc.list) <- c("list", "mcmc.list") nodes <- colnames(mcmc.list[[1]]) # extract node names mcmc.list_list <- list() # initiate list for (i in seq_along(nodes)) # assign nodes mcmc.list_list[[i]] <- mcmc.list[, i] names(mcmc.list_list) <- nodes # assign node names mcmc.list_list <- mcmc.list_list[c("TP", "SE", "SP")] # reorder elements ## define diagnostics # deviance information criterion DIC <- JAGSout$dic # brooks-gelman-rubin diagnostic # exclude fixed nodes exclude <- which(apply(mcmc.list[[1]], 2, sd) == 0) if (length(exclude) > 0) { BGR <- gelman.diag(mcmc.list[, -exclude]) } else { BGR <- gelman.diag(mcmc.list) } ## get output out <- new("prev", par = list(x = x, n = n, SE = Se, SP = Sp, prior = prior, nchains = nchains, burnin = burnin, update = update, inits = inits), model = model, mcmc = mcmc.list_list, diagnostics = list(DIC = DIC, BGR = BGR)) ## return output return(out) } prevalence/R/propCI.R0000644000175000017500000000536514246462542014272 0ustar nileshnileshpropCI <- function(x, n, method = "all", level = 0.95, sortby = "level"){ ## Check 'x' and 'n' if (missing(x)) stop("'x' is missing") if (missing(n)) stop("'n' is missing") if (length(x) != 1 && length(n) != 1 && length(x) != length(n)) stop("'x' and 'n' cannot have different lengths") if (length(x) > length(n)) n <- rep(n, length(x)) if (length(n) > length(x)) x <- rep(x, length(n)) ## Define list of methods m <- character() if (any(method == "all")){ method <- c("agresti.coull", "exact", "jeffreys", "wald", "wilson") m <- method } else { for (i in seq_along(method)){ if (any(method[i] == c("agresti.coull", "agresti-coull", "ac"))) m[i] <- "agresti.coull" if (any(method[i] == c("asymptotic", "normal", "wald"))) m[i] <- "wald" if (any(method[i] == c("clopper-pearson", "cp", "exact"))) m[i] <- "exact" if (any(method[i] == c("jeffreys", "bayes"))) m[i] <- "jeffreys" if (any(method[i] == c("wilson"))) m[i] <- "wilson" } } if (length(m) == 0 | any(m == "")) stop(paste("'method' must be", "agresti.coull, exact, jeffreys, wald, or wilson")) ## Check 'level' checkInput(level, "level", range = c(0, 1)) ## Check 'sortby' checkInput(sortby, "sortby", value = c("level", "method")) ## Create data.frame if (sortby == "level"){ prm <- level sec <- method m <- rep(m, times = length(x) * length(level)) mm <- rep(method, times = length(x) * length(level)) p <- rep(level, each = length(x) * length(method)) x <- rep(x, each = length(method), times = length(level)) n <- rep(n, each = length(method), times = length(level)) } else { prm <- method sec <- level m <- rep(m, each = length(x) * length(level)) mm <- rep(method, each = length(x) * length(level)) p <- rep(level, times = length(x) * length(method)) x <- rep(x, each = length(level), times = length(method)) n <- rep(n, each = length(level), times = length(method)) } data <- data.frame(x = x, n = n, q = x/n, m = mm, p = p, l = NA, u = NA) ## Estimate intervals for (i in seq(nrow(data))){ l <- ciLevel(data$x[i], data$n[i], data$p[i]) cl <- switch(EXPR = as.character(m[i]), agresti.coull = propCI_agresticoull(data$x[i], data$n[i], l), exact = propCI_exact(data$x[i], data$n[i], l), jeffreys = propCI_jeffreys(data$x[i], data$n[i], l), wald = propCI_wald(data$x[i], data$n[i], l), wilson = propCI_wilson(data$x[i], data$n[i], l)) data$l[i] <- cl[1] data$u[i] <- cl[2] } names(data) <- c("x", "n", "p", "method", "level", "lower", "upper") return(data) } prevalence/R/truePrev.R0000644000175000017500000000245414246462542014706 0ustar nileshnileshtruePrev <- function(x, n, SE = 1, SP = 1, prior = c(1, 1), nchains = 2, burnin = 10000, update = 10000, verbose = FALSE) { ## check x and n if (missing(x)) stop("'x' is missing") if (missing(n)) stop("'n' is missing") checkInput(x, "x", class = "integer", min = 0) checkInput(n, "n", class = "integer", minEq = 0) binom <- length(x) == 1 if (!binom & sum(x) != n) stop("'x' does not sum to 'n'") if (!binom & length(n) == 1) n <- rep(n, length(x)) if (any(x > n)) stop("'x' cannot be larger than 'n'") ## check SE and SP checkInput(SE, "SE", class = c("formula", "list", "numeric")) checkInput(SP, "SP", class = c("formula", "list", "numeric")) Se <- checkBinPrior(SE, "SE") Sp <- checkBinPrior(SP, "SP") ## check prior checkInput(prior, "prior", class = "numeric", length = 2, minEq = 0) ## check nchains, burnin & update checkInput(nchains, "nchains", class = "integer", min = 2) checkInput(burnin, "burnin", class = "integer", min = 1) checkInput(update, "update", class = "integer", min = 1) ## check options checkInput(verbose, "verbose", class = "logical") ## get output out <- truePrevBinom(x, n, Se, Sp, prior, nchains, burnin, update, verbose) ## return output return(out) }prevalence/R/checkBinPrior.R0000644000175000017500000000122114246466023015601 0ustar nileshnilesh## check specification of SE and SP checkBinPrior <- function(x, name){ if (inherits(x, "numeric")){ out <- checkSeSp(list(dist = "fixed", par = x)) } else if (inherits(x, "formula")){ ## 'x' should be of length 2 ('~' + dist) if (length(x) != 2) stop("Formula specification of ", name, " is incorrect.\n", "See ?truePrev for more details.") call <- as.character(x)[[2]] dist2list(call, type = "prob") } else if (inherits(x, "list")){ check <- checkSeSp(x) } else { stop(name, " should be specified as a list or a formula.\n", "See ?truePrev for more details.") } }prevalence/R/betaPERT.R0000644000175000017500000000252114246462542014473 0ustar nileshnileshbetaPERT <- function(a, m, b, k = 4, method = c("classic", "vose")) { ## check input if (!exists("a")) stop("'a' is missing") if (!exists("m")) stop("'m' is missing") if (!exists("b")) stop("'b' is missing") if (!is.numeric(a)) stop("'a' must be a numeric value") if (!is.numeric(m)) stop("'m' must be a numeric value") if (!is.numeric(b)) stop("'b' must be a numeric value") if (!exists("method")) stop("'method' is missing") method <- match.arg(method) if (method == "classic") { if (!exists("k")) stop("'k' is missing") if (!is.numeric(k)) stop("'k' must be a numeric value") mu <- (a + k * m + b) / (k + 2) sdev <- (b - a) / (k + 2) alpha <- ((mu - a) / (b - a)) * ( ((mu - a) * (b - mu) / (sdev^ 2 )) - 1 ) beta <- alpha * (b - mu) / (mu - a) } if (method == "vose") { if (!exists("k")) stop("'k' is missing") if (!is.numeric(k)) stop("'k' must be a numeric value") mu <- (a + k * m + b) / (k + 2) alpha <- ifelse(mu == m, 1 + k / 2, ((mu - a) * (2 * m - a - b)) / ((m - mu) * (b - a))) beta <- alpha * (b - mu) / (mu - a) } out <- list(alpha = alpha, beta = beta, a = a, m = m, b = b, method = method) class(out) <- "betaPERT" return(out) }prevalence/R/wrap.R0000644000175000017500000000143314246462542014037 0ustar nileshnileshwrap <- function(me){ # 1e-06 => 1.0E-06 me <- gsub("e+", "E+", me, fixed = TRUE) me <- gsub("e-", "E-", me, fixed = TRUE) for (line in seq_along(me)){ s <- me[line] split <- strsplit(s, "[0-9]|[0-9]\\.[0-9]|\\.[0-9]")[[1]] for (i in seq_along(split)) if (split[i] != "E+" & split[i] != "E-" & split[i] != "") s <- paste(strsplit(s, split[i], fixed = TRUE)[[1]], collapse = "@") split <- unlist(strsplit(s, "@")) for (i in seq_along(split)) if (regexpr("E+", split[i])[1] != -1){ dig <- nchar(strsplit(split[i],"E")[[1]][1]) me[line] <- sub(split[i], formatC(as.numeric(split[i]), format = "E", digits = dig), me[line], fixed = TRUE) } } write(me, "modelTempFile.txt") }prevalence/R/plot-methods.R0000644000175000017500000000131214246462542015501 0ustar nileshnileshplot.betaPERT <- function(x, y, ...){ main <- paste("Beta4(", round(x$alpha, 3), ", ", round(x$beta, 3), ", ", round(x$a, 3), ", ", round(x$b, 3), ")", sep = "") x_val <- seq(x$a, x$b, length.out = 1000) y_val <- with(x, dbeta(seq(0, 1, length.out = 1000), alpha, beta) * (b - a) + a) plot(x_val, y_val, col = "blue", type = "l", lwd = 2, xlab = "x", ylab = "density", main = main) } plot.betaExpert <- function(x, y, ...){ main <- paste("Beta(", round(x$alpha, 3), ", ", round(x$beta, 3), ")", sep = "") with(x, curve(dbeta(x, alpha, beta), col = "blue", lwd = "2", xlab = "x", ylab = "density", main = main)) }prevalence/R/dist2list.R0000644000175000017500000000252314246462542015010 0ustar nileshnilesh## BUGS-dist to list dist2list <- function(d, type) { ## check if d is numeric value if (!is.na(suppressWarnings(as.numeric(d)))) { x <- list(dist = "fixed", par = as.numeric(d)) out <- checkSeSp(x, type) } else { ## extract distribution and parameters dst <- as.character(parse(text = d)[[1]])[1] par <- as.numeric(as.character(parse(text = d)[[1]])[-1]) ## check distribution if (!any(c("fixed", "dunif", "dbeta", "dpert") == dst)) stop(paste("Distribution must be either", "'fixed', 'dunif', 'dbeta' or 'dpert'")) ## check length of par dst_nr <- which(c("fixed", "dunif", "dbeta", "dpert") == dst) len <- c(1, 2, 2, 3)[dst_nr] if (length(par) != len) stop(paste("Distribution", dst, "requires", len, "parameters")) ## check dist and pars x <- switch( dst[1], "fixed" = list(dist = "fixed", par = par[1]), "dunif" = list(dist = "uniform", min = par[1], max = par[2]), "dbeta" = list(dist = "beta", alpha = par[1], beta = par[2]), "dpert" = list(dist = "pert", a = par[1], m = par[2], b = par[3])) out <- checkSeSp(x, type) } ## return distribution in list format return(out) }prevalence/R/truePrevMulti-helper.R0000644000175000017500000003533214246462542017177 0ustar nileshnilesh###=========================================================================# ### TRUE PREVALENCE FROM MULTIPLE TESTS / helper functions ###=========================================================================# ###=========================================================================# ###== FUNCTIONS ============================================================# ###-- checkMultiPrior_conditional ..... check prior for cond prob scheme ###-- checkMultiPrior_covariance ...... check prior for covariance scheme ###---| explode ....................... main explode function ###----| explode_theta ................ explode theta (cond prob) ###----| explode_nodes ................ explode nodes (covariance) ###----| explode_operator ............. explode operator ###----| explode_dist ................. explode distribution ###---| get_nodes ..................... define nodes of conditional model ###-- multiModel_select ............... define theta construct for SE/SP ###-- multiModel_probs ................ define AP[] in terms of theta[] ###-- multiModel_SeSp ................. expressions for TP, SE[] and SP[] ###---| multiModel_build .............. ###---| multiModel_collapse ........... ###-- write_bayesP .................... write definition of Bayes-P ###-- write_bayesP0 ................... write definition of Bayes-P ###-- write_constraint ................ write constraint on prob_se, prob_sp ## -------------------------------------------------------------------------# ## Check prior for conditional probability scheme --------------------------# checkMultiPrior_conditional <- function(prior) { ## evaluate whether prior is defined correctly first_element <- as.character(prior)[1] if (!any(c("{", "list") == first_element)) stop("'prior' is not defined correctly") ## if prior is defined as a list ## note: list element names currently not taken in account! if (first_element == "list") { n <- length(prior) - 1 priors_list <- vector("list", n) for (i in seq(n)) priors_list[[i]] <- checkSeSp(eval(parse(text = prior)[[i + 1]]), type = "prob") } ## if prior is defined as a function if (first_element == "{") { n <- length(prior) - 1 priors_list0 <- vector("list", n) for (i in seq(n)) { priors_list0[[i]] <- explode(as.character(prior[[i + 1]]), "conditional") } ## get indices from priors_list0 index <- sapply(priors_list0, function(x) as.numeric(x[[1]])) ## check if all indices exist if (length(index) != max(index)) { stop("The indices of 'theta[.]' are not correctly specified.\n", "See ?theta for more info.") } if (!all(unique(index) == index)) { stop("The indices of 'theta[.]' are not correctly specified.\n", "See ?theta for more info.") } if (length(index) == 1 | log(length(index) + 1, 2)%%1 != 0) { stop("The number of specified theta values is incorrect.\n", "See ?theta for more info.") } ## re-arrange list elements if needed order <- order(index) priors_list <- vector("list", n) for (i in seq(n)) priors_list[[i]] <- priors_list0[[order[i]]][[2]] } ## return prior in list format return(priors_list) } ## -------------------------------------------------------------------------# ## Check prior for covariance scheme ---------------------------------------# checkMultiPrior_covariance <- function(prior, h) { ## evaluate whether prior is defined correctly first_element <- as.character(prior)[1] if (!any(c("{", "list") == first_element)) stop("'prior' is not defined correctly") ## based on h tests, these priors are expected priors <- get_nodes(h) ## if prior is defined as a list ## note: list element names currently not taken in account! if (first_element == "list") { n <- length(prior) - 1 # check if length is as expected if (n != length(priors)) stop("'prior' is not defined correctly; ", "expected ", length(priors), " elements, ", "got ", n) # check if names are as expected prior_names <- names(eval(prior)) priors_names <- gsub("\\]", "", gsub("\\[", "", priors)) if (!all(prior_names %in% priors_names)) stop("'prior' is not defined correctly; ", "expected priors are ", paste(priors_names, collapse = ", ")) if (!all(priors_names %in% prior_names)) stop("'prior' is not defined correctly; ", "expected priors are ", paste(priors_names, collapse = ", ")) # check priors and put in list priors_list <- vector("list", n) for (i in seq(n)) { xi <- suppressWarnings( as.numeric(substr(prior_names[i], 2, nchar(prior_names[i])))) type <- ifelse(substr(prior_names[i], 1, 1) %in% c("a", "b"), cov_depth(h, xi), "prob") priors_list[[i]] <- list(prior_names[i], checkSeSp(eval(parse(text = prior)[[i + 1]]), type = type)) } ## re-arrange list elements if needed order <- match(prior_names, priors_names) priors_list <- priors_list[order] ## rename priors (add brackets) for (i in seq(n)) priors_list[[i]][[1]] <- priors[i] ## if prior is defined as a function } else if (first_element == "{") { n <- length(prior) - 1 priors_list <- vector("list", n) for (i in seq(n)) { priors_list[[i]] <- explode(as.character(prior[[i + 1]]), "covariance", h) } ## check if all priors are defined priors_nodes <- sapply(priors_list, function(x) x[[1]]) if (!all(priors_nodes %in% priors)) stop("'prior' is not defined correctly; ", "expected priors are ", paste(priors_names, collapse = ", ")) if (!all(priors %in% priors_nodes)) stop("'prior' is not defined correctly; ", "expected priors are ", paste(priors_names, collapse = ", ")) ## re-arrange list elements if needed order <- match(priors_nodes, priors) priors_list <- priors_list[order] } ## return prior in list format return(priors_list) } ## -------------------------------------------------------------------------# ## Check depth of covariance parameter -------------------------------------# cov_depth <- function(h, x) { n_test <- rev(seq(h, 2)) n_comb <- choose(h, n_test) rep(n_test, n_comb)[x] } ## -------------------------------------------------------------------------# ## Main explode function ---------------------------------------------------# explode <- function(x, method, h = NULL) { ## create list of 2 (node & dist) priors <- vector("list", 2) ## extract node priors[[1]] <- switch(method, conditional = explode_theta(x[2]), covariance = explode_nodes(x[2])) ## check if operator is correctly specified explode_operator(x[1]) ## define type xi <- suppressWarnings( as.numeric(substr(priors[[1]], 3, nchar(priors[[1]])-1))) type <- ifelse(substr(priors[[1]], 1, 1) %in% c("a", "b"), cov_depth(h, xi), "prob") ## extract distribution priors[[2]] <- explode_dist(x[3], type) return(priors) } ## -------------------------------------------------------------------------# ## explode theta (conditional probability scheme) --------------------------# explode_theta <- function(x) { ## find 'theta[]' if (length(grep("theta", x, fixed = TRUE)) != 1) stop("Priors must be defined as vector 'theta'") if (length(grep("[", x, fixed = TRUE)) != 1 | length(grep("]", x, fixed = TRUE)) != 1) stop("The different values of theta must be defined as 'theta[.]'") ## extract '.' in 'theta[.]' x <- strsplit(x, "theta[", fixed = TRUE)[[1]][2] theta <- strsplit(x, "]", fixed = TRUE)[[1]][1] ## theta should be an integer if (!is.numeric(theta) && as.numeric(theta) %% 1 != 0) stop("'theta[.]' not specified correctly") return(theta) } ## -------------------------------------------------------------------------# ## explode nodes (covariance scheme) ---------------------------------------# explode_nodes <- function (x) { if (!any(c(grepl("TP", x, fixed = TRUE), grepl("SE", x, fixed = TRUE), grepl("SP", x, fixed = TRUE), grepl("a", x, fixed = TRUE), grepl("b", x, fixed = TRUE)))) { stop("Priors must be named 'TP', 'SE', 'SP', 'a' or 'b'") } if (!(strsplit(x, "[", fixed = T)[[1]][1] %in% c("TP", "SE", "SP", "a", "b"))) { stop("Priors must be named 'TP', 'SE', 'SP', 'a' or 'b'") } if (x != "TP" && !all(c(grepl("[", x, fixed = TRUE), grepl("]", x, fixed = TRUE)))) { stop("Priors must be defined as vectors") } if (x != "TP") { rhs <- strsplit(x, "[", fixed = TRUE)[[1]][2] i <- strsplit(rhs, "]", fixed = TRUE)[[1]][1] if (!grepl("^[[:digit:]]+$", i) || i < 1) { stop("Prior '", strsplit(x, "[", fixed = T)[[1]][1], "' not correctly indexed") } } return(x) } ## -------------------------------------------------------------------------# ## explode operator --------------------------------------------------------# explode_operator <- function(operator) { ## operator should be '~' or '<-' or '=' if (!any(c("~", "<-", "=") == operator)) stop("Operator should be either '~', '<-' or '='") } ## -------------------------------------------------------------------------# ## explode distribution ----------------------------------------------------# explode_dist <- function(x, type) { d <- dist2list(x, type) return(d) } ## -------------------------------------------------------------------------# ## Define nodes of conditional model ---------------------------------------# get_nodes <- function(h) { nodes <- c("TP", paste0("SE[", seq(h), "]"), paste0("SP[", seq(h), "]"), paste0("a[", seq(sum(choose(h, seq(h, 2)))), "]"), paste0("b[", seq(sum(choose(h, seq(h, 2)))), "]")) return(nodes) } ## -------------------------------------------------------------------------# ## Define theta construct for SE/SP ----------------------------------------# ## out01 defines construct of SE/SP: 0=(1-theta[.]), 1=theta[.] ## outSE and outSP define which thetas in expression for SE and SP multiModel_select <- function(n){ out01 <- array(dim = c(2^n, n)) outSE <- array(dim = c(2^n, n)) outSP <- array(dim = c(2^n, n)) for (i in seq(n)){ out01[, i] <- rev(rep(c(0, 1), each = 2^(n-i), times = 2^(i-1))) outSE[, i] <- rev(rep(c((2^i+2^(i-1)-1):(2^i)), each = 2^(n-i+1))) outSP[, i] <- rev(rep(c((2^i+2^(i-1)):(2^(i+1)-1)), each = 2^(n-i+1))) } return(list(out01, outSE, outSP)) } ## -------------------------------------------------------------------------# ## Define AP[] in terms of theta[] -----------------------------------------# multiModel_probs <- function(s) { p <- character(dim(s[[1]])[1]) for (i in seq(dim(s[[1]])[1])) { p[i] <- paste0("AP[", i, "] <- theta[1]") for (j in seq(dim(s[[1]])[2])) { p[i] <- paste0(p[i], ifelse(s[[1]][i,j] == 1, "*theta[", "*(1-theta["), s[[2]][i,j], ifelse(s[[1]][i,j] == 1, "]", "])")) } p[i] <- paste0(p[i], " + (1-theta[1])") for (j in seq(dim(s[[1]])[2])) { p[i] <- paste0(p[i], ifelse(s[[1]][i,j] == 0, "*theta[", "*(1-theta["), s[[3]][i,j], ifelse(s[[1]][i,j] == 0, "]", "])")) } } return(p) } ## -------------------------------------------------------------------------# ## Expressions for TP, SE[] and SP[] ---------------------------------------# multiModel_SeSp <- function(n){ TPSESP <- character(1 + 2 * n) TPSESP[1] <- "TP <- theta[1]" TPSESP[2] <- "SE1 <- theta[2]" TPSESP[3] <- "SP1 <- theta[3]" if (n > 1){ for (i in 2:n){ buildSE <- multiModel_build(i, SP = FALSE) buildSP <- multiModel_build(i, SP = TRUE) if (i > 2){ for (j in i:3){ buildSE <- multiModel_collapse(buildSE, j, SP = FALSE) buildSP <- multiModel_collapse(buildSP, j, SP = TRUE) } } TPSESP[(2*i)] <- paste0("SE", i, " <- ", buildSE) TPSESP[(2*i)+1] <- paste0("SP", i, " <- ", buildSP) } } return(TPSESP) } multiModel_build <- function(n, SP){ N <- 2^(n-1) Next <- c(2*N, 2*N+1) out <- character(N/2) for (i in seq(N/2)){ out[i] <- paste0("theta[", N+(i-1)+(SP*N/2), "] * theta[", Next[1]+(SP*N), "] + (1-theta[", N+(i-1)+(SP*N/2), "]) * theta[", Next[2]+(SP*N), "]") Next <- Next + 2 } return(out) } multiModel_collapse <- function(build, n, SP){ N <- length(build) / 2 Next <- 2^(n-2) out <- character(N) for (i in seq(N)){ ii <- (2*i)-1 out[i] <- paste0("theta[", Next+(i-1)+(SP*Next/2), "] * (", build[ii], ") + (1-theta[", Next+(i-1)+(SP*Next/2), "]) * (", build[ii+1], ")") } return(out) } ## -------------------------------------------------------------------------# ## Write definition of Bayes-P ---------------------------------------------# write_bayesP <- function(h) { bayesP <- c(paste0("x2[1:", (2^h), "] ~ dmulti(AP[1:", (2^h), "], n)"), #"d1 <- pow(x[] - AP[] * n, 2) / (n * AP[] * (1 - AP[]))", #"d2 <- pow(x2[] - AP[] * n, 2) / (n * AP[] * (1 - AP[]))", paste0("for (i in 1:", (2^h), ") {"), "d1[i] <- x[i] * log(max(x[i],1) / (AP[i]*n))", "d2[i] <- x2[i] * log(max(x2[i],1) / (AP[i]*n))", "}", "G0 <- sum(d1[])", "Gt <- sum(d2[])", "bayesP <- step(G0 - Gt)") return(bayesP) } write_bayesP0 <- function(h) { bayesP <- c(paste0("x2[1:", (2^h), "] ~ dmulti(AP[1:", (2^h), "], n)"), paste0("for (i in 1:", (2^h), ") {"), "d1[i] <- x[i] * log(max(x[i],1) / (AP[i]*n))", "d2[i] <- x2[i] * log(max(x2[i],1) / (AP[i]*n))", "}", "G0 <- 2 * sum(d1[])", "Gt <- 2 * sum(d2[])", "bayesP <- step(G0 - Gt)") return(bayesP) } ## -------------------------------------------------------------------------# ## Write constraint on 'prob_se', 'prob_sp' --------------------------------# write_constraint <- function(node, constraint, i) { add <- ifelse (constraint == 2, " - 1", "") constr <- c(paste0("constraint", i, "[i] <- step(", node, "[i]", add, ")"), paste0("O", i, "[i] ~ dbern(constraint", i, "[i])")) return(constr) }prevalence/R/propCI-wald.R0000644000175000017500000000055314246462542015211 0ustar nileshnileshpropCI_wald <- function(x, n, l){ p <- x / n if (x == 0){ lw <- 0 up <- p - qnorm(l[3]) * sqrt(p * (1 - p) / n) } else if (x == n){ lw <- p + qnorm(l[3]) * sqrt(p * (1 - p) / n) up <- 1 } else{ lw <- p + qnorm(l[3]) * sqrt(p * (1 - p) / n) up <- p - qnorm(l[3]) * sqrt(p * (1 - p) / n) } return(c(lw, up)) } prevalence/R/plot-methods-coda.R0000644000175000017500000001112714246462542016412 0ustar nileshnilesh## to do: gelman.plot does not par mfrow setMethod("densplot", "prev", function(x, exclude_fixed = TRUE, ...) { ## check inputs checkInput(exclude_fixed, "exclude_fixed", class = "logical") ## guess which function generated 'x' multi <- is.null(x@par$SE) ## calculate number of plots if (multi) { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) is_fixed <- head(is_fixed, -1) n <- length(x@mcmc) - sum(is_fixed) - 1 N <- which(!is_fixed) } else { n <- length(x@mcmc) - 1 N <- seq(n) } } else { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) N <- which(!is_fixed) n <- length(N) } else { n <- length(x@mcmc) N <- seq(n) } } ## define 'ask' ask_old <- par("ask") ask_new <- prod(par("mfrow")) < n devAskNewPage(ask_new) on.exit(devAskNewPage(ask_old)) ## density plots for (i in N) densplot(x@mcmc[[i]], main = paste("Density of", names(x@mcmc)[i]), ask = FALSE, ...) } ) setMethod("traceplot", "prev", function(x, exclude_fixed = TRUE, ...) { ## check inputs checkInput(exclude_fixed, "exclude_fixed", class = "logical") ## guess which function generated 'x' multi <- is.null(x@par$SE) ## calculate number of plots if (multi) { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) is_fixed <- head(is_fixed, -1) n <- length(x@mcmc) - sum(is_fixed) - 1 N <- which(!is_fixed) } else { n <- length(x@mcmc) - 1 N <- seq(n) } } else { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) N <- which(!is_fixed) n <- length(N) } else { n <- length(x@mcmc) N <- seq(n) } } ## define 'ask' ask_old <- par("ask") ask_new <- prod(par("mfrow")) < n devAskNewPage(ask_new) on.exit(devAskNewPage(ask_old)) ## trace plots for (i in N) traceplot(x@mcmc[[i]], main = paste("Trace of", names(x@mcmc)[i]), ask = FALSE, ...) } ) setMethod("gelman.plot", "prev", function(x, ...) { ## guess which function generated 'x' multi <- is.null(x@par$SE) ## calculate number of plots if (multi) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) is_fixed <- head(is_fixed, -1) n <- length(x@mcmc) - sum(is_fixed) - 1 N <- which(!is_fixed) } else { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) N <- which(!is_fixed) n <- length(N) } ## define 'ask' ask_old <- par("ask") ask_new <- prod(par("mfrow")) < n devAskNewPage(ask_new) on.exit(devAskNewPage(ask_old)) ## gelman plots for (i in N) gelman.plot(x@mcmc[[i]], main = paste("BGR plot of", names(x@mcmc)[i]), ask = TRUE, auto.layout = FALSE, ...) } ) setMethod("autocorr.plot", "prev", function(x, exclude_fixed = TRUE, chain = 1, ...) { ## check inputs checkInput(exclude_fixed, "exclude_fixed", class = "logical") checkInput(chain, "chain", class = "integer", min = 1) ## check number of chains if (chain > length(x@mcmc$TP)) stop(paste("'x' only has", length(x@mcmc$TP), "chains")) ## guess which function generated 'x' multi <- is.null(x@par$SE) ## calculate number of plots if (multi) { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) is_fixed <- head(is_fixed, -1) n <- length(x@mcmc) - sum(is_fixed) - 1 N <- which(!is_fixed) } else { n <- length(x@mcmc) - 1 N <- seq(n) } } else { if (exclude_fixed) { is_fixed <- sapply(x@mcmc, function(x) var(unlist(x)) == 0) N <- which(!is_fixed) n <- length(N) } else { n <- length(x@mcmc) N <- seq(n) } } ## define 'ask' ask_old <- par("ask") ask_new <- prod(par("mfrow")) < n devAskNewPage(ask_new) on.exit(devAskNewPage(ask_old)) ## autocorrelation plots for (i in N) autocorr.plot(x@mcmc[[i]][[chain]], main = paste("Autocorrelation of", names(x@mcmc)[i]), ask = TRUE, auto.layout = FALSE, ...) } )prevalence/R/print-methods.R0000644000175000017500000000652114246462542015666 0ustar nileshnilesh###=========================================================================# ### S3 PRINT METHODS ###=========================================================================# ###=========================================================================# ###== FUNCTIONS ============================================================# ###-- print.betaPERT .................. S3 print method for 'betaPERT' ###-- print.betaExpert ................ S3 print method for 'betaExpert' ###-- print.prevModel ................. S3 print method for 'prevModel' ## -------------------------------------------------------------------------# ## S3 print method for class 'betaPERT' ------------------------------------# print.betaPERT <- function(x, conf.level = 0.95, ...){ ## summary statistics beta_mean <- (x$alpha / (x$alpha + x$beta)) * (x$b - x$a) + x$a beta_var <- (x$alpha * x$beta * (x$b - x$a) ^ 2) / ( ((x$alpha + x$beta) ^ 2) * (x$alpha + x$beta + 1)) beta_med <- qbeta(.5, x$alpha, x$beta) * (x$b - x$a) + x$a ## quantiles ci <- c(0, conf.level) + (1 - conf.level) / 2 beta_lwr <- qbeta(ci[1], x$alpha, x$beta) * (x$b - x$a) + x$a beta_upr <- qbeta(ci[2], x$alpha, x$beta) * (x$b - x$a) + x$a ciLabel <- paste(100 * ci, "%", sep = "") ## create 'out' dataframe out <- data.frame(x$method, x$alpha, x$beta, x$a, x$b, beta_mean, beta_med, x$m, beta_var, beta_lwr, beta_upr) colnames(out) <- c("method", "alpha", "beta", "a", "b", "mean", "median", "mode", "var", ciLabel) ## print 'out' dataframe print(out) } ## -------------------------------------------------------------------------# ## S3 print method for class 'betaExpert' ----------------------------------# print.betaExpert <- function(x, conf.level = .95, ...){ ## summary statistics beta_mean <- x$alpha / (x$alpha + x$beta) if (x$alpha > 1 & x$beta > 1){ beta_mode <- (x$alpha - 1) / (x$alpha + x$beta - 2) } else if (x$alpha == 1) { beta_mode <- 0 } else if (x$beta == 1){ beta_mode <- 1 } else if (x$alpha == x$beta) { beta_mode <- NA } else { beta_mode <- ifelse(x$alpha > x$beta, 1, 0) } beta_var <- (x$alpha * x$beta) / ( ((x$alpha + x$beta) ^ 2) * (x$alpha + x$beta + 1)) beta_med <- qbeta(.5, x$alpha, x$beta) ## quantiles ci <- c(0, conf.level) + (1 - conf.level) / 2 beta_lwr <- qbeta(ci[1], x$alpha, x$beta) beta_upr <- qbeta(ci[2], x$alpha, x$beta) ciLabel <- paste0(100 * ci, "%") ## create 'out' dataframe out <- data.frame(x$alpha, x$beta, beta_mean, beta_med, beta_mode, beta_var, beta_lwr, beta_upr) colnames(out) <- c("alpha", "beta", "mean", "median", "mode", "var", ciLabel) ## print 'out' dataframe print(out) } ## -------------------------------------------------------------------------# ## S3 print method for class 'prevModel' -----------------------------------# print.prevModel <- function(x, ...){ l <- length(x) spacer <- 0 for (i in seq(l)){ if (substr(x[i], nchar(x[i]), nchar(x[i])) == "}") spacer <- spacer - 1 cat(rep(" ", 2 * spacer), x[i], "\n", sep = "") if (substr(x[i], nchar(x[i]), nchar(x[i])) == "{") spacer <- spacer + 1 } } prevalence/R/propCI-exact.R0000644000175000017500000000045614246462542015370 0ustar nileshnileshpropCI_exact <- function(x, n, l){ if (x == 0){ lw <- 0 up <- 1 - l[3] ^ (1/n) } else if (x == n){ lw <- l[3] ^ (1/n) up <- 1 } else{ lw <- qbeta(l[1], x, n - x + 1, lower.tail = T) up <- qbeta(l[2], x + 1, n - x, lower.tail = T) } return(c(lw, up)) }prevalence/NEWS0000644000175000017500000000216714246463273013250 0ustar nileshnileshprevalence 0.4.1 ================ * updated DESCRIPTION and NAMESPACE prevalence 0.4.0 ================ * new method `as.matrix` for objects of class `prev` * add SE, SP to `truePrev` and `truePrevPools` output * fixed some documentation typos * updated website and email address * updated Description field to fix CRAN note prevalence 0.3.0 ================ * new function `truePrevMulti2`, implementing a covariance scheme for estimating TP from AP obtained with multiple tests * new function `define_prior2` to show the definition of the priors used by `truePrevMulti2` * definition of `x` in `truePrevMulti` is reversed; first element of `x` now is the number of samples positive on all tests, last element of `x` is the number of samples negative on all tests * 'definition' functions renamed to `define_x` and `define_prior` * functions `truePrev` and `truePrevPools` lost args `conf.level` and `plot` * function `betaPERT` lost args `p` and `plot` * print method for objects of class `prev` no longer shows percentages * various code cleanups and small bug and typo fixesprevalence/inst/0000755000175000017500000000000014246462542013516 5ustar nileshnileshprevalence/inst/CITATION0000644000175000017500000000233114246466745014663 0ustar nileshnileshcitHeader("To cite the prevalence package in publications, please use:") citEntry( entry = "manual", author = c(person("Brecht", "Devleesschauwer", role = c("aut", "cre"), email = "brechtdv@gmail.com"), person("Paul", "Torgerson", role = "aut"), person("Johannes", "Charlier", role = "aut"), person("Bruno", "Levecke", role = "aut"), person("Nicolas", "Praet", role = "aut"), person("Sophie", "Roelandt", role = "aut"), person("Suzanne", "Smit", role = "aut"), person("Pierre", "Dorny", role = "aut"), person("Dirk", "Berkvens", role = "aut"), person("Niko", "Speybroeck", role = "aut")), title = "prevalence: Tools for prevalence assessment studies.", year = "2022", note = "R package version 0.4.1", url = "https://cran.r-project.org/package=prevalence", textVersion = "Brecht Devleesschauwer, Paul Torgerson, Johannes Charlier, Bruno Levecke, Nicolas Praet, Sophie Roelandt, Suzanne Smit, Pierre Dorny, Dirk Berkvens and Niko Speybroeck (2022). prevalence: Tools for prevalence assessment studies. R package version 0.4.1. https://cran.r-project.org/package=prevalence" ) prevalence/NAMESPACE0000644000175000017500000000243614246462542013765 0ustar nileshnileshimportFrom(methods, show) importFrom(methods, new) importFrom(utils, combn) importFrom(utils, head) importFrom(stats, density) importFrom(stats, median) importFrom(stats, optimize) importFrom(stats, qbeta) importFrom(stats, qnorm) importFrom(stats, quantile) importFrom(stats, sd) importFrom(stats, var) importFrom(graphics, plot) importFrom(graphics, par) importFrom(graphics, title) importFrom(grDevices, devAskNewPage) importFrom(rjags, jags.model) importFrom(rjags, coda.samples) importFrom(rjags, dic.samples) importFrom(coda, gelman.diag) importFrom(coda, gelman.plot) importFrom(coda, densplot) importFrom(coda, traceplot) importFrom(coda, autocorr.plot) importFrom(coda, HPDinterval) export(truePrev) export(truePrevPools) export(truePrevMulti) export(truePrevMulti2) export(define_x) export(define_prior) export(define_prior2) export(betaPERT) export(betaExpert) export(propCI) S3method(print, betaPERT) S3method(plot, betaPERT) S3method(print, betaExpert) S3method(plot, betaExpert) S3method(print, prevModel) exportClasses(prev) exportMethods(show) exportMethods(print) exportMethods(summary) exportMethods(as.matrix) exportMethods(plot) exportMethods(densplot) exportMethods(traceplot) exportMethods(autocorr.plot) exportMethods(gelman.plot)