R/etc_utils_fortify.R

In precrec: Calculate Accurate Precision-Recall and ROC (Receiver Operator Characteristics) Curves

#' Convert a curves and points object to a data frame for ggplot2
#'
#' The \code{fortify} function converts an \code{S3} object generated by
#'   \code{\link{evalmod}} to a data frame for \pkg{ggplot2}.
#'
#' @param model An \code{S3} object generated by \code{\link{evalmod}}.
#'   The \code{fortify} function takes one of the following \code{S3} objects.
#'
#' \enumerate{
#'
#'   \item ROC and Precision-Recall curves (mode = "rocprc")
#'
#'   \tabular{lll}{
#'     \strong{\code{S3} object}
#'     \tab \strong{# of models}
#'     \tab \strong{# of test datasets} \cr
#'
#'     sscurves \tab single   \tab single   \cr
#'     mscurves \tab multiple \tab single   \cr
#'     smcurves \tab single   \tab multiple \cr
#'     mmcurves \tab multiple \tab multiple
#'   }
#'
#'   \item Basic evaluation measures (mode = "basic")
#'
#'   \tabular{lll}{
#'     \strong{\code{S3} object}
#'     \tab \strong{# of models}
#'     \tab \strong{# of test datasets} \cr
#'
#'     sspoints \tab single   \tab single   \cr
#'     mspoints \tab multiple \tab single   \cr
#'     smpoints \tab single   \tab multiple \cr
#'     mmpoints \tab multiple \tab multiple
#'   }
#' }
#'
#' See the \strong{Value} section of \code{\link{evalmod}} for more details.
#'
#' @param data Not used by this method.
#'
#' @param raw_curves A Boolean value to specify whether raw curves are
#'   shown instead of the average curve. It is effective only
#'   when \code{raw_curves} is set to \code{TRUE}
#'   of the \code{\link{evalmod}} function.
#'
#' @param reduce_points A Boolean value to decide whether the points should
#'   be reduced. The points are reduced according to \code{x_bins}
#'   of the \code{\link{evalmod}} function. The default values is \code{FALSE}.
#'
#' @param ... Not used by this method.
#'
#' @return The \code{fortify} function returns a data frame for
#'   \pkg{ggplot2}.
#'
#' @seealso \code{\link{evalmod}} for generating \code{S3} objects with
#'   performance evaluation measures.
#'   \code{\link{autoplot}} for plotting with \pkg{ggplot2}.
#'
#' @examples
#' \dontrun{
#'
#' ## Load library
#' library(ggplot2)
#'
#' ##################################################
#' ### Single model & single test dataset
#' ###
#'
#' ## Load a dataset with 10 positives and 10 negatives
#' data(P10N10)
#'
#' ## Generate an sscurve object that contains ROC and Precision-Recall curves
#' sscurves <- evalmod(scores = P10N10$scores, labels = P10N10$labels)
#'
#' ## Let ggplot internally call fortify
#' p_rocprc <- ggplot(sscurves, aes(x = x, y = y))
#' p_rocprc <- p_rocprc + geom_line()
#' p_rocprc <- p_rocprc + facet_wrap(~curvetype)
#' p_rocprc
#'
#' ## Explicitly fortify sscurves
#' ssdf <- fortify(sscurves)
#'
#' ## Plot a ROC curve
#' p_roc <- ggplot(subset(ssdf, curvetype == "ROC"), aes(x = x, y = y))
#' p_roc <- p_roc + geom_line()
#' p_roc
#'
#' ## Plot a Precision-Recall curve
#' p_prc <- ggplot(subset(ssdf, curvetype == "PRC"), aes(x = x, y = y))
#' p_prc <- p_prc + geom_line()
#' p_prc
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(
#'   mode = "basic", scores = P10N10$scores,
#'   labels = P10N10$labels
#' )
#' ## Fortify sspoints
#' ssdf <- fortify(sspoints)
#'
#' ## Plot normalized ranks vs. precision
#' p_prec <- ggplot(subset(ssdf, curvetype == "precision"), aes(x = x, y = y))
#' p_prec <- p_prec + geom_point()
#' p_prec
#'
#'
#' ##################################################
#' ### Multiple models & single test dataset
#' ###
#'
#' ## Create sample datasets with 10 positives and 10 negatives
#' samps <- create_sim_samples(1, 10, 10, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)
#'
#' ## Let ggplot internally call fortify
#' p_rocprc <- ggplot(mscurves, aes(x = x, y = y, color = modname))
#' p_rocprc <- p_rocprc + geom_line()
#' p_rocprc <- p_rocprc + facet_wrap(~curvetype)
#' p_rocprc
#'
#' ## Explicitly fortify mscurves
#' msdf <- fortify(mscurves)
#'
#' ## Plot ROC curve
#' df_roc <- subset(msdf, curvetype == "ROC")
#' p_roc <- ggplot(df_roc, aes(x = x, y = y, color = modname))
#' p_roc <- p_roc + geom_line()
#' p_roc
#'
#' ## Fortified data frame can be used for plotting a Precision-Recall curve
#' df_prc <- subset(msdf, curvetype == "PRC")
#' p_prc <- ggplot(df_prc, aes(x = x, y = y, color = modname))
#' p_prc <- p_prc + geom_line()
#' p_prc
#'
#' ## Generate an mspoints object that contains basic evaluation measures
#' mspoints <- evalmod(mdat, mode = "basic")
#'
#' ## Fortify mspoints
#' msdf <- fortify(mspoints)
#'
#' ## Plot normalized ranks vs. precision
#' df_prec <- subset(msdf, curvetype == "precision")
#' p_prec <- ggplot(df_prec, aes(x = x, y = y, color = modname))
#' p_prec <- p_prec + geom_point()
#' p_prec
#'
#'
#' ##################################################
#' ### Single model & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 10 positives and 10 negatives
#' samps <- create_sim_samples(5, 10, 10, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)
#'
#' ## Let ggplot internally call fortify
#' p_rocprc <- ggplot(smcurves, aes(x = x, y = y, group = dsid))
#' p_rocprc <- p_rocprc + geom_smooth(stat = "identity")
#' p_rocprc <- p_rocprc + facet_wrap(~curvetype)
#' p_rocprc
#'
#' ## Explicitly fortify smcurves
#' smdf <- fortify(smcurves, raw_curves = FALSE)
#'
#' ## Plot average ROC curve
#' df_roc <- subset(smdf, curvetype == "ROC")
#' p_roc <- ggplot(df_roc, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_roc <- p_roc + geom_smooth(stat = "identity")
#' p_roc
#'
#' ## Plot average Precision-Recall curve
#' df_prc <- subset(smdf, curvetype == "PRC")
#' p_prc <- ggplot(df_prc, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_prc <- p_prc + geom_smooth(stat = "identity")
#' p_prc
#'
#' ## Generate an smpoints object that contains basic evaluation measures
#' smpoints <- evalmod(mdat, mode = "basic")
#'
#' ## Fortify smpoints
#' smdf <- fortify(smpoints)
#'
#' ## Plot normalized ranks vs. precision
#' df_prec <- subset(smdf, curvetype == "precision")
#' p_prec <- ggplot(df_prec, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_prec <- p_prec + geom_ribbon(aes(min = ymin, ymax = ymax),
#'   stat = "identity", alpha = 0.25,
#'   fill = "grey25"
#' )
#' p_prec <- p_prec + geom_point(aes(x = x, y = y))
#' p_prec
#'
#'
#' ##################################################
#' ### Multiple models & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 10 positives and 10 negatives
#' samps <- create_sim_samples(5, 10, 10, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)
#'
#' ## Let ggplot internally call fortify
#' p_rocprc <- ggplot(mmcurves, aes(x = x, y = y, group = dsid))
#' p_rocprc <- p_rocprc + geom_smooth(aes(color = modname), stat = "identity")
#' p_rocprc <- p_rocprc + facet_wrap(~curvetype)
#' p_rocprc
#'
#' ## Explicitly fortify mmcurves
#' mmdf <- fortify(mmcurves, raw_curves = FALSE)
#'
#' ## Plot average ROC curve
#' df_roc <- subset(mmdf, curvetype == "ROC")
#' p_roc <- ggplot(df_roc, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_roc <- p_roc + geom_smooth(aes(color = modname), stat = "identity")
#' p_roc
#'
#' ## Plot average Precision-Recall curve
#' df_prc <- subset(mmdf, curvetype == "PRC")
#' p_prc <- ggplot(df_prc, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_prc <- p_prc + geom_smooth(aes(color = modname), stat = "identity")
#' p_prc
#'
#' ## Generate an mmpoints object that contains basic evaluation measures
#' mmpoints <- evalmod(mdat, mode = "basic")
#'
#' ## Fortify mmpoints
#' mmdf <- fortify(mmpoints)
#'
#' ## Plot normalized ranks vs. precision
#' df_prec <- subset(mmdf, curvetype == "precision")
#' p_prec <- ggplot(df_prec, aes(x = x, y = y, ymin = ymin, ymax = ymax))
#' p_prec <- p_prec + geom_ribbon(aes(min = ymin, ymax = ymax, group = modname),
#'   stat = "identity", alpha = 0.25,
#'   fill = "grey25"
#' )
#' p_prec <- p_prec + geom_point(aes(x = x, y = y, color = modname))
#' p_prec
#' }
#'
#' @name fortify
NULL


#
# Process ... for curve objects
#
.get_fortify_arglist <- function(evalmod_args, def_raw_curves, ...) {
  arglist <- list(...)

  if (!is.null(def_raw_curves)) {
    arglist[["raw_curves"]] <- def_raw_curves
  } else if (!is.null(evalmod_args[["raw_curves"]])) {
    arglist[["raw_curves"]] <- evalmod_args[["raw_curves"]]
  } else {
    arglist[["raw_curves"]] <- FALSE
  }

  arglist
}