Merge pull request #62 from n8thangreen/dev

added extra functionality to `ceplane.plot()` to manipulate wtp text

.Rbuildignore

@@ -25,3 +25,4 @@
 ^CONTRIBUTING\.md$
 ^revdep$
 ^CRAN-SUBMISSION$
+^CITATION\.cff$

BCEA.Rproj

@@ -15,4 +15,4 @@ LaTeX: pdfLaTeX
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
-PackageRoxygenize: rd,collate,namespace,vignette
+PackageRoxygenize: rd,collate,namespace

NEWS.md

@@ -1,10 +1,15 @@
 
+# BCEA 2.4.6 (dev)
+
+* In `ceplane.plot()` for `{ggplot2}` version used the ggplot syntax thats already used for other plotting arguments so that we can now pass e.g. `wtp = list(value = 20000, colour = "blue", x = 10, y = 10, size = 4)`. This closes issue #151 so can do something like `wtp = list(size = 0)` to hide the willingness to pay text. (3d8a770)
+
 # BCEA 2.4.6
 
 _February 2024_
 
 Patch fixing small bugs from last CRAN release.
 
+* Moved `{voi}` package to Suggests in DESCRIPTION and added `requireNamespace()` in `evppi()` to avoid error when not installed (e.g. on CRAN) (f3e3e3e)
 * Converted help documentation in `man-roxygen` folder to md (cf858b1)
 * bugfix: line width in CEAC plot. `{ggplot2}` changed in version 3 to `linewidth` from `size` argument and had only changed some of the code. Updated to `scale_linewidth_manual()`. (60bea9c)
 * Using `testdata` folder `{testthat}` unit tests. (cbce0fa)

R/ceplane.plot.R

@@ -7,7 +7,8 @@
 #'   comparisons together. Any subset of the possible comparisons can be selected
 #'   (e.g., `comparison = c(1,3)` or `comparison = 2`).
 #' @param wtp The value of the willingness to pay parameter. Not used if
-#'   `graph = "base"` for multiple comparisons.
+#'   `graph = "base"` for multiple comparisons. For \pkg{ggplot2} can also provide
+#'   a list of arguments for more options (see below).
 #' @param pos Parameter to set the position of the legend; for a single
 #'   comparison plot, the ICER legend position. Can be given in form of a string
 #'   `(bottom|top)(right|left)` for base graphics and
@@ -36,12 +37,17 @@
 #'   Should be of length 1 or equal to the number of comparisons.
 #'   \item `icer = list(color)`: a vector of colours specifying the colour(s) of the ICER
 #'   points. Should be of length 1 or equal to the number of comparisons.
-#'   \item `icer = list(size)`: a vector of colours specifying the size(s) of the ICER
+#'   \item `icer = list(size)`: a vector of values specifying the size(s) of the ICER
 #'   points. Should be of length 1 or equal to the number of comparisons.
 #'   \item `area_include`: logical, include or exclude the cost-effectiveness 
-#'   acceptability area (default is TRUE).
+#'   acceptability area (default is `TRUE`).
+#'   \item `wtp = list(value)`: equivalent to simply using `wtp = value` but for when multiple
+#'   arguments are passed in list form.
 #'   \item `area = list(color)`: a colour specifying the colour of the cost-effectiveness
 #'   acceptability area.
+#'   \item `wtp = list(color)`: a colour specifying the colour of the willingness-to-pay text
+#'   \item `wtp = list(size)`: a value specifying the size of the willingness-to-pay text
+#'   \item `wtp = list(x=..., y=...)`: a value specifying the x and y coordinates of the willingness-to-pay text
 #'   \item `currency`: Currency prefix to cost differential values - \pkg{ggplot2} only.
 #'   \item `icer_annot`: Annotate each ICER point with text label - \pkg{ggplot2} only.
 #'  }
