https://github.com/cran/cutpointr
Raw File
Tip revision: 7e56c827a694247d212e9a0167a119f917e1f31b authored by Christian Thiele on 31 August 2018, 15:50:10 UTC
version 0.7.4
Tip revision: 7e56c82
plot_metric_boot.R
#' Plot the bootstrapped metric distribution from a cutpointr object
#'
#' Given a \code{cutpointr} object this function plots the bootstrapped metric distribution,
#' i.e. the distribution of out-of-bag metric values.
#' The metric depends on the function that was supplied to \code{metric} in the
#' call to \code{cutpointr}.
#' The \code{cutpointr} function has to be run with \code{boot_runs}` > 0 to enable bootstrapping.
#' @param x A cutpointr object.
#' @param ... Additional arguments (unused)
#' @examples
#' set.seed(300)
#' opt_cut <- cutpointr(suicide, dsi, suicide, boot_runs = 10)
#' plot_metric_boot(opt_cut)
#' @family cutpointr plotting functions
#' @export
plot_metric_boot <- function(x, ...) {

    args <- list(...)

    if (!(has_column(x, "subgroup"))) {
        dts_boot <- "boot"
        dts <- "data"
        fll <- NULL
        clr <- NULL
        transparency <- 1
    } else {
        dts_boot <- c("boot", "subgroup")
        dts <- c("data", "subgroup")
        fll <- "subgroup"
        clr <- "subgroup"
        transparency <- 0.6
    }

    if(has_boot_results(x)) {
        res_boot_unnested <- x %>%
            dplyr::select_(.dots = dts_boot) %>%
            dplyr::mutate_(boot = ~ prepare_bind_rows(boot)) %>%
            tidyr::unnest_(unnest_cols = "boot") %>%
            dplyr::select_(.dots = list("-roc_curve_b", "-roc_curve_oob"))
        # If multiple optimal cutpoints optimal_cutpoint is a list
        if (is.list(res_boot_unnested$optimal_cutpoint)) {
            res_boot_unnested <- res_boot_unnested %>%
                tidyr::unnest_()
        }
        metric_name <- find_metric_name_boot(res_boot_unnested)
        if (all(na_inf_omit(get(metric_name, res_boot_unnested) %% 1 == 0)) |
            only_one_unique(na_inf_omit(get(metric_name, res_boot_unnested)))) {
            all_integer = TRUE
            dist_plot <- ggplot2::geom_bar(alpha = 1, position = "dodge")
        } else {
            all_integer = FALSE
            dist_plot <- ggplot2::geom_density(alpha = transparency)
        }
        boot_metric <- suppressMessages(
            ggplot2::ggplot(res_boot_unnested,
                            ggplot2::aes_string(x = metric_name,
                                                fill = fll, color = clr)) +
                dist_plot +
                ggplot2::ggtitle("Bootstrap", "out-of-bag estimates") +
                ggplot2::xlab(metric_name)
        )
        if (!all_integer) boot_metric <- boot_metric +
            ggplot2::geom_rug(alpha = 0.5)
    } else {
        stop("No bootstrap results found. Was boot_runs > 0 in cutpointr?")
    }

    return(boot_metric)
}
back to top