# (c) Jim Vine
# Author: Jim Vine
# plotting function for collections of interpretation_result objects.
#' Plotting function for collection of interpretation_result objects
#'
#' Produces a plot presenting a collection of
#' \code{\link{interpretation_result}}
#' objects on a single chart. If the \code{interpretation_result} objects are
#' named then the names will be used for labelling the relevant intervals on
#' the chart.
#'
#' For a single \code{interpretation_result} object a \code{plot()} method is
#' provided; see \code{\link{plot.interpretation_result}}.
#'
#' To be a valid group of \code{interpretation_result} objects, each of the
#' items in \code{x} must be a valid \code{interpretation_result}, and they
#' must all share some characteristics. Each of the component objects must have
#' been generated using the same \code{interpretation_set}, with the same
#' boundaries, and the \code{low_to_high} parameter must be the same. This
#' enables them to be meaningfully plotted on the same canvas.
#'
#' @param x
#' A list of \code{interpretation_result} objects, length at least 2. The
#' objects may optionally be named. See Details.
#' @param estimates
#' Estimate values that the intervals assessed in each
#' \code{interpretation_result} object relate to. If not specified, a default
#' of the central point between the two ends of each interval will be assumed.
#' @param ...
#' Further arguments passed to and from methods.
#'
#' @inheritParams plot_region_canvas
#' @inheritParams plot_intervals
#' @inheritParams plot.interpretation_result
#' @inheritParams plot_intervals_norm
#'
#' @examples
#'
#' # Set up some intervals to test:
#' ci_stage_1 <- matrix(c(0.023, 0.131), nrow = 1,
#' dimnames = list("estimate", c("2.5 %", "97.5 %")))
#' ci_stage_2 <- matrix(c(-0.016, 0.096), nrow = 1,
#' dimnames = list("estimate", c("2.5 %", "97.5 %")))
#' # Conduct the interpretations:
#'interp_stage_1 <- interpret_noninferiority(ci_stage_1, actual_null = 0,
#' ni_margin = 0.05,
#' groups = c("Business as usual",
#' "New approach"))
#'interp_stage_2 <- interpret_noninferiority(ci_stage_2, actual_null = 0,
#' ni_margin = 0.05,
#' groups = c("Business as usual",
#' "New approach"))
#'
#' # Assemble the list object:
#' interp_1_and_2 <- list("Stage 1" = interp_stage_1,
#' "Stage 2" = interp_stage_2)
#' # Set a nice colour scheme
#' grDevices::palette(c("#FF671F99", "#F2A90099", "#0085CA99"))
#' plot_interpretation_result_list(interp_1_and_2,
#' boundary_label_pos = "on top")
#'
#' @export
#'
plot_interpretation_result_list <- function(x,
extra_boundaries = NULL,
estimates = NULL,
boundary_values = TRUE,
boundary_label_pos = "below",
interpretation_label_pos = "right",
x_axis_pos = "below",
y_axis_pos = "none",
inner_margin = c(-0.1, 0.05,
-0.1, 0.05),
edge_margin = c(0, 0.02, 0, 0.02),
edge_type = "gradient",
interval_type = "norm",
y_scale = 0.75,
interval_value_labels = TRUE,
estimate_value_labels = TRUE,
plot_estimate_marks = TRUE,
...) {
validate_result_list(x)
interpretation_set <- x[[1]]$parameters$interpretation_set
names(x[[1]]$parameters$boundaries) <- interpretation_set$boundary_names
# Extract values from each of the interpretation_result objects
ci <- t(sapply(sapply(x, "[[", "parameters", simplify = FALSE), "[[", "ci"))
interpretations_short <- sapply(x, "[[", "interpretation_short")
plot_region_canvas(boundaries = x[[1]]$parameters$boundaries,
extra_boundaries = extra_boundaries,
values = ci,
interpretations = interpretations_short,
boundary_values = boundary_values,
boundary_label_pos = boundary_label_pos,
interpretation_label_pos = interpretation_label_pos,
x_axis_pos = x_axis_pos,
y_axis_pos = y_axis_pos,
inner_margin = inner_margin,
edge_margin = edge_margin,
edge_type = edge_type,
...)
plot_intervals(intervals = ci[(nrow(ci) : 1), ],
estimates = rev(estimates),
interval_type = interval_type,
y_scale = y_scale,
interval_value_labels = interval_value_labels,
estimate_value_labels = estimate_value_labels,
plot_estimate_marks = plot_estimate_marks,
...)
if(!is.null(names(x))) {
graphics::text(x = rowMeans(ci),
y = (nrow(ci) : 1),
names(x))
}
}
#' Validates a collection of interpretation_result objects
#'
#' Checks that a collection of interpretation_result objects has been correctly
#' assembled for use in the plotting function.
#'
#' To be a valid group of \code{interpretation_result} objects, each of the
#' items in \code{x} must be a valid \code{interpretation_result}, and they
#' must all share some characteristics. Each of the component objects must have
#' been generated using the same \code{interpretation_set}, with the same
#' boundaries, and the \code{low_to_high} parameter must be the same.
#'
#' @inheritParams plot_interpretation_result_list
#'
validate_result_list <- function(x) {
if(length(x) < 2) {
stop(paste("The interpretation_result list should be at least length 2",
"to use this."))
}
# Check that the set is valid.
# Check the first one alone, since for the loop can then go from 2:last
validate_interpretation_result(x[[1]])
for (i in 2 : length(x)) {
# All items are valid results in their own right.
validate_interpretation_result(x[[i]])
# All items have the same interpretation_set_name
if (x[[i]]$parameters$interpretation_set_name !=
x[[1]]$parameters$interpretation_set_name) {
stop(paste("All results in a set ought to have been generated using",
"the same interpretation_set. (Some values of",
"$parameters$interpretation_set_name are not equal.)"))
}
# All have the same interpretation_set objects
if (!isTRUE(all.equal(x[[i]]$parameters$interpretation_set,
x[[1]]$parameters$interpretation_set))) {
stop(paste("All results in a set ought to have been generated using",
"the same interpretation_set. (Some values of",
"$parameters$interpretation_set are not equal.)"))
}
# All items have the same boundaries
if (!isTRUE(all.equal(x[[i]]$parameters$boundaries,
x[[1]]$parameters$boundaries))) {
stop(paste("All results in a set ought to have been generated using",
"the same boundaries. (Some values of",
"$parameters$boundaries are not equal.)"))
}
# All items have the same low_to_high
if (!isTRUE(all.equal(x[[i]]$parameters$low_to_high,
x[[1]]$parameters$low_to_high))) {
stop(paste("All results in a set ought to have been generated using",
"the same boundary order. (Some values of",
"$parameters$low_to_high are not equal.)"))
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.