State of package before submitting to CRAN (re-added correct code to fix calc_lambda_j_prop)

R/R6_tests.R

+test <- R6::R6Class(
+  "test",
+  private = list(
+    x1 = NULL,
+    x2 = NULL,
+    x3 = R6::R6Class(
+      "x3",
+      public = list(
+        a = NULL,
+        b = NULL,
+        initialize = function(x3, x1 = private$x1) {
+          private$c = x3$c
+          private$d = x3$d
+          self$a = x1
+          self$b = x3$b
+        }
+      ),
+      private = list(
+        c = NULL,
+        d = NULL
+      )
+    )
+  ),
+  public = list(
+    initialize = function(x1 = NA, x2 = NA, x3 = list())
+    {
+      private$x1 <- x1
+      private$x2 <- x2
+      if (is.null(private$x3$a)) {
+        private$x3 <- private$x3$new(x3, x1)
+      } else {
+        stop("something is already here!")
+      }
+    },
+    extract = function()
+    {
+      return(list(x1 = private$x1, x2 = private$x2, x3 = private$x3))
+    }
+  )
+)
+
+res <- test$new(x1 = 1, x2 = 2, list(a=3, b=4, c=5, d=6))
+
+res
+res$extract()

R/campy.R

+#' Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.
+#'
+#' A dataset containing the number of human cases of campylobacteriosis and numbers of source samples
+#' positive for \emph{Campylobacter} for each bacterial subtype.
+#'
+#' @format A data frame with 115 rows and 10 variables:
+#' \describe{
+#'   \item{Human}{number of human cases of campylobacteriosis between 2005-2008 in the Manawatu
+#'   region of New Zealand}
+#'   \item{ChickenA}{number of samples of chicken from supplier A out of a total of 239 tested}
+#'   \item{ChickenB}{number of samples of chicken from supplier B out of a total of 196 tested}
+#'   \item{ChickenC}{number of samples of chicken from supplier C out of a total of 127 tested}
+#'   \item{Bovine}{number of bovine samples out of a total of 595 tested}
+#'   \item{Ovine}{number of ovine samples out of a total of 552 tested}
+#'   \item{Environment}{number of environmental samples out of a total of 524 tested}
+#'   \item{Time}{Time id for the samples}
+#'   \item{Location}{Location id for the samples}
+#'   \item{Type}{MLST type id for the samples}
+#' }
+"campy"

R/interface.R

@@ -6,7 +6,6 @@
 # Purpose: Source attribution model interface       #
 #####################################################
 
-
 #' Runs the HaldDP source attribution model
 #'
 #' @docType class
@@ -220,7 +219,7 @@
 #'
 #' The parameters are defined as follows:
 #' \deqn{a_{jtl}} is the unknown source effect for source \eqn{j}, time \eqn{t}, location \eqn{l}
-#' \deqn{q_{k(i)}} is the unknown type effect for type \eqn{i} in group \eqn{k}.
+#' \deqn{q_{s(i)}} is the unknown type effect for type \eqn{i} in group \eqn{s}.
 #' \deqn{x_{ij}} is the known number of positive samples for each source \eqn{j} type\eqn{i} combination
 #' \deqn{n_{ij}} is the known total number of samples for each source \eqn{j} type \eqn{i} combination
 #' \deqn{k_{j}} is the fixed prevalence in source (i.e. the number of positive samples
