R/etc_utils_plot.R

#' Plot performance evaluation measures
#'
#' The \code{plot} function creates a plot of performance evaluation measures.
#'
#' @param x An \code{S3} object generated by \code{\link{evalmod}}.
#'   The \code{plot} function accepts 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 y Equivalent with \code{curvetype}.
#'
#' @param ... All the following arguments can be specified.
#'
#' \describe{
#'   \item{curvetype}{
#'     \enumerate{
#'
#'       \item ROC and Precision-Recall curves (mode = "rocprc")
#'         \tabular{ll}{
#'           \strong{curvetype}
#'           \tab \strong{description} \cr
#'
#'           ROC \tab ROC curve \cr
#'           PRC \tab Precision-Recall curve
#'         }
#'         Multiple \code{curvetype} can be combined, such as
#'         \code{c("ROC", "PRC")}.
#'
#'       \item Basic evaluation measures (mode = "basic")
#'         \tabular{ll}{
#'           \strong{curvetype}
#'           \tab \strong{description} \cr
#'
#'           error \tab Normalized ranks vs. error rate \cr
#'           accuracy \tab Normalized ranks vs. accuracy \cr
#'           specificity \tab Normalized ranks vs. specificity \cr
#'           sensitivity \tab Normalized ranks vs. sensitivity \cr
#'           precision \tab Normalized ranks vs. precision \cr
#'           mcc \tab Normalized ranks vs. Matthews correlation coefficient \cr
#'           fscore \tab Normalized ranks vs. F-score
#'        }
#'        Multiple \code{curvetype} can be combined, such as
#'        \code{c("precision", "sensitivity")}.
#'     }
#'   }
#'   \item{type}{
#'     A character to specify the line type as follows.
#'     \describe{
#'       \item{"l"}{lines}
#'       \item{"p"}{points}
#'       \item{"b"}{both lines and points}
#'     }
#'   }
#'   \item{show_cb}{
#'     A Boolean value to specify whether point-wise confidence
#'     bounds are drawn. It is effective only when \code{calc_avg} of the
#'     \code{\link{evalmod}} function is set to \code{TRUE}.
#'   }
#'   \item{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} of the \code{\link{evalmod}} function is set to
#'     \code{TRUE}.
#'   }
#'   \item{show_legend}{
#'     A Boolean value to specify whether the legend is shown.
#'   }
#' }
#'
#' @return The \code{plot} function shows a plot and returns NULL.
#'
#' @seealso \code{\link{evalmod}} for generating an \code{S3} object.
#'   \code{\link{autoplot}} for plotting the equivalent curves
#'   with \pkg{ggplot2}.
#'
#' @examples
#'
#' \dontrun{
#' ##################################################
#' ### 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)
#'
#' ## Plot both ROC and Precision-Recall curves
#' plot(sscurves)
#'
#' ## Plot a ROC curve
#' plot(sscurves, curvetype = "ROC")
#'
#' ## Plot a Precision-Recall curve
#' plot(sscurves, curvetype = "PRC")
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
#'                     labels = P10N10$labels)
#'
#' ## Plot normalized ranks vs. basic evaluation measures
#' plot(sspoints)
#'
#' ## Plot normalized ranks vs. precision
#' plot(sspoints, curvetype = "precision")
#'
#'
#' ##################################################
#' ### Multiple models & single test dataset
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(1, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]])
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)
#'
#' ## Plot both ROC and Precision-Recall curves
#' plot(mscurves)
#'
#' ## Hide the legend
#' plot(mscurves, show_legend = FALSE)
#'
#' ## Generate an mspoints object that contains basic evaluation measures
#' mspoints <- evalmod(mdat, mode = "basic")
#'
#' ## Plot normalized ranks vs. basic evaluation measures
#' plot(mspoints)
#'
#' ## Hide the legend
#' plot(mspoints, show_legend = FALSE)
#'
#'
#' ##################################################
#' ### Single model & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(10, 100, 100, "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)
#'
#' ## Plot average ROC and Precision-Recall curves
#' plot(smcurves, raw_curves = FALSE)
#'
#' ## Hide confidence bounds
#' plot(smcurves, raw_curves = FALSE, show_cb = FALSE)
#'
#' ## Plot raw ROC and Precision-Recall curves
#' plot(smcurves, raw_curves = TRUE, show_cb = FALSE)
#'
#' ## Generate an smpoints object that contains basic evaluation measures
#' smpoints <- evalmod(mdat, mode = "basic")
#'
#' ## Plot normalized ranks vs. average basic evaluation measures
#' plot(smpoints)
#'
#'
#' ##################################################
#' ### Multiple models & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(10, 100, 100, "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)
#'
#' ## Plot average ROC and Precision-Recall curves
#' plot(mmcurves, raw_curves = FALSE)
#'
#' ## Show confidence bounds
#' plot(mmcurves, raw_curves = FALSE, show_cb = TRUE)
#'
#' ## Plot raw ROC and Precision-Recall curves
#' plot(mmcurves, raw_curves = TRUE)
#'
#' ## Generate an mmpoints object that contains basic evaluation measures
#' mmpoints <- evalmod(mdat, mode = "basic")
#'
#' ## Plot normalized ranks vs. average basic evaluation measures
#' plot(mmpoints)
#'
#'
#' ##################################################
#' ### N-fold cross validation datasets
#' ###
#'
#' ## Load test data
#' data(M2N50F5)
#'
#' ## Speficy nessesary columns to create mdat
#' cvdat <- mmdata(nfold_df = M2N50F5, score_cols = c(1, 2),
#'                 lab_col = 3, fold_col = 4,
#'                 modnames = c("m1", "m2"), dsids = 1:5)
#'
#' ## Generate an mmcurve object that contains ROC and Precision-Recall curves
#' cvcurves <- evalmod(cvdat)
#'
#' ## Average ROC and Precision-Recall curves
#' plot(cvcurves)
#'
#' ## Show confidence bounds
#' plot(cvcurves, show_cb = TRUE)
#'
#' ## Generate an mmpoints object that contains basic evaluation measures
#' cvpoints <- evalmod(cvdat, mode = "basic")
#'
#' ## Normalized ranks vs. average basic evaluation measures
#' plot(cvpoints)
#'
#'}
#' @name plot
NULL