@@ -103,7 +109,6 @@ ceplane.plot.bcea <- function(he,
                               pos = c(0, 1),
                               graph = c("base", "ggplot2", "plotly"),
                               ...) {
-
   graph <- match.arg(graph)
 
   he <- setComparisons(he, comparison)
@@ -120,7 +125,6 @@ ceplane.plot.bcea <- function(he,
   } else if (is_ggplot(graph)) {
 
     ceplane_plot_ggplot(he,
-                        wtp,
                         pos_legend = pos,
                         graph_params, ...)
 

R/ceplane_base_params.R

@@ -8,7 +8,7 @@ ceplane_base_params <- function(he,
   c(list(
     setup = setup_params(graph_params),
     points = points_params(graph_params),
-    polygon = polygon_params(graph_params, wtp),
+    polygon = polygon_params(graph_params),
     k_txt = k_text(graph_params, wtp),
     wtp = wtp,
     ref_first = graph_params$ref_first),

R/ceplane_base_params_xxx.R

@@ -17,7 +17,9 @@ setup_params <- function(graph_params) {
 
 #' @keywords dplot
 #' 
-polygon_params <- function(graph_params, wtp) {
+polygon_params <- function(graph_params) {
+
+  wtp <- graph_params$wtp_value
 
   x_max <- graph_params$xlim[2]
   y_min <- graph_params$ylim[1]

R/ceplane_geom_params.R

@@ -25,14 +25,14 @@ ceplane_geom_params <- function(...) {
       names(extra_params) %in% c("area_include", "area_color")]
   names(polygon_params) <- gsub("area_", "", names(polygon_params))
 
-  wtp_params <-
+  label.pos <-
     extra_params[
       names(extra_params) %in% "label.pos"]
 
   modifyList(
     list(
       area_include = TRUE,
-      wtp_label.pos = wtp_params),
+      label.pos = label.pos),
     list(
       icer = icer_params,
       point = point_params,

R/ceplane_ggplot_params.R

@@ -2,7 +2,6 @@
 #' CE-plane ggplot Parameters
 #' 
 #' @template args-he
-#' @param wtp Willingness to pay
 #' @param pos_legend Position of legend
 #' @param graph_params Other graphical parameters
 #' @param ... Additional arguments
@@ -11,15 +10,14 @@
 #' @keywords internal
 #' 
 ceplane_ggplot_params <- function(he,
-                                  wtp,
                                   pos_legend,
                                   graph_params,
                                   ...) {
-  
+
   ext_params <- ceplane_geom_params(...)
 
   graph_params$area <-
-    modifyList(polygon_params(graph_params, wtp),
+    modifyList(polygon_params(graph_params),
                graph_params$area)
 
   graph_params$legend <- make_legend_ggplot(he, pos_legend)
@@ -33,7 +31,6 @@ ceplane_ggplot_params <- function(he,
         y = graph_params$ylim[1],
         hjust = "inward",
         vjust = "inward",
-        label = paste0("  k = ", format(wtp, digits = 6), "\n"),
         size = convert_pts_to_mm(1),
         colour = "black"),
       icer = list(

R/ceplane_plot_graph.R

@@ -138,10 +138,8 @@ ceplane_plot_base <- function(he, ...) {
 #'              theme = ggplot2::theme_linedraw())
 #'              
 ceplane_plot_ggplot.bcea <- function(he,
-                                     wtp = 25000,
                                      pos_legend,
                                      graph_params, ...) {
-
   # single long format for ggplot data
   delta_ce <-
     merge(
@@ -160,7 +158,7 @@ ceplane_plot_ggplot.bcea <- function(he,
       by = c("sim", "comparison"))
 
   plot_params <-
-    ceplane_ggplot_params(he, wtp, pos_legend, graph_params, ...)
+    ceplane_ggplot_params(he, pos_legend, graph_params, ...)
 
   theme_add <- purrr::keep(list(...), is.theme)
 
@@ -194,7 +192,7 @@ ceplane_plot_ggplot.bcea <- function(he,
             list(title = plot_params$title,
                  x = plot_params$xlab,
                  y = plot_params$ylab)) +
-    do.call(geom_abline, c(slope = wtp, plot_params$line)) +
+    do.call(geom_abline, c(slope = plot_params$wtp_value, plot_params$line)) +
     do.call(geom_point, plot_params$icer) +
     do.call(annotate, plot_params$wtp) +
     do.call(annotate, plot_params$icer_txt) +

R/prep_ceplane_params.R

@@ -5,19 +5,22 @@
 #' parameters with defaults.
 #'
 #' @template args-he
-#' @param wtp Willingness-to-pay
+#' @param wtp_params Willingness-to-pay parameters. This can be a single value or a list.
 #' @param ... Additional arguments
 #' @importFrom grDevices grey.colors
 #'
 #' @return List pf graph parameters
 #' @export
 #' @keywords internal
 #'
-prep_ceplane_params <- function(he, wtp, ...) {
+prep_ceplane_params <- function(he, wtp_params, ...) {
 
   graph_params <- list(...)
 
-  ##TODO: back-compatibility helper..
+  # back compatibility
+  if (!is.list(wtp_params)) {
+    wtp_params <- list(value = wtp_params)
+  }
 
   intervs_in_title <-
     paste("\n",
@@ -32,8 +35,8 @@ prep_ceplane_params <- function(he, wtp, ...) {
       ifelse(he$n_comparisons == 1,  #he$change_comp,
              yes = intervs_in_title,
              no = ""))
-  
-  axes_lim <- xy_params(he, wtp, graph_params)
+
+  axes_lim <- xy_params(he, wtp_params$value, graph_params)
 
   default_params <-
     list(xlab = "Incremental effectiveness",
@@ -47,13 +50,25 @@ prep_ceplane_params <- function(he, wtp, ...) {
                                alpha = 1),
            size = 0.35,
            shape = rep(20, he$n_comparisons)),
+         wtp = list(
+           value = 25000),
          area_include = TRUE,
          ICER_size = 2,
          area = list(
            # line_color = "black",
            col = "grey95"),
          ref_first = TRUE)
 
-  modifyList(default_params, graph_params)
+  out <- 
+    modifyList(default_params, graph_params) |> 
+    modifyList(list(wtp = wtp_params))
+
+  out$wtp$label <- paste0("  k = ", format(out$wtp$value, digits = 6), "\n")
+
+  # move out of wtp list so can pass straight to geom
+  out$wtp_value <- out$wtp$value
+  out$wtp$value <- NULL
+
+  out
 }
 

cran-comments.md

@@ -1,5 +1,5 @@
 ## R CMD check results
 
-0 errors | 0 warnings | 0 note
+0 errors | 0 warnings | 0 notes
 
 * This is an updated release.

vignettes/ceplane.Rmd

@@ -111,6 +111,40 @@ ceplane.plot(he, pos = c(1, 0))
 ceplane.plot(he, pos = c(1, 1))
 ```
 
+### Willingness-to-pay label
+
+For `{ggplot2}`
+
+```{r}
+ceplane.plot(he, graph = "ggplot2")  # default
+ceplane.plot(he, graph = "ggplot2", wtp = 10000)
+ceplane.plot(he, graph = "ggplot2", wtp = list(value = 10000))
+ceplane.plot(he, graph = "ggplot2", wtp = list(value = 10000, colour = "blue"))
+ceplane.plot(he, graph = "ggplot2", wtp = list(colour = "blue"))
+ceplane.plot(he, graph = "ggplot2", wtp = list(y = 8))
+ceplane.plot(he, graph = "ggplot2", wtp = list(size = 5))
+
+# to hide text
+ceplane.plot(he, graph = "ggplot2", wtp = list(size = 0))
+```
+
+For base `R`
+
+```{r}
+ceplane.plot(he)  # default
+
+##TODO: not yet implemented
+# ceplane.plot(he, wtp = 10000)
+# ceplane.plot(he, wtp = list(value = 10000))
+# ceplane.plot(he, wtp = list(value = 10000, colour = "blue"))
+# ceplane.plot(he, wtp = list(colour = "blue"))
+# ceplane.plot(he, wtp = list(y = 8))
+# ceplane.plot(he, wtp = list(size = 5))
+# 
+# # to hide text
+# ceplane.plot(he, wtp = list(size = 0))
+```
+
 <!-- ```{r} -->
 <!-- ceac.plot(he, graph = "ggplot2", pos = c(0, 0)) -->
 <!-- ceac.plot(he, graph = "ggplot2", pos = c(0, 1)) -->