https://github.com/cran/cutpointr
Tip revision: 7e56c827a694247d212e9a0167a119f917e1f31b authored by Christian Thiele on 31 August 2018, 15:50:10 UTC
version 0.7.4
version 0.7.4
Tip revision: 7e56c82
plot_roc.R
#' Plot ROC curve from a cutpointr object
#'
#' Given a \code{cutpointr} object this function plots the ROC curve(s)
#' per subgroup, if given.
#' @param x A cutpointr object.
#' @param display_cutpoint (logical) Whether or not to display the optimal
#' cutpoint as a dot on the ROC curve.
#' @param ... Additional arguments (unused).
#' @examples
#' opt_cut <- cutpointr(suicide, dsi, suicide)
#' plot_roc(opt_cut, display_cutpoint = FALSE)
#'
#' opt_cut_2groups <- cutpointr(suicide, dsi, suicide, gender)
#' plot_roc(opt_cut_2groups, display_cutpoint = TRUE)
#' @family cutpointr plotting functions
#' @export
plot_roc <- function(x, display_cutpoint = TRUE, ...) {
stopifnot("cutpointr" %in% class(x))
args <- list(...)
predictor <- as.name(x$predictor[1])
outcome <- as.name(x$outcome[1])
if (!(has_column(x, "subgroup"))) {
dts_roc <- "roc_curve"
fll <- NULL
clr <- NULL
clr_roc <- NULL
transparency <- 1
} else {
dts_roc <- c("roc_curve", "subgroup")
fll <- "subgroup"
clr <- "subgroup"
clr_roc <- ~ subgroup
transparency <- 0.6
}
if (!(has_column(x, "subgroup"))) {
roc_title <- ggplot2::ggtitle("ROC curve")
} else {
roc_title <- ggplot2::ggtitle("ROC curve", "by class")
}
if (display_cutpoint) {
optcut_coords <- apply(x, 1, function(r) {
opt_ind <- get_opt_ind(roc_curve = r$roc_curve,
oc = r$optimal_cutpoint,
direction = r$direction)
data.frame(tpr = r$roc_curve$tpr[opt_ind],
tnr = r$roc_curve$tnr[opt_ind])
})
optcut_coords <- do.call(rbind, optcut_coords)
}
res_unnested <- x %>%
dplyr::select_(.dots = dts_roc) %>%
tidyr::unnest_(unnest_cols = "roc_curve")
roc <- ggplot2::ggplot(res_unnested,
ggplot2::aes_(x = ~ 1 - tnr, y = ~ tpr, color = clr_roc)) +
ggplot2::geom_step() +
roc_title +
ggplot2::xlab("1 - Specificity") +
ggplot2::ylab("Sensitivity") +
ggplot2::theme(aspect.ratio = 1)
if (display_cutpoint) {
roc <- roc + ggplot2::geom_point(data = optcut_coords, color = "black")
}
return(roc)
}