#
# Check partial match - ROC and PRC curve type
#
.pmatch_curvetype_rocprc <- function(vals) {
  pfunc <- function(val) {
    if (assertthat::is.string(val)) {
      sval <- tolower(val)

      if (!is.na(pmatch(sval, "roc"))) {
        return("ROC")
      }

      if (!is.na(pmatch(sval, "prc"))) {
        return("PRC")
      }
    }

    val
  }

  unlist(lapply(vals, pfunc))
}

#
# Check partial match - Basic evaluation measures
#
.pmatch_curvetype_basic <- function(vals) {

  pfunc <- function(val) {
    if (assertthat::is.string(val)) {
      sval <- tolower(val)

      if (!is.na(pmatch(sval, "error rate"))) {
        return("error")
      }

      if (!is.na(pmatch(sval, "accuracy"))) {
        return("accuracy")
      }

      if (!is.na(pmatch(sval, "specificity")) || sval == "tnr") {
        return("specificity")
      }

      if (!is.na(pmatch(sval, "sensitivity"))
          || !is.na(pmatch(sval, "recall")) || sval == "tpr" || sval == "sn") {
        return("sensitivity")
      }

      if (!is.na(pmatch(sval, "precision")) || sval == "ppv") {
        return("precision")
      }

      if (!is.na(pmatch(sval, "matthews correlation coefficient"))
          || sval == "mcc") {
        return("mcc")
      }

      if (!is.na(pmatch(sval, "fscore")) || !is.na(pmatch(sval, "f1score"))) {
        return("fscore")
      }

      if (!is.na(pmatch(sval, "score"))) {
        return("score")
      }

      if (!is.na(pmatch(sval, "label"))) {
        return("label")
      }
    }

    val
  }

  unlist(lapply(vals, pfunc))
}

#
# Process ... for curve objects
#
.get_plot_arglist <- function(evalmod_args, y,
                              def_curvetype, def_type, def_show_cb,
                              def_raw_curves, def_add_np_nn, def_show_legend,
                              ...) {
  arglist <- list(...)

  if (!is.null(y)) {
    arglist[["curvetype"]] <- y
  }

  if (is.null(arglist[["curvetype"]])){
    arglist[["curvetype"]] <- def_curvetype
  }

  if (is.null(arglist[["type"]])){
    arglist[["type"]] <- def_type
  }

  if (is.null(arglist[["show_cb"]])){
    arglist[["show_cb"]] <- def_show_cb
  }
  if (!evalmod_args[["calc_avg"]] && arglist[["show_cb"]]) {
    stop("Invalid show_cb. Inconsistent with calc_avg of evalmod.",
         call. = FALSE)
  }

  if (is.null(arglist[["raw_curves"]])){
    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
    }
  }
  if (!evalmod_args[["raw_curves"]] && arglist[["raw_curves"]]) {
    stop("Invalid raw_curves. Inconsistent with the value of evalmod.",
         call. = FALSE)
  }

  if (is.null(arglist[["add_np_nn"]])){
    arglist[["add_np_nn"]] <- def_add_np_nn
  }

  if (is.null(arglist[["show_legend"]])){
    arglist[["show_legend"]] <- def_show_legend
  }

  arglist

}

