#' Sensitivity and specificity plot from a cutpointr object
#'
#' Given a \code{cutpointr} object this function plots the sensitivity and specificity
#' curve(s) per subgroup, if the latter is given.
#' @param x A cutpointr object.
#' @param display_cutpoint (logical) Whether or not to display the optimal
#' cutpoint as a dot on the precision recall curve.
#' @param ... Additional arguments (unused).
#' @examples
#' library(cutpointr)
#'
#' ## Optimal cutpoint for dsi
#' data(suicide)
#' opt_cut <- cutpointr(suicide, dsi, suicide)
#' plot_sensitivity_specificity(opt_cut)
#' @family cutpointr plotting functions
#' @export
#' @importFrom purrr %>%
plot_sensitivity_specificity <- function(x, display_cutpoint = TRUE, ...) {
if (!("cutpointr" %in% class(x))) {
stop("Only cutpointr objects are supported.")
}
args <- list(...)
if (!(has_column(x, "subgroup"))) {
dts_pr <- c("roc_curve", "optimal_cutpoint")
} else {
dts_pr <- c("roc_curve", "subgroup", "optimal_cutpoint")
}
plot_title <- ggplot2::ggtitle("Sensitivity and Specificity Plot")
for (r in 1:nrow(x)) {
x$roc_curve[[r]] <- x$roc_curve[[r]] %>%
dplyr::mutate(Sensitivity = tp / (tp + fn),
Specificity = tn / (tn + fp))
}
res_unnested <- x %>%
dplyr::select(dts_pr) %>%
tidyr::unnest(.data$roc_curve)
res_unnested <- res_unnested[is.finite(res_unnested$x.sorted), ]
res_unnested <- tidyr::gather(res_unnested, key = "metric", value = "value",
Sensitivity, Specificity)
if (!(has_column(x, "subgroup"))) {
pr <- ggplot2::ggplot(res_unnested,
ggplot2::aes(x = x.sorted, y = value,
color = metric))
} else {
pr <- ggplot2::ggplot(res_unnested,
ggplot2::aes(x = x.sorted, y = value,
color = metric, linetype = subgroup))
}
pr <- pr +
ggplot2::geom_line() +
plot_title +
ggplot2::xlab("Cutpoint") +
ggplot2::ylab("Sensitivity and Specificity")
if (display_cutpoint) {
if (!(has_column(x, "subgroup"))) {
res_cutpoints <- x %>%
dplyr::select(.data$optimal_cutpoint)
if (is.list(res_cutpoints$optimal_cutpoint)) {
res_cutpoints <- tidyr::unnest(res_cutpoints)
}
pr <- pr +
ggplot2::geom_vline(data = res_cutpoints,
ggplot2::aes(xintercept = optimal_cutpoint))
} else {
res_cutpoints <- x %>%
dplyr::select(.data$optimal_cutpoint, .data$subgroup)
if (is.list(res_cutpoints$optimal_cutpoint)) {
res_cutpoints <- tidyr::unnest(res_cutpoints)
}
pr <- pr +
ggplot2::geom_vline(data = res_cutpoints,
ggplot2::aes(xintercept = optimal_cutpoint,
linetype = subgroup))
}
}
return(pr)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.