@@ -328,7 +327,6 @@ HaldDP <- R6::R6Class(
     alpha_updaters = NULL,
     updaters = NULL,
     save_chain_state = function(iter)
-      # FINISHED
     {
       for (time in 1:private$nTimes) {
         for (location in 1:private$nLocations) {
@@ -346,7 +344,6 @@ HaldDP <- R6::R6Class(
       private$posterior$s[, iter] <- private$DPModel_impl$qNodes$s
     },
     create_posterior = function()
-      # FINISHED
     {
       if (private$append == FALSE |
           isTRUE(all.equal(private$n_iter_old, 0)))
@@ -401,7 +398,6 @@ HaldDP <- R6::R6Class(
       }
     },
     assign_updaters = function()
-      # FINISHED
     {
       r_updaters <- list()
       alpha_updaters <- list()
@@ -468,7 +464,6 @@ HaldDP <- R6::R6Class(
                recursive = TRUE)
     },
     set_data = function(data)
-      # FINISHED
     {
       if (!is.data.frame(data))
         stop("data must be a data frame.")
@@ -596,7 +591,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_k = function(k)
-      # FINISHED
     {
       if (!is.data.frame(k))
         stop("k must be a data frame.")
@@ -642,7 +636,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_a_q = function(a_q)
-      # FINISHED
     {
       if (length(a_q) != 1 |
           !isFinitePositive(a_q) |
@@ -651,7 +644,6 @@ HaldDP <- R6::R6Class(
       private$a_q <- a_q
     },
     set_priors = function(priors)
-      # FINISHED
     {
       if (!is.list(priors) |
           !all(c("a_alpha", "a_r", "a_theta", "b_theta") %in% names(priors)))
@@ -804,7 +796,6 @@ HaldDP <- R6::R6Class(
       private$priors <- HaldDP_priors$new(priors)
     },
     set_inits = function(inits)
-      # FINISHED
     {
       ## r values
       if (!("r" %in% names(inits))) {
@@ -990,7 +981,6 @@ HaldDP <- R6::R6Class(
     },
 
     set_niter = function(n_iter)
-      # FINISHED
     {
       ## check n_iter
       if (isFiniteInteger(n_iter) &
@@ -1005,7 +995,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_append = function(append)
-      # FINISHED
     {
       if (isFiniteLogical(append) & length(append) == 1)
       {
@@ -1016,7 +1005,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_burn_in = function(burn_in)
-      # FINISHED
     {
       if (!isFiniteInteger(burn_in) | burn_in < 0) {
         stop("burn_in is not a positive integer.")
@@ -1025,7 +1013,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_thin = function(thin)
-      # FINISHED
     {
       if (!isFiniteInteger(thin) | thin <= 0) {
         stop("thin is not a positive integer.")
@@ -1034,7 +1021,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_n_r = function(n_r)
-      # FINISHED
     {
       if (!isFiniteInteger(n_r) | n_r <= 0 | n_r > private$nTypes) {
         stop("n_r is not a positive real number or it is larger than the number of types.")
@@ -1043,7 +1029,6 @@ HaldDP <- R6::R6Class(
       }
     },
     set_params_fix = function(params_fix)
-      # FINISHED
     {
       if (is.null(params_fix))
       {
@@ -1100,7 +1085,6 @@ HaldDP <- R6::R6Class(
     },
 
     flatten_alpha = function(object)
-      # FINISHED
     {
       res <- NULL
       ncol_old = 0
@@ -1121,14 +1105,12 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     flatten_q_s = function(object, names)
-      # FINISHED
     {
       res <- t(object)
       colnames(res) <- paste(names, colnames(res), sep = "_")
       return(res)
     },
     flatten_r = function(object)
-      # FINISHED
     {
       res <- NULL
       ncol_old = 0
@@ -1147,7 +1129,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     flatten_lambda_i = function(object)
-      # FINISHED
     {
       res <- NULL
       ncol_old = 0
@@ -1168,7 +1149,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     flatten_lambda_j = function(object)
-      # FINISHED
     {
       res <- NULL
       ncol_old = 0
@@ -1192,7 +1172,6 @@ HaldDP <- R6::R6Class(
     calc_CI = function(x, alpha, CI_type)
     {
       # x is the MCMC output
-
       if (!is.atomic(alpha) |
           !isFinitePositive(alpha) |
           alpha > 1)
@@ -1210,7 +1189,6 @@ HaldDP <- R6::R6Class(
     },
 
     calc_CI_alpha = function(object, alpha, CI_type)
-      # FINISHED
     {
       res <- array(
         dim = c(dim(object)[1],
@@ -1236,7 +1214,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     calc_CI_q = function(object, alpha, CI_type)
-      # FINISHED
     {
       res <-
         sapply(setNames(1:dim(object)[1], dimnames(object)$type), function(x)
@@ -1245,7 +1222,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     calc_CI_r = function(object, alpha, CI_type)
-      # FINISHED
     {
       res <- array(
         dim = c(dim(object)[1],
@@ -1271,7 +1247,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     calc_CI_lambda_i = function(object, alpha, CI_type)
-      # FINISHED
     {
       res <- array(
         dim = c(dim(object)[1],
@@ -1296,7 +1271,6 @@ HaldDP <- R6::R6Class(
       return(res)
     },
     calc_CI_lambda_j = function(object, alpha, CI_type)
-      # FINISHED
     {
       res <- array(
         dim = c(dim(object)[1],
@@ -1328,7 +1302,6 @@ HaldDP <- R6::R6Class(
                                             types,
                                             iters,
                                             flatten)
-      # FINISHED
     {
       if (!mode(params) %in% c("character") |
           length(params) > 7 |
@@ -1513,7 +1486,6 @@ HaldDP <- R6::R6Class(
   public = list(
     #TODO : change r init to an x/colsums(x) and remove from model!
     initialize = function(data, k, priors, a_q, inits = NULL)
-      # FINISHED
     {
       ## read in data
       private$set_data(data) # sets y, X, names and number of sources, types, times and locations
@@ -1566,7 +1538,6 @@ HaldDP <- R6::R6Class(
       private$create_posterior()
     },
     update = function(n_iter, append = TRUE)
-      # FINISHED
     {
       if (!missing(append)) {
         if (all(is.na(private$posterior$r))) {
@@ -1687,7 +1658,6 @@ HaldDP <- R6::R6Class(
 
     ## Functions to access the data and results
     print_data = function()
-      # FINISHED
     {
       return(
         list(
@@ -1708,18 +1678,15 @@ HaldDP <- R6::R6Class(
       )
     },
     print_priors = function()
-      # FINISHED
     {
       return(list(priors = private$priors,
                   a_q = private$a_q))
     },
     print_inits = function()
-      # FINISHED
     {
       return(private$inits)
     },
     print_fit_params = function()
-      # FINISHED
     {
       return(
         list(
@@ -1732,13 +1699,11 @@ HaldDP <- R6::R6Class(
       )
     },
     print_acceptance = function()
-      # FINISHED
     {
       return(private$acceptance)
     },
 
     extract = function(params = c("alpha", "q", "s", "r", "lambda_i", "lambda_j", "lambda_j_prop"),
-                       # FINISHED
                        times = NULL,
                        locations = NULL,
                        sources = NULL,
@@ -1746,7 +1711,7 @@ HaldDP <- R6::R6Class(
                        iters = NULL,
                        flatten = FALSE,
                        drop = TRUE)
-      # FINISHED
+
     {
       params_checked <-
         private$check_extract_summary_params(params, times, locations,
@@ -1836,7 +1801,7 @@ HaldDP <- R6::R6Class(
                        iters = NULL,
                        flatten = FALSE,
                        CI_type = "chen-shao")
-      # FINISHED
+
     {
       object <-
         self$extract(params, times, locations, sources, types, iters, flatten, drop = F)

R/posterior.R

@@ -117,12 +117,25 @@ Posterior_HaldDP = R6::R6Class(
       }
     },
 
-    calc_lambda_j_prop = function() {
-      # TODO: check with multiple times and locations
-      if (is.null(self$lambda_j)) self$calc_lambda_j()
+    calc_lambda_j_prop = function(n_iter, nSources, nTimes,
+                                  nLocations,
+                                  namesSources, namesTimes,
+                                  namesLocations,
+                                  namesIters,
+                                  k) {
+      if (is.null(self$lambda_j)) self$calc_lambda_j(nSources, nTimes,
+                                                     nLocations, nTypes, n_iter,
+                                                     namesSources, namesTimes,
+                                                     namesLocations, namesTypes,
+                                                     namesIters)
       self$lambda_j_prop <- self$lambda_j
       for (iter in 1:dim(self$lambda_j)[4]) {
-        self$lambda_j_prop[,,,iter] <- self$lambda_j[,,,iter] / sum(self$lambda_j[,,,iter])
+        for (times in 1:nTimes) {
+          for (locations in 1:nLocations) {
+            self$lambda_j_prop[,times,locations,iter] <-
+              self$lambda_j[,times,locations,iter] / sum(self$lambda_j[,times,locations,iter])
+          }
+        }
       }
     }
   )

R/sim_SA_data.R

+#' Simulated data: Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.
+#'
+#' A simulated dataset containing the number of human cases of campylobacteriosis and numbers of source samples
+#' positive for \emph{Campylobacter} for each bacterial subtype.
+#'
+#' @format A data frame with 364 rows and 10 variables:
+#' \describe{
+#'   \item{Human}{number of human cases of campylobacteriosis}
+#'   \item{Source1}{number of Source1 samples}
+#'   \item{Source2}{number of Source2 samples}
+#'   \item{Source3}{number of Source3 samples}
+#'   \item{Source4}{number of Source4 samples}
+#'   \item{Source5}{number of Source5 samples}
+#'   \item{Source6}{number of Source6 samples}
+#'   \item{Time}{Time id for the samples}
+#'   \item{Location}{Location id for the samples}
+#'   \item{Type}{MLST type id for the samples}
+#' }
+"sim_SA_data"

R/sim_SA_prev.R

+#' Simulated data prevalences.
+#'
+#' Source prevalences for the simulated data (sim_SA_data).
+#'
+#' @format A data frame with 12 rows and 3 variables:
+#' \describe{
+#'   \item{Value}{prevalence values}
+#'   \item{Time}{Time id for the samples}
+#'   \item{Source}{Source id for the samples}
+#' }
+"sim_SA_prev"

R/sim_SA_true.R

+#' True values for the parameters generating the simulated data.
+#'
+#' A list containing the true values of the parameters used to simulate the sim_SA_data dataset.
+#'
+#' @format A list with 5 items:
+#' \describe{
+#'   \item{alpha}{A dataframe with 24 rows and 4 variables: Value contains the true alpha values,
+#'   Time, Location and Source contain the time, location and source id's respectively.}
+#'   \item{q}{A dataframe with 91 rows and 2 variables: Value contains the true q values, and
+#'   Type contains the type id's.}
+#'   \item{lambda_i}{A dataframe with 364 rows and 4 variables: Value contains the true lambda_i values,
+#'   Time, Location and Type contain the time, location and type id's respectively.}
+#'   \item{lambda_j}{A dataframe with 24 rows and 4 variables: Value contains the true lambda_j values,
+#'   Time, Location and Source contain the time, location and source id's respectively.}
+#'   \item{r}{A dataframe with 2184 rows and 5 variables: Value contains the true r values,
+#'   Time, Type, Location and Source contain the time, type, location and source id's respectively.}
+#' }
+"sim_SA_true"

man/campy.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/campy.R
+\docType{data}
+\name{campy}
+\alias{campy}
+\title{Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.}
+\format{A data frame with 115 rows and 10 variables:
+\describe{
+  \item{Human}{number of human cases of campylobacteriosis between 2005-2008 in the Manawatu
+  region of New Zealand}
+  \item{ChickenA}{number of samples of chicken from supplier A out of a total of 239 tested}
+  \item{ChickenB}{number of samples of chicken from supplier B out of a total of 196 tested}
+  \item{ChickenC}{number of samples of chicken from supplier C out of a total of 127 tested}
+  \item{Bovine}{number of bovine samples out of a total of 595 tested}
+  \item{Ovine}{number of ovine samples out of a total of 552 tested}
+  \item{Environment}{number of environmental samples out of a total of 524 tested}
+  \item{Time}{Time id for the samples}
+  \item{Location}{Location id for the samples}
+  \item{Type}{MLST type id for the samples}
+}}
+\usage{
+campy
+}
+\description{
+A dataset containing the number of human cases of campylobacteriosis and numbers of source samples
+positive for \emph{Campylobacter} for each bacterial subtype.
+}
+\keyword{datasets}
+

man/sim_SA_data.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sim_SA_data.R
+\docType{data}
+\name{sim_SA_data}
+\alias{sim_SA_data}
+\title{Simulated data: Human cases of campylobacteriosis and numbers of source samples positive for \emph{Campylobacter}.}
+\format{A data frame with 364 rows and 10 variables:
+\describe{
+  \item{Human}{number of human cases of campylobacteriosis}
+  \item{Source1}{number of Source1 samples}
+  \item{Source2}{number of Source2 samples}
+  \item{Source3}{number of Source3 samples}
+  \item{Source4}{number of Source4 samples}
+  \item{Source5}{number of Source5 samples}
+  \item{Source6}{number of Source6 samples}
+  \item{Time}{Time id for the samples}
+  \item{Location}{Location id for the samples}
+  \item{Type}{MLST type id for the samples}
+}}
+\usage{
+sim_SA_data
+}
+\description{
+A simulated dataset containing the number of human cases of campylobacteriosis and numbers of source samples
+positive for \emph{Campylobacter} for each bacterial subtype.
+}
+\keyword{datasets}
+

man/sim_SA_prev.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sim_SA_prev.R
+\docType{data}
+\name{sim_SA_prev}
+\alias{sim_SA_prev}
+\title{Simulated data prevalences.}
+\format{A data frame with 12 rows and 3 variables:
+\describe{
+  \item{Value}{prevalence values}
+  \item{Time}{Time id for the samples}
+  \item{Source}{Source id for the samples}
+}}
+\usage{
+sim_SA_prev
+}
+\description{
+Source prevalences for the simulated data (sim_SA_data).
+}
+\keyword{datasets}
+

man/sim_SA_true.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sim_SA_true.R
+\docType{data}
+\name{sim_SA_true}
+\alias{sim_SA_true}
+\title{True values for the parameters generating the simulated data.}
+\format{A list with 5 items:
+\describe{
+  \item{alpha}{A dataframe with 24 rows and 4 variables: Value contains the true alpha values,
+  Time, Location and Source contain the time, location and source id's respectively.}
+  \item{q}{A dataframe with 91 rows and 2 variables: Value contains the true q values, and
+  Type contains the type id's.}
+  \item{lambda_i}{A dataframe with 364 rows and 4 variables: Value contains the true lambda_i values,
+  Time, Location and Type contain the time, location and type id's respectively.}
+  \item{lambda_j}{A dataframe with 24 rows and 4 variables: Value contains the true lambda_j values,
+  Time, Location and Source contain the time, location and source id's respectively.}
+  \item{r}{A dataframe with 2184 rows and 5 variables: Value contains the true r values,
+  Time, Type, Location and Source contain the time, type, location and source id's respectively.}
+}}
+\usage{
+sim_SA_true
+}
+\description{
+A list containing the true values of the parameters used to simulate the sim_SA_data dataset.
+}
+\keyword{datasets}
+

[Poppy Miller]

Didn't actually submit to cran. Upload failed, then found bug, so didn't upload again.