#
# Plot ROC and Precision-Recall
#
.plot_multi <- function(x, arglist) {
  curvetype <- arglist[["curvetype"]]
  type <- arglist[["type"]]
  raw_curves <- arglist[["raw_curves"]]
  add_np_nn <- arglist[["add_np_nn"]]
  show_legend <- arglist[["show_legend"]]

  show_cb <- arglist[["show_cb"]]
  if (!attr(x, "args")$calc_avg) {
    show_cb = FALSE
  }

  raw_curves <- arglist[["raw_curves"]]
  if (show_cb) {
    raw_curves = FALSE
  }

  # === Validate input arguments ===
  .validate(x)
  .check_curvetype(curvetype, x)
  .check_type(type)
  .check_show_cb(show_cb, x)
  .check_raw_curves(raw_curves, x)
  .check_add_np_nn(add_np_nn)
  .check_show_legend(show_legend)

  # === Create a plot ===
  show_legend2 <- show_legend
  if (length(curvetype) > 1) {
    .set_layout(length(curvetype), show_legend)
    on.exit(graphics::layout(1), add = TRUE)
    show_legend2 <- FALSE
  }

  for (ct in curvetype) {
    .plot_single(x, ct, type = type, show_cb = show_cb,
                 raw_curves = raw_curves, add_np_nn = add_np_nn,
                 show_legend = show_legend2)
  }
  if (length(curvetype) > 4 && length(curvetype) %% 3 == 2) {
    graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
  }
  if (length(curvetype) > 4 && length(curvetype) %% 3 == 1) {
    graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
    graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
  }

  if (length(curvetype) > 1) {
    .show_legend(x, show_legend)
  }
}

#
# Set layout
#
.set_layout <- function(ctype_len, show_legend) {

  if (ctype_len == 1) {
    nrow1 <- 2
    ncol1 <- 1
    mat1 <- c(1, 2)
    mat2 <- c(1)
    heights <- c(0.85, 0.15)
  } else  if (ctype_len == 2) {
    nrow1 <- 2
    ncol1 <- 2
    mat1 <- c(1, 2, 3, 3)
    mat2 <- c(1, 2)
    heights <- c(0.85, 0.15)
  } else if (ctype_len == 3) {
    nrow1 <- 2
    ncol1 <- 3
    mat1 <- c(1, 2, 3, 4, 4, 4)
    mat2 <- c(1, 2, 3)
    heights <- c(0.85, 0.15)
  } else if (ctype_len == 4) {
    nrow1 <- 3
    ncol1 <- 2
    mat1 <- c(1, 2, 3, 4, 5, 5)
    mat2 <- c(1, 2, 3, 4)
    heights <- c(0.425, 0.425, 0.15)
  } else if (ctype_len == 5 || ctype_len == 6) {
    nrow1 <- 3
    ncol1 <- 3
    mat1 <- c(1, 2, 3, 4, 5, 6, 7, 7, 7)
    mat2 <- c(1, 2, 3, 4, 5, 6)
    heights <- c(0.425, 0.425, 0.15)
  } else if (ctype_len == 7 || ctype_len == 8 || ctype_len == 9) {
    nrow1 <- 4
    ncol1 <- 3
    mat1 <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 10, 10)
    mat2 <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
    heights <- c(0.28, 0.28, 0.28, 0.16)
  }

  if (show_legend) {
    m <- matrix(mat1, nrow = nrow1, ncol = ncol1, byrow = TRUE)
    graphics::layout(mat = m, heights = heights)
  } else {
    m <- matrix(mat2, nrow = nrow1 - 1, ncol = ncol1, byrow = TRUE)
    graphics::layout(mat = m)
  }
}

#
# matplot wrapper
#
.matplot_wrapper <- function(obj, type, curvetype, main, xlab, ylab) {

  # === Validate input arguments ===
  .validate(obj[[curvetype]])

  # === Create line colours ===
  model_type <- attr(obj, "model_type")

  if (model_type == "single") {
    line_col <- "black"
  } else {
    line_col <- .make_multi_colors(obj)
  }

  # === Create a plot ===
  xlim <- .get_xlim(obj, curvetype)
  ylim <- .get_ylim(obj, curvetype)
  mats <- .make_matplot_mats(obj[[curvetype]])
  graphics::matplot(mats[["x"]], mats[["y"]], type = type, lty = 1, pch = 19,
                    col = line_col, main = main, xlab = xlab, ylab = ylab,
                    ylim = ylim, xlim = xlim)
}

