Merge pull request #65 from andbe/master

Added plotly support and other fixes to plotting functions

DESCRIPTION

@@ -8,7 +8,7 @@ Authors@R: c(
             role = c("aut", "cre", "cph"),
             comment = c(ORCID = "0000-0003-4314-2570")),
     person("Andrea", "Berardi",
-            email = "[email protected]",
+            email = "[email protected]",
             role = c("aut"),
             comment = c(ORCID = "0000-0002-2906-496X")),
     person("Anna", "Heath",
@@ -28,6 +28,7 @@ Imports:
     MASS,
     Matrix,
     MCMCvis,
+    plotly,
     purrr,
     Rdpack,
     reshape2,
@@ -42,7 +43,6 @@ Suggests:
     knitr,
     markdown,
     mgcv,
-    plotly,
     plotrix,
     RColorBrewer,
     rjags,

NAMESPACE

@@ -10,6 +10,7 @@ S3method("setKmax<-",bcea)
 S3method("setKmax<-",default)
 S3method("setReferenceGroup<-",bcea)
 S3method("setReferenceGroup<-",default)
+S3method(CEriskav.plot,CEriskav)
 S3method(bcea,bugs)
 S3method(bcea,default)
 S3method(bcea,rjags)
@@ -51,6 +52,7 @@ export("mixedAn<-")
 export("setComparisons<-")
 export("setKmax<-")
 export("setReferenceGroup<-")
+export(CEriskav.plot)
 export(bcea)
 export(best_interv_given_k)
 export(ce_table)
@@ -94,6 +96,7 @@ export(validate_bcea)
 import(dplyr)
 import(ggplot2)
 import(grid)
+import(plotly)
 import(reshape2)
 importFrom(MASS,kde2d)
 importFrom(MCMCvis,MCMCchains)
@@ -110,6 +113,7 @@ importFrom(grDevices,colors)
 importFrom(grDevices,colours)
 importFrom(grDevices,dev.new)
 importFrom(grDevices,devAskNewPage)
+importFrom(grDevices,gray)
 importFrom(grDevices,grey.colors)
 importFrom(grDevices,pdf.options)
 importFrom(grDevices,ps.options)

R/CEriskav.plot.R

@@ -0,0 +1,51 @@
+#' @rdname CEriskav.plot
+#' 
+#' @template args-he
+#' @param pos Legend position
+#' @param graph A string used to select the graphical engine to use for
+#' plotting. Should (partial-)match the options `"base"`,
+#' `"ggplot2"` or `"plotly"`. Default value is `"base"`.
+#'
+#' @return \item{plot}{ A ggplot or plot_ly object containing the plot. Returned only
+#' if `graph_type="ggplot2"` or `graph_type="plotly"`.}
+#' @seealso [bcea()]
+#' 
+#' @references
+#' \insertRef{Baio2013}{BCEA}
+#' 
+#' @importFrom grDevices colours
+#' 
+#' @export
+#' 
+CEriskav.plot.CEriskav <- function(he,
+                           pos = "topright",
+                           graph = c("base", "ggplot2", "plotly")
+                           ) {
+
+  graph <- match.arg(graph)
+  # extra_args <- list(...)
+
+  if (is_baseplot(graph)) {
+    CEriskav_plot_base(he,
+                       pos_legend = pos)
+  } else if (is_ggplot(graph)) {
+    CEriskav_plot_ggplot(he,
+                         pos_legend = pos)
+  } else if (is_plotly(graph)) {
+    CEriskav_plot_plotly(he,
+                         pos_legend = pos)
+  }
+}
+
+#' Cost-effectiveness Plot Including a Parameter of Risk Aversion (CEriskav)
+#' 
+#' @template args-he
+#' @param pos Legend position
+#' @param graph A string used to select the graphical engine to use for
+#' plotting. Should (partial-)match the options `"base"`,
+#' `"ggplot2"` or `"plotly"`. Default value is `"base"`.
+#' @export
+#' 
+CEriskav.plot <- function(he, pos, graph) {
+  UseMethod('CEriskav.plot', he, pos, graph)
+}

R/CEriskav_plot_graph.R

@@ -7,7 +7,7 @@
 #' @name CEriskav_plot_graph
 #' @title Cost-effectiveness Plot Including a Parameter of Risk Aversion
 #'
-#' @description Choice of base R, \pkg{ggplot2}.
+#' @description Choice of base R, \pkg{ggplot2} or \pkg{plotly}.
 #'
 #' @template args-he
 #' @param pos_legend Legend position
@@ -159,3 +159,75 @@ CEriskav_plot_ggplot <- function(he, pos_legend) {
   invisible(list(eib = eibr_plot,
                  evi = evir_plot))
 }
+
+#' @rdname CEriskav_plot_graph
+#' @title CEriskav plotly version
+#'
+CEriskav_plot_plotly <- function(he, pos_legend) {
+  default_comp <- 1
+  linetypes <- rep(c(1,2,3,4,5,6), ceiling(he$R/6))[1:he$R]
+
+  # labels
+  text <- paste0("r = ", he$r)
+
+  # if the first value for r is small enough,
+  # consider close to 0 and print label accordingly
+  if (he$r[1] < 1e-8) text[1] <- paste("r","\U2B62","0")
+
+  legend_params <- make_legend_plotly(pos_legend)
+
+  eib_dat <-
+    melt(he$eibr[, default_comp, , drop = FALSE],
+         value.name = "eibr") |>
+    dplyr::rename(k = "Var1", r = "Var3") |>
+    dplyr::mutate(r = factor(.data$r, labels = text))
+
+  evi_dat <-
+    melt(he$evir,
+         value.name = "evir") |>
+    dplyr::rename(r = "Var2", k = "Var1") |>
+    dplyr::mutate(r = factor(.data$r, labels = text))
+
+  eibr_plot <-
+    plotly::plot_ly(data = eib_dat, linetype = ~r, x = ~k) |>
+    plotly::add_trace(
+      y = ~eibr,
+      type = "scatter",
+      mode = "lines",
+      linetypes = linetypes,
+      line = list(
+        color = "black"
+      )
+    ) |>
+    plotly::layout(
+      title = "EIB as a function of the risk aversion parameter",
+      xaxis = list(title = "Willingness to pay"),
+      yaxis = list(title = "EIB"),
+      legend = list(title = list(text = "Risk aversion"))
+    ) |>
+    plotly::config(displayModeBar = FALSE)
+
+  evir_plot <-
+    plotly::plot_ly(data = evi_dat, linetype = ~r, x = ~k) |>
+    plotly::add_trace(
+      y = ~evir,
+      type = "scatter",
+      mode = "lines",
+      linetypes = linetypes,
+      line = list(
+        color = "black"
+      )
+    ) |>
+    plotly::layout(
+      title = "EVI as a function of the risk aversion parameter",
+      xaxis = list(title = "Willingness to pay"),
+      yaxis = list(title = "EVI"),
+      legend = list(title = list(text = "Risk aversion"))
+    ) |>
+    plotly::config(displayModeBar = FALSE)
+
+  print(list(eibr_plot, evir_plot))
+
+  invisible(list(eib = eibr_plot,
+                 evi = evir_plot))
+}

R/ceac.plot.R

@@ -61,7 +61,7 @@
 #'
 ceac.plot.bcea <- function(he,
                            comparison = NULL,
-                           pos = c(1, 0),
+                           pos = "bottomright",
                            graph = c("base", "ggplot2", "plotly"),
                            ...) {
   graph <- match.arg(graph)

R/ceac_plot_graph.R

@@ -136,7 +136,6 @@ ceac_ggplot <- function(he,
 
   ggplot(data_psa, aes(x = .data$k, y = .data$ceac)) +
     geom_line(aes(linetype = .data$comparison,
-                  linewidth = factor(.data$comparison),
                   colour = factor(.data$comparison))) +
     theme_ceac() + 
     theme_add +                                            # theme
@@ -160,21 +159,15 @@ ceac_ggplot <- function(he,
 #' @rdname ceac_plot_graph
 #' 
 ceac_plot_plotly <- function(he,
-                             pos_legend = "left",
+                             pos_legend = "bottomright",
                              graph_params) {
-
-  comparisons_label <-
-    paste0(he$interventions[he$ref]," vs ",he$interventions[he$comp])
-
   data.psa <- data.frame(
-    k = he$k,
-    ceac = he$ceac,
-    comparison = as.factor(c(
-      sapply(1:he$n_comparisons, function(x) rep(x, length(he$k)))
-    )),
-    label = as.factor(c(
-      sapply(comparisons_label, function(x) rep(x, length(he$k)))
-    )))
+    k = rep(he$k, he$ceac |> ncol()),
+    ceac = he$ceac |> c(),
+    comparison = he$ceac |> colnames() |> as.factor() |> as.numeric() |> sapply(function(x) rep(x, length(he$k))) |> c(),
+    single_label = he$ceac |> colnames() |> as.factor() |> sapply(function(x) rep(x, length(he$k))) |> c()
+  )
+  data.psa$label = paste0(he$interventions[he$ref], " vs ", data.psa$single_label)
 
   graph_params$line$type <- graph_params$line$type %||% rep_len(1:6, he$n_comparisons)
 
@@ -214,7 +207,8 @@ ceac_plot_plotly <- function(he,
         title = graph_params$annot$y,
         range = c(0, 1.005)),
       showlegend = he$n_comparisons > 1, 
-      legend = legend_params)
+      legend = legend_params) |>
+    plotly::hide_colorbar()
 
   plotly::config(ceac, displayModeBar = FALSE)
 }