Merge branch 'dev' of https://github.com/n8thangreen/BCEA into dev

.github/workflows/check-standard.yaml

@@ -67,9 +67,7 @@ jobs:
 
       - name: Install jags (macOS-latest)
         if: runner.os == 'macOS'
-        run : |
-              rm '/usr/local/bin/gfortran'
-              brew install jags
+        run : brew install jags
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 2.4.2
-Date: 2022-08-23 11:44:30 UTC
-SHA: f0469ce213fba001efa2707da7fa79289b337105
+Version: 2.4.3
+Date: 2023-05-02 15:57:14 UTC
+SHA: 849eaea3529ff1cdbddbd3e537c66e9b2da26194

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: BCEA
 Type: Package
 Title: Bayesian Cost Effectiveness Analysis
-Version: 2.4.2.9000
+Version: 2.4.3
 Authors@R: c(
     person("Gianluca", "Baio",
-            email = "gianluca@stats.ucl.ac.uk",
-            role = c("aut", "cre"),
+            email = "g.baio@ucl.ac.uk",
+            role = c("aut", "cre", "cph"),
             comment = c(ORCID = "0000-0003-4314-2570")),
     person("Andrea", "Berardi",
             email = "[email protected]",
@@ -27,6 +27,7 @@ Imports:
     graphics,
     MASS,
     Matrix,
+    MCMCvis,
     purrr,
     Rdpack,
     reshape2,
@@ -40,7 +41,6 @@ Suggests:
     INLA,
     knitr,
     markdown,
-    MCMCvis,
     mgcv,
     plotly,
     rjags,

NAMESPACE

@@ -96,6 +96,7 @@ import(ggplot2)
 import(grid)
 import(reshape2)
 importFrom(MASS,kde2d)
+importFrom(MCMCvis,MCMCchains)
 importFrom(Matrix,Matrix)
 importFrom(Matrix,expm)
 importFrom(Rdpack,reprompt)

NEWS.md

@@ -1,5 +1,24 @@
 
-# BCEA 2.4.2.9000
+# BCEA 2.4.3
+May 2023
+
+## Bug fixes
+
+* Consistent colours across plots for each intervention for grid of plots in `plot.bcea()` (cf1ee43)
+* `make.report()` change variable name (f940f2e)
+* Fixed issue with summary table where names of interventions in the wrong order (6a006e3)
+* `summary.bcea()` now only prints results for chosen comparisons and not always all of them. `kstar` and `best` in `bcea()` object were not updated with subset of interventions (#125)
+
+## Refactoring
+
+* `withr::with_par()` used in plotting function `plot.bcea()` to only temporarily change graphics parameters. (725c536)
+* Using `@md` and markdown syntax in function documentation
+* Update `psa.struct()` to add the absolute value in the formula to compute the weights (1cea278)
+* Use `dplyr` piping new syntax from `.data$*` to simply using speech marks `"*"` (2b280ad)
+
+## Miscellaneous
+
+* Template added for GitHub Issues (0ea59fa)
 
 
 # BCEA 2.4.2
@@ -24,13 +43,12 @@ August 2022
 ## New features
 
 * Can now specify what order the interventions labels are in the legend for ce plane (and contour plots) for base R and ggplot2 i.e. reference first or second with optional `ref_first` argument (cc38f07)
-* Can specify currency for axes in `ce-plane.plot` and `ceac.plot` `ggplot2` versions (6808aa6)
+* Can specify currency for axes in `ceplane.plot` and `ceac.plot` `ggplot2` versions (6808aa6)
 * Argument added to `ceplane.plot` of `icer_annot` to annotate each of the ICER points with the text label of the intervention name. Only for `ggplot2` at the moment. (a7b4beb)
 * Added `pos` argument to `contour2()` so that its consistent with `contour()` and `ceplane.plot()`. (50f8f8b)
 * Allow passing `ref` argument by name as well as index in `bcea()`. (9eab459)
 
 
-
 # BCEA 2.4.1.2
 April 2022
 

R/CEriskav_plot_graph.R

@@ -88,8 +88,8 @@ CEriskav_plot_ggplot <- function(he, pos_legend) {
   eib_dat <-
     melt(he$eibr[, default_comp, , drop = FALSE],
          value.name = "eibr") %>%
-    rename(k = .data$Var1,
-           r = .data$Var3) %>%
+    rename(k = "Var1",
+           r = "Var3") %>%
     mutate(r = as.factor(.data$r))
 
   eibr_plot <-
@@ -122,8 +122,8 @@ CEriskav_plot_ggplot <- function(he, pos_legend) {
   evi_dat <-
     melt(he$evir,
          value.name = "evir") %>%
-    rename(r = .data$Var2,
-           k = .data$Var1) %>%
+    rename(r = "Var2",
+           k = "Var1") %>%
     mutate(r = as.factor(.data$r))
 
   evir_plot <-

R/bcea.default.R

@@ -26,7 +26,7 @@ bcea.default <- function(eff,
 
   if (is.null(ref)) {
     ref <- 1
-    message("No reference selected. Defaulting to first intervention.")  
+    message("No reference selected. Defaulting to first intervention.")
   }
 
   if (!is.null(k) && length(k) == 1)
@@ -69,7 +69,7 @@ bcea.default <- function(eff,
   df_ce <- 
     df_ce %>%
     select(-ref) %>% 
-    rename(ref = .data$ints) %>% 
+    rename(ref = "ints") %>% 
     merge(df_ce,
           by = c("ref", "sim"),
           suffixes = c("0", "1"),
@@ -94,6 +94,7 @@ bcea.default <- function(eff,
 
 #' @rdname bcea
 #' @param ... Additional arguments
+#' @importFrom MCMCvis MCMCchains
 #' @export
 bcea.rjags <- function(eff, ...) {
 

R/ce_table.R

@@ -54,8 +54,7 @@ tabulate_means <- function(he,
                            comp_label = NULL,
                            ...) {
 
-  if (is.null(comp_label))
-    comp_label <- 1:he$n_comparisons
+  comp_label <- comp_label %||% seq_len(he$n_comparisons)
 
   data.frame(
     lambda.e = vapply(1:he$n_comparisons,

R/ceac_plot_graph.R

@@ -136,7 +136,7 @@ ceac_ggplot <- function(he,
 
   ggplot(data_psa, aes(.data$k, .data$ceac)) +
     geom_line(aes(linetype = .data$comparison,
-                  size = .data$comparison,
+                  linewidth = .data$comparison,
                   colour = factor(.data$comparison))) +
     theme_ceac() + 
     theme_add +                                            # theme
@@ -176,8 +176,7 @@ ceac_plot_plotly <- function(he,
       sapply(comparisons_label, function(x) rep(x, length(he$k)))
     )))
 
-  if (is.null(graph_params$line$types))
-    graph_params$line$type <- rep_len(1:6, he$n_comparisons)
+  graph_params$line$type <- graph_params$line$type %||% rep_len(1:6, he$n_comparisons)
 
   # opacities
   if (!is.null(graph_params$area$color))

R/ceaf.plot.R

@@ -101,8 +101,8 @@ ceaf.plot.pairwise <- function(mce,
   } else {
     df <- data.frame(k = mce$k,
                      ceaf = mce$ceaf)
-    ggceaf <-
-      ggplot(df, aes(x = .data$k, y = .data$ceaf)) +
+
+    ggplot(df, aes(x = .data$k, y = .data$ceaf)) +
       theme_bw() +
       geom_line() +
       coord_cartesian(ylim = c(-0.05, 1.05)) +
@@ -119,8 +119,6 @@ ceaf.plot.pairwise <- function(mce,
               face = "bold",
               size = 14.3,
               hjust = 0.5))
-
-    return(ggceaf)
   }
 }
 

R/compute_xxx.R

@@ -264,7 +264,7 @@ compute_IB <- function(df_ce, k) {
   df_ce <-
     df_ce %>% 
     filter(ints != .data$ref) %>%
-    rename(comps = .data$ints)
+    rename(comps = "ints")
 
   ib_df <-
     data.frame(k = rep(k, each = nrow(df_ce)),

R/eib_plot_graph.R

@@ -88,7 +88,7 @@ eib_plot_ggplot <- function(he,
       data = data.frame("kstar" = he$kstar),
       colour = "grey50",
       linetype = 2,
-      size = 0.5) +
+      linewidth = 0.5) +
     scale_linetype_manual(
       "",
       labels = graph_params$labels,
@@ -166,8 +166,7 @@ eib_plot_plotly <- function(he,
 
   n_comp <- length(comparison)
 
-  if (is.null(plot_aes$line$types))
-    plot_aes$line$types <- rep(1:6, ceiling(he$n_comparisons/6))[1:he$n_comparisons]
+  plot_aes$line$types <- plot_aes$line$types %||% rep(1:6, ceiling(he$n_comparisons/6))[1:he$n_comparisons]
 
   comparisons.label <-
     paste0(he$interventions[he$ref], " vs ", he$interventions[he$comp])

R/evi.plot.mixedAn.R

@@ -82,9 +82,7 @@ evi.plot.mixedAn <- function(he,
   alt_legend <- pos
   base.graphics <- all(pmatch(graph, c("base", "ggplot2")) != 2)
 
-  if (is.null(y.limits)){
-    y.limits <- range(he$evi, he$evi.star)
-  }
+  y.limits <- y.limits %||% range(he$evi, he$evi.star)
 
   if (base.graphics) {
 

R/evppi.R

@@ -172,7 +172,8 @@
 #' plot(EVPPI.sad)
 #'  
 #' # Compute the EVPPI using INLA/SPDE
-#' x_inla <- evppi(he = m, 39:40, input = inp$mat)
+#' if (require("INLA"))
+#'   x_inla <- evppi(he = m, 39:40, input = inp$mat)
 #' 
 #' # using GAM regression
 #' x_gam <- evppi(he = m, 39:40, input = inp$mat, method = "GAM")
@@ -181,14 +182,16 @@
 #' x_gp <- evppi(he = m, 39:40, input = inp$mat, method = "GP")
 #' 
 #' # plot results
-#' plot(x_inla)
+#' if (require("INLA")) plot(x_inla)
 #' points(x_inla$k, x_inla$evppi, type = "l", lwd = 2, lty = 2)
 #' points(x_gam$k, x_gam$evppi, type = "l", col = "red")
 #' points(x_gp$k, x_gp$evppi, type = "l", col = "blue")
 #' 
-#' plot(x_inla$k, x_inla$evppi, type = "l", lwd = 2, lty = 2)
-#' points(x_gam$k, x_gam$evppi, type = "l", col = "red")
-#' points(x_gp$k, x_gp$evppi, type = "l", col = "blue")
+#' if (require("INLA")) {
+#'   plot(x_inla$k, x_inla$evppi, type = "l", lwd = 2, lty = 2)
+#'   points(x_gam$k, x_gam$evppi, type = "l", col = "red")
+#'   points(x_gp$k, x_gp$evppi, type = "l", col = "blue")
+#' }
 #' 
 #' data(Smoking)
 #' treats <- c("No intervention", "Self-help",

R/evppi.default.R

@@ -10,9 +10,8 @@ evppi.bcea <- function(he,
                        plot = FALSE,
                        residuals = TRUE, ...) {
 
-  if (is.null(colnames(input))) {
-    colnames(input) <- paste0("theta", seq_len(dim(input)[2]))
-  }
+  colnames(input) <- colnames(input) %||% paste0("theta", seq_len(dim(input)[2]))
+
   if (is.numeric(param_idx[1]) || is.integer(param_idx[1])) {
     params <- colnames(input)[param_idx]
   } else {
@@ -22,9 +21,8 @@ evppi.bcea <- function(he,
     }
     class(param_idx) <- "numeric"
   }
-  if (is.null(N)) {
-    N <- he$n_sim
-  }
+
+  N <- N %||% he$n_sim
 
   robust <- NULL
   extra_args <- list(...)
@@ -139,8 +137,8 @@ evppi.bcea <- function(he,
               if (nSegs[i, j] == 1) {
                 l <- which.min(cm)
                 u <- which.max(cm)
-                if (cm[u] - max(cm[1], cm[n]) > min(cm[1],
-                                                    cm[n]) - cm[l]) {
+                if (cm[u] - max(cm[1], cm[n]) >
+                    min(cm[1], cm[n]) - cm[l]) {
                   segPoint <- u
                 } else {
                   segPoint <- l
@@ -249,6 +247,7 @@ evppi.bcea <- function(he,
                   distMinMax <- 0
                   minL <- Inf
                   maxL <- -Inf
+
                   for (sims in seq_len(n)) {
                     if (cm[sims] > maxL) {
                       maxLP <- sims
@@ -273,6 +272,7 @@ evppi.bcea <- function(he,
                   }
                   siMaxMin <- cm[segMaxMinL] + distMaxMin + (cm[n] - cm[segMaxMinR])
                   siMinMax <- -cm[segMaxMinL] + distMinMax - (cm[n] - cm[segMinMaxR])
+
                   if (siMaxMin > siMinMax) {
                     segPoint <- c(segMaxMinL, segMaxMinR)
                   } else {
@@ -515,11 +515,12 @@ evppi.bcea <- function(he,
                 convex.inner = convex.inner,
                 convex.outer = convex.outer,
                 cutoff = cutoff,
-                max.edge = max.edge
-              )
-            plot.mesh(mesh = mesh$mesh,
+                max.edge = max.edge)
+
+            plot_mesh(mesh = mesh$mesh,
                       data = data,
                       plot = plot)
+
             if (!suppress.messages) {
               cat("Calculating fitted values for the GP regression using INLA/SPDE \n")
             }
@@ -579,7 +580,7 @@ evppi.bcea <- function(he,
     }
     if (!suppress.messages) cat("Calculating EVPPI \n")
 
-    comp <- compute.evppi(he = he, fit.full = fit.full)
+    comp <- compute_evppi(he = he, fit.full = fit.full)
 
     name <- prepare.output(parameters = params, inputs = inputs)
 

R/evppi2stage.R

@@ -58,9 +58,8 @@
 #   for (i in 1:n.out) {
 #     cmd <- paste(phi.name, " <- phi[i]", sep = "")
 #     eval(parse(text = cmd))
-#     if (is.null(n.thin)) {
-#       n.thin <- floor((n.iter - n.burnin) / (n.mc / 2))
-#     }
+#
+#     n.thin <- n.thin %||% floor((n.iter - n.burnin) / (n.mc / 2))
 #     
 #     model.evppi <-
 #       jags(data,