#
# Make matrices for matplot
#
.make_matplot_mats <- function(obj) {
  ncol <- length(obj)

  max_nrow <- max(unlist(lapply(obj, function(o) length(o[["x"]]))))

  x <- matrix(as.double(NA), nrow = max_nrow, ncol = ncol)
  y <- matrix(as.double(NA), nrow = max_nrow, ncol = ncol)

  for (i in seq_along(obj)) {
    x[1:length(obj[[i]][["x"]]), i] <- obj[[i]][["x"]]
    y[1:length(obj[[i]][["y"]]), i] <- obj[[i]][["y"]]
  }

  list(x = x, y = y)
}

#
# Make colours for multiple models and multiple datasets
#
.make_multi_colors <- function(obj) {
  uniq_modnames <- attr(obj, "uniq_modnames")
  modnames <- attr(obj, "data_info")[["modnames"]]

  uniq_col <- grDevices::rainbow(length(uniq_modnames))
  modnams_idx <- as.numeric(factor(modnames, levels = uniq_modnames))
  unlist(lapply(seq_along(modnames), function(i) uniq_col[modnams_idx[i]]))
}

#
# Plot average line with CI
#
.plot_avg <- function(obj, type, curvetype, main, xlab, ylab, show_cb) {
  # === Create a plot ===
  grp_avg <- attr(obj, "grp_avg")
  avgcurves <- grp_avg[[curvetype]]

  xlim <- .get_xlim(obj, curvetype)
  ylim <- .get_ylim(obj, curvetype)
  graphics::plot(1, type = "n", main = main, xlab = xlab, ylab = ylab,
                 ylim = ylim, xlim = xlim)

  if (length(avgcurves) == 1) {
    lcols <- "blue"
  } else {
    lcols <- grDevices::rainbow(length(avgcurves))
  }

  for (i in 1:length(avgcurves)) {
    .add_curve_with_ci(avgcurves, type, i, "grey", lcols[i], show_cb)
  }
}

#
# Add a curve with CI
#
.add_curve_with_ci <- function(avgcurves, type, idx, pcol, lcol, show_cb) {
  x <- avgcurves[[idx]][["x"]]
  y <- avgcurves[[idx]][["y_avg"]]
  naidx <- is.na(y)

  if (any(naidx)) {
    x <- x[!naidx]
    y <- y[!naidx]
  }

  if (show_cb) {
    ymin <- avgcurves[[idx]][["y_ci_l"]]
    ymax <- avgcurves[[idx]][["y_ci_h"]]
    if (any(naidx)) {
      ymin <- ymin[!naidx]
      ymax <- ymax[!naidx]
    }

    g <- grDevices::col2rgb(pcol)
    graphics::polygon(c(x, rev(x)), c(ymin, rev(ymax)), border = FALSE,
                      col = grDevices::rgb(g[1], g[2], g[3], 180,
                                           maxColorValue = 255))
  }

  b <- grDevices::col2rgb(lcol)
  graphics::lines(x, y, type = type, lty = 1, pch = 19,
                  col = grDevices::rgb(b[1], b[2], b[3], 200,
                                       maxColorValue = 255))
}

#
# Plot ROC or Precision-Recall
#
.plot_single <- function(x, curvetype, type = type, show_cb = FALSE,
                         raw_curves = FALSE, add_np_nn = TRUE,
                         show_legend = TRUE) {

  tlist <- .get_titiles(curvetype)
  main <- tlist[["main"]]

  pn_info <- .get_pn_info(x)
  if (add_np_nn && pn_info$is_consistant) {
    np <- pn_info$avg_np
    nn <- pn_info$avg_nn
    main <- paste0(main, " - P: ", np, ", N: ", nn)
  }

  old_pty <- graphics::par(pty = "s")
  on.exit(graphics::par(old_pty), add = TRUE)

  if (show_legend) {
    .set_layout(1, show_legend)
    on.exit(graphics::layout(1), add = TRUE)
  }

  # === Create a plot ===
  if (show_cb) {
    .plot_avg(x, type, tlist[["ctype"]], main, tlist[["xlab"]],
              tlist[["ylab"]], show_cb)
  } else if (raw_curves) {
    .matplot_wrapper(x, type, tlist[["ctype"]], main, tlist[["xlab"]],
                     tlist[["ylab"]])
  } else {
    .plot_avg(x, type, tlist[["ctype"]], main, tlist[["xlab"]],
              tlist[["ylab"]], show_cb)
  }

  if (curvetype == "ROC") {
    graphics::abline(a = 0, b = 1, col = "grey", lty = 3)

  } else if (curvetype == "PRC") {
    graphics::abline(h = pn_info$prc_base, col = "grey", lty = 3)
  }

  .show_legend(x, show_legend)
}

