Port over EPT analysis into public package

.Rbuildignore

@@ -1,4 +1,3 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 .travis.yml
-LICENSE.md

.gitignore

@@ -7,3 +7,4 @@ src/*.so
 src/*.dll
 *.Rproj
 .DS_Store
+*.rda

.travis.yml

@@ -12,4 +12,3 @@ notifications:
   email:
     on_success: never
     on_failure: change
-  slack: epimodel:ARrkdZn2p9KKRZxkcGFK9Ns0

DESCRIPTION

@@ -1,24 +1,23 @@
 Package: EpiModelHIV
-Version: 1.5.0
-Date: 2017-05-04
+Version: 1.0.0
+Date: 2016-06-25
 Type: Package
-Title: Network-Based Epidemic Modeling of HIV Transmission among MSM and Heterosexual Populations
+Title: Epidemic Modeling of HIV Transmission among MSM and Heterosexual Populations
 Authors@R: c(person("Samuel M.", "Jenness", role = c("cre", "aut"), email = "[email protected]"),
              person("Steven M.", "Goodreau", role="aut", email="[email protected]"),
-             person("Emily", "Beylerian", role = "ctb", email = "[email protected]"),
-             person("Kevin", "Weiss", role = "aut", email = "[email protected]"))
+             person("Emily", "Beylerian", role = "ctb", email = "[email protected]"))
 Maintainer: Samuel M. Jenness <[email protected]>
 Description: EpiModelHIV provides extensions to our general EpiModel package to allow for simulating HIV transmission
   dynamics among two populations: men who have sex with men (MSM) in the United States and heterosexual adults in
   sub-Saharan Africa.
 License: GPL-3
 Depends:
     R (>= 3.2.0),
-    EpiModel (>= 1.6.5),
+    EpiModel (>= 1.2.7),
     EpiModelHPC (>= 1.3.1),
-    ergm (>= 3.9.4),
-    tergm (>= 3.5.2),
-    tergmLite (>= 1.1.0)
+    ergm (>= 3.5),
+    tergm,
+    tergmLite
 Imports:
     bindata,
     network,
@@ -29,6 +28,5 @@ Suggests:
     testthat
 VignetteBuilder: knitr
 LinkingTo: ergm
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1
 LazyData: true
-Encoding: UTF-8

NAMESPACE

@@ -18,48 +18,56 @@ export(control_het)
 export(control_msm)
 export(deaths_het)
 export(deaths_msm)
-export(disclose_msm)
 export(dx_het)
 export(edges_correct_het)
 export(edges_correct_msm)
 export(get_args)
+export(hiv_disclose_msm)
+export(hiv_progress_msm)
+export(hiv_test_msm)
+export(hiv_trans_msm)
+export(hiv_tx_msm)
+export(hiv_vl_msm)
 export(init_ccr5_msm)
 export(init_het)
 export(init_msm)
-export(init_status_msm)
+export(init_status_hiv_msm)
+export(init_status_sti_msm)
 export(initialize_het)
 export(initialize_msm)
 export(make_nw_het)
 export(param_het)
 export(param_msm)
+export(part_msm)
 export(position_msm)
 export(prep_msm)
 export(prevalence_het)
 export(prevalence_msm)
-export(progress_msm)
+export(prevalence_msm_ept)
+export(prevalence_msm_tnt)
 export(reallocate_pcp)
 export(reinit_het)
 export(reinit_msm)
 export(remove_bad_roles_msm)
-export(riskhist_msm)
+export(riskhist_prep_msm)
+export(riskhist_stitest_msm)
+export(setBirthAttr_het)
 export(simnet_het)
 export(simnet_msm)
 export(sourceDir)
-export(sti_recov)
-export(sti_trans)
-export(sti_tx)
-export(test_msm)
+export(sti_ept_msm)
+export(sti_recov_msm)
+export(sti_test_msm)
+export(sti_trans_msm)
+export(sti_tx_msm)
+export(syph_progress_msm)
 export(trans_het)
-export(trans_msm)
-export(truncate_sim)
 export(tx_het)
-export(tx_msm)
 export(update_aiclass_msm)
 export(update_roleclass_msm)
 export(verbose_het)
 export(verbose_msm)
 export(vl_het)
-export(vl_msm)
 import(EpiModel)
 import(EpiModelHPC)
 import(bindata)
@@ -70,6 +78,7 @@ import(tergm)
 import(tergmLite)
 importFrom(dplyr,group_by)
 importFrom(dplyr,summarise)
+importFrom(stats,median)
 importFrom(stats,plogis)
 importFrom(stats,rbinom)
 importFrom(stats,rgeom)

R/EpiModelHIV-package.R

@@ -1,10 +1,10 @@
-#' Network-Based Epidemic Modeling of HIV Transmission among MSM and Heterosexual Populations
+#' HIV Transmission Dynamics among MSM and Heterosexuals
 #'
 #' \tabular{ll}{
 #'    Package: \tab EpiModelHIV\cr
 #'    Type: \tab Package\cr
-#'    Version: \tab 1.5.0\cr
-#'    Date: \tab 2017-05-04\cr
+#'    Version: \tab 1.0.0\cr
+#'    Date: \tab 2016-06-25\cr
 #'    License: \tab GPL-3\cr
 #'    LazyLoad: \tab yes\cr
 #' }
@@ -19,7 +19,7 @@
 #' @aliases EpiModelHIV
 #'
 #' @import EpiModel EpiModelHPC network networkDynamic tergmLite tergm ergm bindata
-#' @importFrom stats rbinom rgeom rmultinom rpois runif simulate rnbinom plogis
+#' @importFrom stats median rbinom rgeom rmultinom rpois runif simulate rnbinom plogis
 #' @importFrom dplyr group_by summarise
 #'
 #' @useDynLib EpiModelHIV, .registration = TRUE

R/ErgmTerms.R

@@ -1,8 +1,8 @@
 
 #' @title Definition for absdiffnodemix ERGM Term
 #'
-#' @description This function defines and initialize the absdiffnodemix ERGM term
-#'              that allows for targeting age homophily by race.
+#' @description This function defines and initialize the absdiffnodemix ERGM 
+#'              term that allows for targeting age homophily by race.
 #'
 #' @param nw An object of class \code{network}.
 #' @param arglist A list of arguments as specified in the \code{ergm.userterms}
@@ -11,11 +11,11 @@
 #'        \code{ergm.userterms} package framework.
 #'
 #' @details
-#' This ERGM user term was written to allow for age-based homophily in partnership
-#' formation that is heterogenous by race. The absdiff component allows targets
-#' the distribution of age mixing on that continuous variable, and the nodemix
-#' component differentiates this for black-black, black-white, and white-white
-#' couples.
+#' This ERGM user term was written to allow for age-based homophily in 
+#' partnership formation that is heterogenous by race. The absdiff component 
+#' allows targets the distribution of age mixing on that continuous variable, 
+#' and the nodemix component differentiates this for black-black, black-white, 
+#' and white-white couples.
 #'
 #' @author Steven M. Goodreau
 #'
@@ -53,7 +53,8 @@ InitErgmTerm.absdiffnodemix <- function(nw, arglist, ...) {
   inputs = c(length(nodecov), length(urm), nodecov, nodecovby, urm, ucm)
 
   list(name = "absdiffnodemix",
-       coef.names = paste("absdiffnodemix", a$attrname, a$byattrname, uun, sep = "."),
+       coef.names = paste("absdiffnodemix", a$attrname, a$byattrname, uun, 
+                          sep = "."),
        pkgname = "EpiModelHIV",
        inputs = inputs,
        dependence = FALSE)
@@ -73,10 +74,11 @@ InitErgmTerm.absdiffnodemix <- function(nw, arglist, ...) {
 #'        \code{ergm.userterms} package framework.
 #'
 #' @details
-#' This ERGM user term was written to allow for age-based homophily in partnership
-#' formation that is asymetric by sex. The absdiff component targets age homophily
-#' while the by component allows that to be structed by a binary attribute such
-#' as "male", in order to enforce an offset in the average difference.
+#' This ERGM user term was written to allow for age-based homophily in 
+#' partnershipformation that is asymetric by sex. The absdiff component targets 
+#' age homophily while the by component allows that to be structed by a binary 
+#' attribute suchas "male", in order to enforce an offset in the average 
+#' difference.
 #'
 #' @export
 InitErgmTerm.absdiffby <- function(nw, arglist, ...) {

R/estimation.R

@@ -4,12 +4,13 @@
 
 #' @title Calculate Target Statistics for Network Model Estimation
 #'
-#' @description Calculates the target statistics for the formation and dissolution
-#'              components of the network model to be estimated with \code{netest}.
+#' @description Calculates the target statistics for the formation and 
+#'              dissolution components of the network model to be estimated 
+#'              with \code{netest}.
 #'
 #' @param time.unit Time unit relative to 1 for daily.
-#' @param method Method for calculating target statistics by race, with options of
-#'        \code{2} for preserving race-specific statistics and \code{1} for
+#' @param method Method for calculating target statistics by race, with options 
+#'        of \code{2} for preserving race-specific statistics and \code{1} for
 #'        averaging over the statistics and dropping the race-specific terms.
 #' @param num.B Population size of black MSM.
 #' @param num.W Population size of white MSM.
@@ -25,14 +26,14 @@
 #'        \code{NA} to ignore these quantiles in the target statistics.
 #' @param qnts.W Means of one-off rates split into quintiles for black MSM. Use
 #'        \code{NA} to ignore these quantiles in the target statistics.
-#' @param prop.hom.mpi.B A vector of length 3 for the proportion of main, casual,
-#'        and one-off partnerships in same race for black MSM.
-#' @param prop.hom.mpi.W A vector of length 3 for the proportion of main, casual,
-#'        and one-off partnerships in same race for white MSM.
+#' @param prop.hom.mpi.B A vector of length 3 for the proportion of main, 
+#'        casual, and one-off partnerships in same race for black MSM.
+#' @param prop.hom.mpi.W A vector of length 3 for the proportion of main, 
+#'        casual, and one-off partnerships in same race for white MSM.
 #' @param balance Method for balancing of edges by race for number of mixed-race
-#'        partnerships, with options of \code{"black"} to apply black MSM counts,
-#'        \code{"white"} to apply white MSM counts, and \code{"mean"} to take
-#'        the average of the two expectations.
+#'        partnerships, with options of \code{"black"} to apply black MSM 
+#'        counts, \code{"white"} to apply white MSM counts, and \code{"mean"} to
+#'        take the average of the two expectations.
 #' @param sqrt.adiff.BB Vector of length 3 with the mean absolute differences
 #'        in the square root of ages in main, casual, and one-off black-black
 #'        partnerships.
@@ -107,7 +108,8 @@ calc_nwstats_msm <- function(time.unit = 7,
     stop("deg.mp.W must sum to 1.")
   }
   if (!(method %in% 1:2)) {
-    stop("method must either be 1 for one-race models or 2 for two-race models", call. = FALSE)
+    stop("method must either be 1 for one-race models or 2 for two-race models",
+         call. = FALSE)
   }
 
   num <- num.B + num.W
@@ -168,15 +170,18 @@ calc_nwstats_msm <- function(time.unit = 7,
 
   # Sqrt absdiff term for age
   if (method == 2) {
-    sqrt.adiff.m <- edges.nodemix.m * c(sqrt.adiff.BB[1], sqrt.adiff.BW[1], sqrt.adiff.WW[1])
+    sqrt.adiff.m <- edges.nodemix.m * c(sqrt.adiff.BB[1], sqrt.adiff.BW[1], 
+                                        sqrt.adiff.WW[1])
   }
   if (method == 1) {
-    sqrt.adiff.m <- edges.m * mean(c(sqrt.adiff.BB[1], sqrt.adiff.BW[1], sqrt.adiff.WW[1]))
+    sqrt.adiff.m <- edges.m * mean(c(sqrt.adiff.BB[1], sqrt.adiff.BW[1], 
+                                     sqrt.adiff.WW[1]))
   }
 
   # Compile target stats
   if (method == 2) {
-    stats.m <- c(edges.m, edges.nodemix.m[2:3], totdeg.m.by.dp[c(2:3, 5:6)], sqrt.adiff.m)
+    stats.m <- c(edges.m, edges.nodemix.m[2:3], totdeg.m.by.dp[c(2:3, 5:6)], 
+                 sqrt.adiff.m)
   }
   if (method == 1) {
     stats.m <- c(edges.m, totdeg.m.by.dp[2:3], sqrt.adiff.m)
@@ -236,10 +241,12 @@ calc_nwstats_msm <- function(time.unit = 7,
 
   # Sqrt absdiff term for age
   if (method == 2) {
-    sqrt.adiff.p <- edges.nodemix.p * c(sqrt.adiff.BB[2], sqrt.adiff.BW[2], sqrt.adiff.WW[2])
+    sqrt.adiff.p <- edges.nodemix.p * c(sqrt.adiff.BB[2], sqrt.adiff.BW[2], 
+                                        sqrt.adiff.WW[2])
   }
   if (method == 1) {
-    sqrt.adiff.p <- edges.p * mean(c(sqrt.adiff.BB[2], sqrt.adiff.BW[2], sqrt.adiff.WW[2]))
+    sqrt.adiff.p <- edges.p * mean(c(sqrt.adiff.BB[2], sqrt.adiff.BW[2], 
+                                     sqrt.adiff.WW[2]))
   }
 
   # Compile target statistics
@@ -310,10 +317,12 @@ calc_nwstats_msm <- function(time.unit = 7,
   }
 
   if (method == 2) {
-    sqrt.adiff.i <- edges.nodemix.i * c(sqrt.adiff.BB[3], sqrt.adiff.BW[3], sqrt.adiff.WW[3])
+    sqrt.adiff.i <- edges.nodemix.i * c(sqrt.adiff.BB[3], sqrt.adiff.BW[3], 
+                                        sqrt.adiff.WW[3])
   }
   if (method == 1) {
-    sqrt.adiff.i <- edges.i * mean(c(sqrt.adiff.BB[3], sqrt.adiff.BW[3], sqrt.adiff.WW[3]))
+    sqrt.adiff.i <- edges.i * mean(c(sqrt.adiff.BB[3], sqrt.adiff.BW[3], 
+                                     sqrt.adiff.WW[3]))
   }
 
   if (!is.na(qnts.B[1]) & !is.na(qnts.W[1])) {
@@ -328,7 +337,8 @@ calc_nwstats_msm <- function(time.unit = 7,
 
   } else {
     if (method == 2) {
-      stats.i <- c(edges.i, num.inst.B[-1], num.inst.W, edges.hom.i, sqrt.adiff.i)
+      stats.i <- c(edges.i, num.inst.B[-1], num.inst.W, edges.hom.i, 
+                   sqrt.adiff.i)
     }
     if (method == 1) {
       stats.i <- c(edges.i, num.inst[-1], sqrt.adiff.i)
@@ -383,10 +393,10 @@ calc_nwstats_msm <- function(time.unit = 7,
 #'        \code{\link{calc_nwstats_msm}}.
 #'
 #' @details
-#' This function takes the output of \code{\link{calc_nwstats_msm}} and constructs
-#' an empty network with the necessary attributes for race, square root of age,
-#' and sexual role class. This base network is used for all three network
-#' estimations.
+#' This function takes the output of \code{\link{calc_nwstats_msm}} and 
+#' constructs an empty network with the necessary attributes for race, square 
+#' root of age, and sexual role class. This base network is used for all three 
+#' network estimations.
 #'
 #' @seealso
 #' The final vertex attributes on the network for cross-network degree are
@@ -446,9 +456,9 @@ base_nw_msm <- function(nwstats) {
 #' @param nwstats Object of class \code{nwstats}.
 #'
 #' @details
-#' This function assigns the degree of other networks as a vertex attribute on the
-#' target network given a bivariate degree mixing matrix of main, casual, and
-#' one-partnerships contained in the \code{nwstats} data.
+#' This function assigns the degree of other networks as a vertex attribute on 
+#' the target network given a bivariate degree mixing matrix of main, casual, 
+#' and one-partnerships contained in the \code{nwstats} data.
 #'
 #' @keywords msm
 #' @export
@@ -546,7 +556,8 @@ make_nw_het <- function(n = 10000,
   # Dissolution model
   dissolution <- ~offset(edges)
   dur <- part.dur/time.unit
-  d.rate <- time.unit * (((1 - start.prev) * 1/(55 - 18)/365) + (start.prev * 1/12/365))
+  d.rate <- time.unit * (((1 - start.prev) * 1/(55 - 18)/365) + 
+                           (start.prev * 1/12/365))
   coef.diss <- dissolution_coefs(dissolution, duration = dur, d.rate = d.rate)
 
   out <- list()