Fixed a few little bugs in new heatmap and summary functions, and in DirichletNode.

R/heatmap.R

@@ -6,17 +6,17 @@
 # Purpose: Draws a clustered heatmap                #
 #####################################################
 
-are_colours <- function(x) {
-  sapply(x, function(X) {
+are_colours <- function(object) {
+  sapply(object, function(x) {
     tryCatch(
-      is.matrix(col2rgb(X)),
+      is.matrix(col2rgb(x)),
       error = function(e)
         FALSE
     )
   })
 }
 
-clusterHeatMap <- function(x, cols, xnames = 1:length(x), hclust_method) {
+clusterHeatMap <- function(object, cols, xnames = 1:length(object), hclust_method) {
 
   # Check colours
   if (length(cols) != 2 |
@@ -28,7 +28,7 @@ clusterHeatMap <- function(x, cols, xnames = 1:length(x), hclust_method) {
   }
 
   groups <-
-    as.data.frame(apply(groups, 2, function(x)
+    as.data.frame(apply(object, 2, function(x)
       as.factor(x)))
 
   # compute dissimilarity matrix for the type effect clusters

R/interface.R

@@ -180,10 +180,10 @@
 #'
 #'   \item{\code{summary(alpha = 0.05, params = c("alpha", "q", "s", "r", "lambda_i",
 #'   "lambda_j" ,"lambda_j_prop"), times = NULL, locations = NULL, sources = NULL,
-#'   types = NULL, iters = NULL, flatten = FALSE, drop = TRUE, CI_type = "c-s")}}{
+#'   types = NULL, iters = NULL, flatten = FALSE, drop = TRUE, CI_type = "chen-shao")}}{
 #'   returns a list contining the
 #'   median and credible intervals for a subset of the parameters. The default credible
-#'   interval type are Chen-Shao highest posterior density intervals (alternatives
+#'   interval type are Chen-Shao (\code{"chen-shao"}) highest posterior density intervals (alternatives
 #'   are \code{"percentiles"} and \code{"spin"}).
 #'   See \code{extract} for details on the subsetting. \code{lambda_j_prop} returns the
 #'   proportion of cases attributed to each source \code{j} and is calculated by dividing
@@ -258,7 +258,7 @@
 #'
 #' res$summary(params = c("alpha", "q", "lambda_i"),
 #'             times = "1", sources = c("ChickenA", "Bovine"),
-#'             iters = 10:100, flatten = TRUE, CI_type = "c-s")
+#'             iters = 10:100, flatten = TRUE, CI_type = "chen-shao")
 #'
 #' res$extract(params = c("alpha", "r", "q", "lambda_j"),
 #'             sources = c("ChickenB", "Ovine"),
@@ -1164,8 +1164,8 @@ HaldDP <- R6::R6Class(
 
       switch(
         CI_type,
-        "chen-shao" = ci_chenShao(x),
-        "percentiles" = ci_percentiles(x),
+        "chen-shao" = ci_chenShao(x, alpha),
+        "percentiles" = ci_percentiles(x, alpha),
         "SPIn" = ci_spin(x, alpha),
         stop(
           "The type of interval specified must be one of: chen-shao, percentiles, or SPIn."

R/node.R

@@ -286,7 +286,8 @@ DirichletNode <- R6::R6Class(
       self$addParent(alpha, name = 'alpha')
     },
     logDensity = function() {
-      lgamma(sum(alpha)) - sum(lgamma(alpha)) +
+      lgamma(sum(self$parents$alpha$getData())) -
+        sum(lgamma(self$parents$alpha$getData())) +
         sum((self$parents$alpha$getData() - 1) * log(self$data))
     }
   )

man/HaldDP.Rd

@@ -169,10 +169,10 @@ human cases for each type, time and location follow a Poisson likelihood.
 
   \item{\code{summary(alpha = 0.05, params = c("alpha", "q", "s", "r", "lambda_i",
   "lambda_j" ,"lambda_j_prop"), times = NULL, locations = NULL, sources = NULL,
-  types = NULL, iters = NULL, flatten = FALSE, drop = TRUE, CI_type = "c-s")}}{
+  types = NULL, iters = NULL, flatten = FALSE, drop = TRUE, CI_type = "chen-shao")}}{
   returns a list contining the
   median and credible intervals for a subset of the parameters. The default credible
-  interval type are Chen-Shao highest posterior density intervals (alternatives
+  interval type are Chen-Shao (\code{"chen-shao"}) highest posterior density intervals (alternatives
   are \code{"percentiles"} and \code{"spin"}).
   See \code{extract} for details on the subsetting. \code{lambda_j_prop} returns the
   proportion of cases attributed to each source \code{j} and is calculated by dividing
@@ -218,14 +218,14 @@ divided by the number of negative samples) \eqn{j}
 \emph{Priors}
 \deqn{r_{.jt}\sim Dirichlet(a_r_{1jt},..., a_r_{njt})}
 \deqn{a_{tl}\sim Dirichlet(a_alpha_{1tl},..., a_alpha_{mtl})}
-\deqn{q\sim DP(alpha, Gamma(a_{theta},b_{theta}))}
+\deqn{q\sim DP(a_q, Gamma(a_{theta},b_{theta}))}
 }
 }
 \examples{
 data(campy)
 zero_rows <- which(apply(campy[,c(2:7)], 1, sum) == 0)
 campy <- campy[-zero_rows,]
-prevs <- data.frame(Value = 1/c(181/ 239, 113/196, 109/127,
+prevs <- data.frame(Value = c(181/ 239, 113/196, 109/127,
                               97/595, 165/552, 86/524),
                     Source = colnames(campy[, 2:7]),
                     Time = rep(1, 6),
@@ -245,7 +245,7 @@ res$plot_heatmap(iters = 10:100, hclust_method = "complete")
 
 res$summary(params = c("alpha", "q", "lambda_i"),
             times = "1", sources = c("ChickenA", "Bovine"),
-            iters = 10:100, flatten = TRUE, CI_type = "c-s")
+            iters = 10:100, flatten = TRUE, CI_type = "chen-shao")
 
 res$extract(params = c("alpha", "r", "q", "lambda_j"),
             sources = c("ChickenB", "Ovine"),