#
# Get title and subtitles
#
.get_titiles <- function(curvetype) {
  tlist = list()

  if (curvetype == "ROC") {
    tlist[["main"]] <- "ROC"
    tlist[["xlab"]] <- "1 - Specificity"
    tlist[["ylab"]] <- "Sensitivity"
    tlist[["ctype"]] <- "rocs"
  } else if (curvetype == "PRC") {
    tlist[["main"]] <- "Precision-Recall"
    tlist[["xlab"]] <- "Recall"
    tlist[["ylab"]] <- "Precision"
    tlist[["ctype"]] <- "prcs"
  } else {
    mnames <- list(score = "score", label = "label", error = "err",
                   accuracy = "acc", specificity = "sp", sensitivity = "sn",
                   precision = "prec", mcc = "mcc", fscore = "fscore")
    if (curvetype == "mcc") {
      main <- "MCC"
    } else if (curvetype == "label") {
      main <- "Label (1:pos, -1:neg)"
    } else {
      main <- paste0(toupper(substring(curvetype, 1, 1)), substring(curvetype, 2))
    }
    tlist[["main"]] <- main
    tlist[["xlab"]] <- "normalized rank"
    tlist[["ylab"]] <- curvetype
    tlist[["ctype"]] <- mnames[[curvetype]]
  }

  tlist
}

#
# Show legend
#
.show_legend <- function(obj, show_legend, gnames = "modnames") {
  if (show_legend) {
    old_mar <- graphics::par(mar = c(0, 0, 0, 0))
    on.exit(graphics::par(old_mar), add = TRUE)
    old_pty <- graphics::par(pty = "m")
    on.exit(graphics::par(old_pty), add = TRUE)

    gnames <- attr(obj, paste0("uniq_", gnames))
    graphics::plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
    graphics::legend(x = "top", lty = 1,
                     legend = gnames,
                     col = grDevices::rainbow(length(gnames)),
                     horiz = TRUE)
  }
}

#
# Get value range
#
.get_value_range <- function(obj, curvetype) {
  curves <- obj[[curvetype]]
  grp_avg <- attr(obj, "grp_avg")
  avgcurves <- grp_avg[[curvetype]]

  max_score <- NA
  min_score <- NA

  if (!all(is.na(avgcurves))) {
    for (i in 1:length(avgcurves)) {
      max_score <- max(max_score, max(avgcurves[[i]][["y_ci_h"]], na.rm = TRUE),
                       na.rm = TRUE)
      min_score <- min(min_score, min(avgcurves[[i]][["y_ci_l"]], na.rm = TRUE),
                       na.rm = TRUE)
    }
  } else {
    for (i in 1:length(curves)) {
      max_score <- max(max_score, max(curves[[i]][["y"]], na.rm = TRUE),
                       na.rm = TRUE)
      min_score <- min(min_score, min(curves[[i]][["y"]], na.rm = TRUE),
                       na.rm = TRUE)
    }
  }

  c(min_score, max_score)
}

#
# Get xlim
#
.get_xlim <- function(obj, curvetype) {
  if (curvetype == "rocs" || curvetype == "prcs") {
    xlim <- attr(obj[[curvetype]], "xlim")
  } else if (curvetype == "mcc" || curvetype == "label") {
    xlim <- c(0, 1)
  } else if (curvetype == "score") {
    xlim <- c(0, 1)
  } else {
    xlim <- c(0, 1)
  }
}

#
# Get ylim
#
.get_ylim <- function(obj, curvetype) {
  if (curvetype == "rocs" || curvetype == "prcs") {
    ylim <- attr(obj[[curvetype]], "ylim")
  } else if (curvetype == "mcc" || curvetype == "label") {
    ylim <- c(-1, 1)
  } else if (curvetype == "score") {
    ylim <- .get_value_range(obj, curvetype)
  } else {
    ylim <- c(0, 1)
  }
}
guillermozbta/precrec documentation built on May 11, 2019, 7:22 p.m.