R/contour_plotly_lines.R

In BCEA: Bayesian Cost Effectiveness Analysis

#' Add contour lines to a plotly contour or CE plane plot
#' 
#' @param plotly plotly object generated by calling function
#' @param he bcea object of interest
#' @param delta_ce Object generated by calling function (long format)
#' @param graph_params Other graphical parameters
#' @param pt_cols Vector of colours for the interventions
#'
#' @importFrom plotly add_contour
#' @keywords internal
#' 
#' @seealso [contour_plotly()]
#' 

contour_plotly_lines = function(plotly, he, delta_ce, graph_params, pt_cols) {
  density <- lapply(
    1:ncol(he$delta_e),
    function(ndx) {
      MASS::kde2d(
        delta_ce$delta_e[delta_ce$comparison |> as.numeric() == ndx],
        delta_ce$delta_c[delta_ce$comparison |> as.numeric() == ndx],
        n = 300,
        h = c(sd(he$delta_e[, ndx] |> c())/graph_params$scale,
              sd(he$delta_c[, ndx] |> c())/graph_params$scale))
    })
  
  for (ii in seq_along(density)) {
    density[[ii]]$z = density[[ii]]$z/max(density[[ii]]$z)
    density[[ii]]$comparison = factor(ii, levels = 1:length(density), labels = levels(delta_ce$comparison))
  }
  
  for (ndx in seq_along(density)) {
    # work-around for uneven contour levels: add one trace per contour line
    # drawback is that this is quite slow unfortunately
    for (contour_line in graph_params$levels) {
      plotly = plotly |>
        plotly::add_contour(
          z = density[[ndx]]$z,
          x = density[[ndx]]$x,
          y = density[[ndx]]$y,
          transpose = TRUE,
          showlegend = FALSE,
          showscale = FALSE,
          autocolorscale = FALSE,
          contours = list(
            type = "constraint",
            showlabels = TRUE,
            operation = "=",
            value = contour_line
          ),
          line = list(
            color = pt_cols[ndx]
          )
        )
    }
  }
  
  return(plotly)
}