Commit ⋅ evalclass/precrec

#' head(M2N50F5)
#'
#' ## Convert with format_nfold
#' nfold_list1 <- format_nfold(nfold_df = M2N50F5, score_cols = c(1, 2),
#'                             lab_col = 3, fold_col = 4)
#' nfold_list1 <- format_nfold(
#'   nfold_df = M2N50F5, score_cols = c(1, 2),
#'   lab_col = 3, fold_col = 4
#' )
#'
#' ## Show the list structure
#' str(nfold_list1)

@@ -49,8 +51,10 @@

#' ###
#'
#' ## Convert with format_nfold
#' nfold_list2 <- format_nfold(nfold_df = M2N50F5, score_cols = 1,
#'                             lab_col = 3, fold_col = 4)
#' nfold_list2 <- format_nfold(
#'   nfold_df = M2N50F5, score_cols = 1,
#'   lab_col = 3, fold_col = 4
#' )
#'
#' ## Show the list structure
#' str(nfold_list2)

@@ -63,9 +67,11 @@

#' ###
#'
#' ## Convert with format_nfold
#' nfold_list3 <- format_nfold(nfold_df = M2N50F5,
#'                            score_cols = c("score1", "score2"),
#'                            lab_col = "label", fold_col = "fold")
#' nfold_list3 <- format_nfold(
#'   nfold_df = M2N50F5,
#'   score_cols = c("score1", "score2"),
#'   lab_col = "label", fold_col = "fold"
#' )
#'
#' ## Show the list structure
#' str(nfold_list3)

@@ -74,7 +80,6 @@

#'
#' @export
format_nfold <- function(nfold_df, score_cols, lab_col, fold_col) {

  # Validate arguments
  .validate_format_nfold_args(nfold_df, score_cols, lab_col, fold_col)


@@ -113,8 +118,8 @@

#
# Validate arguments of format_nfold()
#
.validate_format_nfold_args <- function(nfold_df, score_cols, lab_col, fold_col) {

.validate_format_nfold_args <- function(nfold_df, score_cols,
                                        lab_col, fold_col) {
  if (!is.data.frame(nfold_df)) {
    stop("nfold_df must be a data frame.", call. = FALSE)
  }

@@ -127,6 +132,4 @@


  # Check fold column name
  .validate_fold_col(fold_col, nfold_df)

}


@@ -23,8 +23,8 @@

#' @return The \code{auc} function returns a data frame with AUC scores.
#'
#' @seealso \code{\link{evalmod}} for generating \code{S3} objects with
#'   performance evaluation measures. \code{\link{pauc}} for retrieving a dataset
#'   of pAUCs.
#'   performance evaluation measures. \code{\link{pauc}} for retrieving
#'   a dataset of pAUCs.
#'
#' @examples
#'

@@ -49,7 +49,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -65,8 +66,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -90,8 +92,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -4,7 +4,8 @@

#'   \code{\link{evalmod}} to a data frame.
#'
#' @param x An \code{S3} object generated by \code{\link{evalmod}}.
#'   The \code{as.data.frame} function takes one of the following \code{S3} objects.
#'   The \code{as.data.frame} function takes
#'     one of the following \code{S3} objects.
#'
#' \enumerate{
#'

@@ -63,7 +64,6 @@

#'   performance evaluation measures.
#'
#' @examples
#'
#' \dontrun{
#' ##################################################
#' ### Single model & single test dataset

@@ -82,8 +82,10 @@

#' head(sscurves.df)
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
#'                     labels = P10N10$labels)
#' sspoints <- evalmod(
#'   mode = "basic", scores = P10N10$scores,
#'   labels = P10N10$labels
#' )
#' ## Convert sspoints to a data frame
#' sspoints.df <- as.data.frame(sspoints)
#'

@@ -98,7 +100,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -126,8 +129,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -155,8 +159,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -185,9 +190,11 @@

#' 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)
#' 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)

@@ -214,8 +221,10 @@

#'
#' ## mode = "aucroc"
#' data(P10N10)
#' uauc1 <- evalmod(scores = P10N10$scores, labels = P10N10$labels,
#'                  mode="aucroc")
#' uauc1 <- evalmod(
#'   scores = P10N10$scores, labels = P10N10$labels,
#'   mode = "aucroc"
#' )
#'
#' # as.data.frame 'aucroc'
#' as.data.frame(uauc1)

@@ -223,9 +232,10 @@

#' ## mode = "aucroc"
#' samps <- create_sim_samples(10, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#' uauc2 <- evalmod(mdat, mode="aucroc")
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#' uauc2 <- evalmod(mdat, mode = "aucroc")
#'
#' # as.data.frame 'aucroc'
#' head(as.data.frame(uauc2))

@@ -271,51 +281,61 @@

    } else {
      x_bins <- 0
    }

  } else if (new_mode == "basic") {
    curvetype_names <- list(score = "score", label = "label", error = "err",
                            accuracy = "acc", specificity = "sp",
                            sensitivity = "sn", precision = "prec", mcc = "mcc",
                            fscore = "fscore")
    curvetype_names <- list(
      score = "score", label = "label", error = "err",
      accuracy = "acc", specificity = "sp",
      sensitivity = "sn", precision = "prec", mcc = "mcc",
      fscore = "fscore"
    )
    x_bins <- 0
  }

  # Make dsis-modname pairs
  dsid_modnames <- paste(attr(obj, "data_info")$modnames,
                         attr(obj, "data_info")$dsids, sep = ":")
    attr(obj, "data_info")$dsids,
    sep = ":"
  )

  # Create curve_df
  if (raw_curves) {
    if (use_rcpp) {
      list_df <- convert_curve_df(obj, uniq_modnames, as.character(uniq_dsids),
                                  match(modnames, uniq_modnames),
                                  match(dsids, uniq_dsids),
                                  dsid_modnames, curvetype_names, x_bins)
      list_df <- convert_curve_df(
        obj, uniq_modnames, as.character(uniq_dsids),
        match(modnames, uniq_modnames),
        match(dsids, uniq_dsids),
        dsid_modnames, curvetype_names, x_bins
      )
      .check_cpp_func_error(list_df, "convert_curve_df")
      curve_df <- list_df[["df"]]
    } else {
      curve_df <- .dataframe_curve(obj, uniq_modnames, uniq_dsids, modnames,
                                   dsids, dsid_modnames, curvetype_names)
      curve_df <- .dataframe_curve(
        obj, uniq_modnames, uniq_dsids, modnames,
        dsids, dsid_modnames, curvetype_names
      )
      warning("R version of .dataframe_common is used")
    }
  } else {
    if (use_rcpp) {
      list_df <- convert_curve_avg_df(attr(obj, "grp_avg"), uniq_modnames,
                                      match(modnames, uniq_modnames),
                                      curvetype_names, x_bins)
      list_df <- convert_curve_avg_df(
        attr(obj, "grp_avg"), uniq_modnames,
        match(modnames, uniq_modnames),
        curvetype_names, x_bins
      )
      .check_cpp_func_error(list_df, "convert_curve_avg_df")
      curve_df <- list_df[["df"]]
    } else {
      curve_df <- .dataframe_curve_avg(obj, uniq_modnames, uniq_dsids, modnames,
                                       dsids, dsid_modnames, curvetype_names)
      curve_df <- .dataframe_curve_avg(
        obj, uniq_modnames, uniq_dsids, modnames,
        dsids, dsid_modnames, curvetype_names
      )
      warning("R version of .dataframe_common is used")
    }

  }

  if (!check_ggplot) {
    if ("dsid_modname" %in% names(curve_df)) {
      curve_df <- with(curve_df, subset(curve_df, select = -dsid_modname))
      curve_df[["dsid_modname"]] <- NULL
    }
    colnum <- ncol(curve_df)
    names(curve_df) <- c(names(curve_df)[1:(colnum - 1)], "type")

@@ -329,7 +349,6 @@

#
.dataframe_curve <- function(obj, uniq_modnames, uniq_dsids, modnames, dsids,
                             dsid_modnames, curvetype_names) {

  curve_df <- NULL
  for (curvetype in names(curvetype_names)) {
    curves <- obj[[curvetype_names[[curvetype]]]]

@@ -339,15 +358,22 @@


      modname <- factor(rep(modnames[i], length(x)), levels = uniq_modnames)
      dsid <- factor(rep(dsids[i], length(x)), levels = uniq_dsids)
      dsid_modname <- factor(rep(paste(modnames[i], dsids[i], sep = ":"),
                                 length(x)),
                             levels = dsid_modnames)
      dsid_modname <- factor(
        rep(
          paste(modnames[i], dsids[i], sep = ":"),
          length(x)
        ),
        levels = dsid_modnames
      )
      curvename <- factor(rep(curvetype, length(x)),
                          levels = names(curvetype_names))
      curve_df <- rbind(curve_df, data.frame(x = x, y = y, modname = modname,
                                             dsid = dsid,
                                             dsid_modname = dsid_modname,
                                             curvetype = curvename))
        levels = names(curvetype_names)
      )
      curve_df <- rbind(curve_df, data.frame(
        x = x, y = y, modname = modname,
        dsid = dsid,
        dsid_modname = dsid_modname,
        curvetype = curvename
      ))
    }
  }


@@ -357,9 +383,8 @@

#
# Make a dataframe for plotting with average curves
#
.dataframe_curve_avg <- function(obj, uniq_modnames, uniq_dsids, modnames, dsids,
                               dsid_modnames, curvetype_names) {

.dataframe_curve_avg <- function(obj, uniq_modnames, uniq_dsids, modnames,
                                 dsids, dsid_modnames, curvetype_names) {
  grp_avg <- attr(obj, "grp_avg")
  curve_df <- NULL
  for (curvetype in names(curvetype_names)) {

@@ -372,13 +397,17 @@

      ymax <- avgcurves[[i]][["y_ci_h"]]

      modname <- factor(rep(uniq_modnames[i], length(x)),
                        levels = uniq_modnames)
        levels = uniq_modnames
      )
      curvename <- factor(rep(curvetype, length(x)),
                          levels = names(curvetype_names))
      curve_df <- rbind(curve_df, data.frame(x = x, y = y,
                                             ymin = ymin, ymax = ymax,
                                             modname = modname,
                                             curvetype = curvename))
        levels = names(curvetype_names)
      )
      curve_df <- rbind(curve_df, data.frame(
        x = x, y = y,
        ymin = ymin, ymax = ymax,
        modname = modname,
        curvetype = curvename
      ))
    }
  }


@@ -389,7 +418,6 @@

# Process ... for curve objects
#
.get_dataframe_arglist <- function(evalmod_args, def_raw_curves, ...) {

  arglist <- list(...)

  if (is.null(arglist[["raw_curves"]])) {

@@ -404,4 +432,3 @@

404	432
405	433		arglist
406	434		}
407		-

@@ -160,8 +160,10 @@

#' autoplot(sscurves, curvetype = "PRC")
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
#'                     labels = P10N10$labels)
#' sspoints <- evalmod(
#'   mode = "basic", scores = P10N10$scores,
#'   labels = P10N10$labels
#' )
#'
#' ## Normalized ranks vs. basic evaluation measures
#' autoplot(sspoints)

@@ -177,7 +179,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -215,8 +218,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -255,8 +259,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -272,8 +277,10 @@

#'
#' ## Reduced/Full supporting points
#' sampmm <- create_sim_samples(4, 5000, 5000)
#' mdatmm <- mmdata(sampmm$scores, sampmm$labels, modnames = c("m1", "m2"),
#'                  dsids = c(1, 2), expd_first = "modnames")
#' mdatmm <- mmdata(sampmm$scores, sampmm$labels,
#'   modnames = c("m1", "m2"),
#'   dsids = c(1, 2), expd_first = "modnames"
#' )
#' evalmm <- evalmod(mdatmm, raw_curves = TRUE)
#'
#' # Reduced supporting point

@@ -297,9 +304,11 @@

#' 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)
#' 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)

@@ -315,7 +324,6 @@

#'
#' ## Normalized ranks vs. average basic evaluation measures
#' autoplot(cvpoints)
#'
#' }
#'
#' @name autoplot

@@ -329,7 +337,6 @@

                                  def_raw_curves, def_add_np_nn,
                                  def_show_legend, def_ret_grob,
                                  def_reduce_points, def_multiplot_lib, ...) {

  arglist <- list(...)

  if (is.null(arglist[["curvetype"]])) {

@@ -345,7 +352,8 @@

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

  if (is.null(arglist[["raw_curves"]])) {

@@ -359,7 +367,8 @@

  }
  if (!evalmod_args[["raw_curves"]] && arglist[["raw_curves"]]) {
    stop("Invalid raw_curves. Inconsistent with the value of evalmod.",
         call. = FALSE)
      call. = FALSE
    )
  }

  if (is.null(arglist[["add_np_nn"]])) {

@@ -413,9 +422,13 @@

#
.load_ggplot2 <- function() {
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop(paste("ggplot2 is required to perform this function.",
               "Please install it."),
         call. = FALSE)
    stop(
      paste(
        "ggplot2 is required to perform this function.",
        "Please install it."
      ),
      call. = FALSE
    )
  }
}


@@ -425,17 +438,19 @@

.load_grid <- function() {
  if (!requireNamespace("grid", quietly = TRUE)) {
    stop("grid is required to perform this function. Please install it.",
         call. = FALSE)
      call. = FALSE
    )
  }
}

#
# Load gridExtra
#
.load_gridExtra <- function() {
.load_gridextra <- function() {
  if (!requireNamespace("gridExtra", quietly = TRUE)) {
    stop("gridExtra is required to perform this function. Please install it.",
         call. = FALSE)
      call. = FALSE
    )
  }
}


@@ -446,8 +461,13 @@

  if (requireNamespace("patchwork", quietly = TRUE)) {
    return(TRUE)
  } else {
    warning("patchwork is not installed. grid and gridExtra will be used instead.",
            call. = FALSE)
    warning(
      paste0(
        "patchwork is not installed. ",
        "grid and gridExtra will be used instead."
      ),
      call. = FALSE
    )
    return(FALSE)
  }
}

@@ -466,17 +486,16 @@


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

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

  # === Check package availability  ===
  .load_ggplot2()
  avail_pathwork <- .load_ggplot2()
  .validate(object)
  .check_curvetype(curvetype, object)
  .check_type(type)

@@ -488,22 +507,29 @@

  .check_multiplot_lib(multiplot_lib)

  # === Create a ggplot object for ROC&PRC, ROC, or PRC ===
  curve_df <- ggplot2::fortify(object, raw_curves = raw_curves,
                               reduce_points = reduce_points)
  curve_df <- ggplot2::fortify(object,
    raw_curves = raw_curves,
    reduce_points = reduce_points
  )

  func_plot <- function(ctype) {
    .autoplot_single(object, curve_df, curvetype = ctype, type = type,
                     show_cb = show_cb, raw_curves = raw_curves,
                     reduce_points = reduce_points, show_legend = show_legend,
                     add_np_nn = add_np_nn)
    .autoplot_single(object, curve_df,
      curvetype = ctype, type = type,
      show_cb = show_cb, raw_curves = raw_curves,
      reduce_points = reduce_points, show_legend = show_legend,
      add_np_nn = add_np_nn
    )
  }
  lcurves <- lapply(curvetype, func_plot)
  names(lcurves) <- curvetype

  if (length(lcurves) > 1) {
    do.call(.combine_plots, c(lcurves, show_legend = show_legend,
                              ret_grob = ret_grob, multiplot_lib = multiplot_lib,
                              nplots = length(lcurves)))
    do.call(.combine_plots, c(lcurves,
      show_legend = show_legend,
      ret_grob = ret_grob,
      multiplot_lib = multiplot_lib,
      nplots = length(lcurves)
    ))
  } else {
    lcurves[[1]]
  }

@@ -520,7 +546,7 @@

  plots <- list(...)

  g <- ggplot2::ggplotGrob(plots[[1]]
                           + ggplot2::theme(legend.position = "bottom"))$grobs
  + ggplot2::theme(legend.position = "bottom"))$grobs
  legend <- g[[which(lapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)


@@ -531,7 +557,8 @@

    do.call(fncol, lapply(plots, fnolegend)),
    legend,
    heights = grid::unit.c(grid::unit(1, "npc") - lheight, lheight),
    ncol = 1)
    ncol = 1
  )
}

#

@@ -574,7 +601,7 @@

  if (show_legend) {
    p <- p + patchwork::plot_layout(guides = "collect")
    if (length(plotlist) > 2) {
      p <- p + ggplot2::theme(legend.position = 'bottom')
      p <- p + ggplot2::theme(legend.position = "bottom")
    }
  }


@@ -594,8 +621,11 @@

  }
  if (multiplot_lib == "grid") {
    .load_grid()
    .load_gridExtra()
    .combine_plots_grid(..., show_legend = show_legend, ret_grob = ret_grob, nplots = nplots)
    .load_gridextra()
    .combine_plots_grid(...,
      show_legend = show_legend,
      ret_grob = ret_grob, nplots = nplots
    )
  }
}


@@ -606,40 +636,65 @@

                             show_cb = FALSE, raw_curves = FALSE,
                             reduce_points = TRUE, show_legend = FALSE,
                             add_np_nn = TRUE, ...) {

  curve_df <- .prepare_autoplot(object, curve_df = curve_df,
                                curvetype = curvetype,
                                raw_curves = raw_curves,
                                reduce_points = reduce_points, ...)
  curve_df <- .prepare_autoplot(object,
    curve_df = curve_df,
    curvetype = curvetype,
    raw_curves = raw_curves,
    reduce_points = reduce_points, ...
  )

  # === Create a ggplot object ===
  x_col <- rlang::sym("x")
  y_col <- rlang::sym("y")
  ymin_col <- rlang::sym("ymin")
  ymax_col <- rlang::sym("ymax")
  modname_col <- rlang::sym("modname")
  dsid_modname_col <- rlang::sym("dsid_modname")
  if (show_cb) {
    p <- ggplot2::ggplot(curve_df,
                         ggplot2::aes_string(x = 'x', y = 'y',
                                             ymin = 'ymin', ymax = 'ymax'))
    p <- ggplot2::ggplot(
      curve_df,
      ggplot2::aes(
        x = !!x_col, y = !!y_col,
        ymin = !!ymin_col, ymax = !!ymax_col
      )
    )
    if (type == "l") {
      p <- p + ggplot2::geom_smooth(ggplot2::aes_string(color = 'modname'),
                                    stat = "identity", na.rm = TRUE,
                                    size = 0.5)
      p <- p + ggplot2::geom_smooth(ggplot2::aes(color = !!modname_col),
        stat = "identity", na.rm = TRUE,
        linewidth = 0.5
      )
    } else if (type == "b" || type == "p") {
      p <- p + ggplot2::geom_ribbon(ggplot2::aes_string(ymin = 'ymin',
                                                        ymax = 'ymax',
                                                        group = 'modname'),
                                    stat = "identity", alpha = 0.25,
                                    fill = "grey25", na.rm = TRUE)
      p <- p + ggplot2::geom_ribbon(
        ggplot2::aes(
          ymin = !!ymin_col,
          ymax = !!ymax_col,
          group = !!modname_col
        ),
        stat = "identity", alpha = 0.25,
        fill = "grey25", na.rm = TRUE
      )
      if (type == "b") {
        p <- p + ggplot2::geom_line(ggplot2::aes_string(color = 'modname'),
                                    alpha = 0.25, na.rm = TRUE)
        p <- p + ggplot2::geom_line(ggplot2::aes(color = !!modname_col),
          alpha = 0.25, na.rm = TRUE
        )
      }
      p <- p + ggplot2::geom_point(ggplot2::aes_string(x = 'x', y = 'y',
                                                       color = 'modname'),
                                   na.rm = TRUE)
      p <- p + ggplot2::geom_point(
        ggplot2::aes(
          x = !!x_col, y = !!y_col,
          color = !!modname_col
        ),
        na.rm = TRUE
      )
    }
  } else if (raw_curves) {
    p <- ggplot2::ggplot(curve_df,
                         ggplot2::aes_string(x = 'x', y = 'y',
                                             group = 'dsid_modname',
                                             color = 'modname'))
    p <- ggplot2::ggplot(
      curve_df,
      ggplot2::aes(
        x = !!x_col, y = !!y_col,
        group = !!dsid_modname_col,
        color = !!modname_col
      )
    )

    if (type == "l") {
      p <- p + ggplot2::geom_line(na.rm = TRUE)

@@ -649,10 +704,11 @@

      }
      p <- p + ggplot2::geom_point(na.rm = TRUE)
    }

  } else {
    p <- ggplot2::ggplot(curve_df, ggplot2::aes_string(x = 'x', y = 'y',
                                                       color = 'modname'))
    p <- ggplot2::ggplot(curve_df, ggplot2::aes(
      x = !!x_col, y = !!y_col,
      color = !!modname_col
    ))
    if (type == "l") {
      p <- p + ggplot2::geom_line(na.rm = TRUE)
    } else if (type == "b" || type == "p") {

@@ -692,13 +748,15 @@

  }
  if (curvetype == "ROC" || curvetype == "PRC") {
    if (all(xlim == ylim)) {
      ratio = 1
      ratio <- 1
    } else {
      ratio = NULL
      ratio <- NULL
    }
  }
  p <- func_g(p, object, show_legend = show_legend, add_np_nn = add_np_nn,
              curve_df = curve_df, xlim = xlim, ylim = ylim, ratio = ratio, ...)
  p <- func_g(p, object,
    show_legend = show_legend, add_np_nn = add_np_nn,
    curve_df = curve_df, xlim = xlim, ylim = ylim, ratio = ratio, ...
  )

  p
}

@@ -736,7 +794,6 @@

#
.geom_basic_roc <- function(p, object, show_legend = TRUE, add_np_nn = TRUE,
                            xlim, ylim, ratio, ...) {

  pn_info <- .get_pn_info(object)

  if (add_np_nn && pn_info$is_consistant) {

@@ -745,8 +802,10 @@

    main <- "ROC"
  }

  p <- p + ggplot2::geom_abline(intercept = 0, slope = 1, colour = "grey",
                                linetype = 3)
  p <- p + ggplot2::geom_abline(
    intercept = 0, slope = 1, colour = "grey",
    linetype = 3
  )
  p <- .set_coords(p, xlim, ylim, ratio)
  p <- .geom_basic(p, main, "1 - Specificity", "Sensitivity", show_legend)


@@ -758,7 +817,6 @@

#
.geom_basic_prc <- function(p, object, show_legend = TRUE, add_np_nn = TRUE,
                            xlim, ylim, ratio, ...) {

  pn_info <- .get_pn_info(object)

  if (add_np_nn && pn_info$is_consistant) {

@@ -767,8 +825,10 @@

    main <- "Precision-Recall"
  }

  p <- p + ggplot2::geom_hline(yintercept = pn_info$prc_base, colour = "grey",
                               linetype = 3)
  p <- p + ggplot2::geom_hline(
    yintercept = pn_info$prc_base, colour = "grey",
    linetype = 3
  )
  p <- .set_coords(p, xlim, ylim, ratio)
  p <- .geom_basic(p, main, "Recall", "Precision", show_legend)


@@ -779,8 +839,7 @@

# Set coordinates for ROC and precision-recall
#
.set_coords <- function(p, xlim, ylim, ratio) {

  if (is.null(ratio))  {
  if (is.null(ratio)) {
    p <- p + ggplot2::coord_cartesian(xlim = xlim, ylim = ylim)
  } else {
    p <- p + ggplot2::coord_fixed(ratio = ratio, xlim = xlim, ylim = ylim)

@@ -794,14 +853,13 @@

#
.geom_basic_point <- function(p, object, show_legend = TRUE,
                              curve_df = curve_df, xlim, ylim, ratio, ...) {

  s <- curve_df[["curvetype"]][1]
  if (s == "mcc") {
    main <- "MCC"
  } else if (s == "label") {
    main <- "Label (1:pos, -1:neg)"
  } else {
    main <- paste0(toupper(substring(s, 1, 1)), substring(s,2))
    main <- paste0(toupper(substring(s, 1, 1)), substring(s, 2))
  }
  p <- .set_coords(p, xlim, ylim, ratio)
  p <- .geom_basic(p, main, "normalized rank", s, show_legend)

@@ -4,7 +4,6 @@

.pl_main_basic <- function(mdat, model_type, dataset_type, class_name_pf,
                           calc_avg = TRUE, cb_alpha = 0.05,
                           raw_curves = FALSE) {

  if (dataset_type == "single") {
    calc_avg <- FALSE
    raw_curves <- TRUE

@@ -19,26 +18,35 @@

      } else {
        cl <- "negative"
      }
      err_msg <- paste0("Basic measures cannot be calculated. ",
                        "Only a single class (", cl, ") ",
                        "found in dataset (modname: ", attr(mdat[[s]], "modname"),
                        ", dsid: ",attr(mdat[[s]], "dsid"), ").")
      err_msg <- paste0(
        "Basic measures cannot be calculated. ",
        "Only a single class (", cl, ") ",
        "found in dataset (modname: ",
        attr(mdat[[s]], "modname"),
        ", dsid: ", attr(mdat[[s]], "dsid"), ")."
      )
      stop(err_msg, call. = FALSE)
    }
    cdat <- create_confmats(mdat[[s]], keep_fmdat = TRUE)
    pevals <- calc_measures(cdat)
    calc_measures(cdat)
  }
  lpoints <- lapply(seq_along(mdat), plfunc)

  # Summarize points by evaluation measure
  grpfunc <- function(m) {
    .summarize_points(lpoints, m, "pointgrp", mdat, dataset_type,
                      calc_avg, cb_alpha)
    .summarize_points(
      lpoints, m, "pointgrp", mdat, dataset_type,
      calc_avg, cb_alpha
    )
  }
  eval_names <- c("score", "label", "error", "accuracy", "specificity",
                  "sensitivity", "precision", "mcc", "fscore")
  grp_row_names <- c("score", "label", "err", "acc", "sp", "sn", "prec", "mcc",
                     "fscore")
  eval_names <- c(
    "score", "label", "error", "accuracy", "specificity",
    "sensitivity", "precision", "mcc", "fscore"
  )
  grp_row_names <- c(
    "score", "label", "err", "acc", "sp", "sn", "prec", "mcc",
    "fscore"
  )
  grp_points <- lapply(eval_names, grpfunc)
  names(grp_points) <- grp_row_names


@@ -60,8 +68,10 @@

    grp_points <- lapply(eval_names, grpfunc3)
    names(grp_points) <- grp_row_names
  }
  s3obj <- structure(grp_points, class = c(paste0(class_name_pf, "points"),
                                           "beval_info"))
  s3obj <- structure(grp_points, class = c(
    paste0(class_name_pf, "points"),
    "beval_info"
  ))

  # Set attributes
  attr(s3obj, "eval_summary") <- eval_summary

@@ -71,10 +81,12 @@

  attr(s3obj, "uniq_dsids") <- attr(mdat, "uniq_dsids")
  attr(s3obj, "model_type") <- model_type
  attr(s3obj, "dataset_type") <- dataset_type
  attr(s3obj, "args") <- list(mode = "basic",
                              calc_avg = calc_avg,
                              cb_alpha = cb_alpha,
                              raw_curves = raw_curves)
  attr(s3obj, "args") <- list(
    mode = "basic",
    calc_avg = calc_avg,
    cb_alpha = cb_alpha,
    raw_curves = raw_curves
  )
  attr(s3obj, "validated") <- FALSE

  # Call .validate.class_name()

@@ -86,12 +98,13 @@

#
.summarize_points <- function(lpoints, eval_type, class_name, mdat,
                              dataset_type, calc_avg, cb_alpha) {

  if (!is.null(lpoints)) {
    # Summarize basic evaluation measures
    grp_func <- function(s) {
      list(x = lpoints[[s]][["basic"]][["rank"]],
           y = lpoints[[s]][["basic"]][[eval_type]])
      list(
        x = lpoints[[s]][["basic"]][["rank"]],
        y = lpoints[[s]][["basic"]][[eval_type]]
      )
    }
    pevals <- lapply(seq_along(lpoints), grp_func)


@@ -130,24 +143,27 @@

# Summarize basic evaluation measures
#
.summarize_basic <- function(lpoints, mdat) {

  # Summarize AUC of ROC or PRC curves
  modnames <- attr(mdat, "data_info")[["modnames"]]
  dsids <- attr(mdat, "data_info")[["dsids"]]
  evaltypes <- c("rank", "score", "label", "error", "accuracy",
                 "specificity","sensitivity", "precision", "mcc", "fscore")
  evaltypes <- c(
    "rank", "score", "label", "error", "accuracy",
    "specificity", "sensitivity", "precision", "mcc", "fscore"
  )
  elen <- length(evaltypes)

  sbasic <- data.frame(modnames = rep(modnames, each = elen),
                       dsids = rep(dsids, each = elen),
                       evaltypes = rep(evaltypes, length(modnames)),
                       minvals = rep(NA, length(modnames) * elen),
                       q25vals = rep(NA, length(modnames) * elen),
                       medianvals = rep(NA, length(modnames) * elen),
                       meanvals = rep(NA, length(modnames) * elen),
                       q75vals = rep(NA, length(modnames) * elen),
                       maxvals = rep(NA, length(modnames) * elen),
                       stringsAsFactors = FALSE)
  sbasic <- data.frame(
    modnames = rep(modnames, each = elen),
    dsids = rep(dsids, each = elen),
    evaltypes = rep(evaltypes, length(modnames)),
    minvals = rep(NA, length(modnames) * elen),
    q25vals = rep(NA, length(modnames) * elen),
    medianvals = rep(NA, length(modnames) * elen),
    meanvals = rep(NA, length(modnames) * elen),
    q75vals = rep(NA, length(modnames) * elen),
    maxvals = rep(NA, length(modnames) * elen),
    stringsAsFactors = FALSE
  )

  for (i in seq_along(lpoints)) {
    for (j in seq_along(evaltypes)) {

@@ -169,14 +185,20 @@

  }

  # Validate class items and attributes
  item_names <- c("score", "label", "err", "acc", "sp", "sn", "prec", "mcc",
                  "fscore")
  attr_names <- c("eval_summary", "grp_avg", "data_info", "uniq_modnames",
                  "uniq_dsids", "model_type", "dataset_type", "args",
                  "validated")
  item_names <- c(
    "score", "label", "err", "acc", "sp", "sn", "prec", "mcc",
    "fscore"
  )
  attr_names <- c(
    "eval_summary", "grp_avg", "data_info", "uniq_modnames",
    "uniq_dsids", "model_type", "dataset_type", "args",
    "validated"
  )
  arg_names <- c("mode", "calc_avg", "cb_alpha", "raw_curves")
  .validate_basic(points, class_name, ".pl_main_basic", item_names, attr_names,
                  arg_names)
  .validate_basic(
    points, class_name, ".pl_main_basic", item_names, attr_names,
    arg_names
  )

  attr(points, "validated") <- TRUE
  points

@@ -221,11 +243,15 @@


  # Validate class items and attributes
  item_names <- NULL
  attr_names <- c("data_info", "eval_type", "uniq_modnames", "uniq_dsids",
                  "avgcurves", "validated")
  attr_names <- c(
    "data_info", "eval_type", "uniq_modnames", "uniq_dsids",
    "avgcurves", "validated"
  )
  arg_names <- NULL
  .validate_basic(pointgrp, "pointgrp", ".summarize_points", item_names,
                  attr_names, arg_names)
  .validate_basic(
    pointgrp, "pointgrp", ".summarize_points", item_names,
    attr_names, arg_names
  )

  attr(pointgrp, "validated") <- TRUE
  pointgrp

@@ -3,11 +3,12 @@

#
create_curves <- function(pevals, scores = NULL, labels = NULL,
                          x_bins = 1000, keep_pevals = FALSE, ...) {

  # === Validate input arguments ===
  # Create pevals from scores and labels if pevals is missing
  pevals <- .create_src_obj(pevals, "pevals", calc_measures, scores, labels,
                                 ...)
  pevals <- .create_src_obj(
    pevals, "pevals", calc_measures, scores, labels,
    ...
  )

  if (is.null(x_bins) || any(is.na(x_bins))) {
    x_bins <- 1

@@ -16,10 +17,14 @@

  .validate(pevals)

  # === Create ROC and Precision-Recall curves ===
  roc_curve <- create_roc(pevals, x_bins = x_bins,
                          keep_pevals = keep_pevals, ...)
  prc_curve <- create_prc(pevals, x_bins = x_bins,
                          keep_pevals = keep_pevals, ...)
  roc_curve <- create_roc(pevals,
    x_bins = x_bins,
    keep_pevals = keep_pevals, ...
  )
  prc_curve <- create_prc(pevals,
    x_bins = x_bins,
    keep_pevals = keep_pevals, ...
  )

  curves <- list(roc = roc_curve, prc = prc_curve)


@@ -48,11 +53,12 @@

#
create_roc <- function(pevals, scores = NULL, labels = NULL, x_bins = 1000,
                       keep_pevals = FALSE, ...) {

  # === Create a ROC curve ===
  .create_curve("specificity", "sensitivity", create_roc_curve,
                "create_roc_curve", "roc_curve", pevals, scores, labels,
                x_bins, keep_pevals, ...)
  .create_curve(
    "specificity", "sensitivity", create_roc_curve,
    "create_roc_curve", "roc_curve", pevals, scores, labels,
    x_bins, keep_pevals, ...
  )
}

#

@@ -60,11 +66,12 @@

#
create_prc <- function(pevals, scores = NULL, labels = NULL, x_bins = 1000,
                       keep_pevals = FALSE, ...) {

  # === Create a Precision-Recall curve ===
  .create_curve("sensitivity", "precision", create_prc_curve,
                "create_prc_curve", "prc_curve", pevals, scores, labels,
                x_bins, keep_pevals, ...)
  .create_curve(
    "sensitivity", "precision", create_prc_curve,
    "create_prc_curve", "prc_curve", pevals, scores, labels,
    x_bins, keep_pevals, ...
  )
}

#

@@ -73,26 +80,31 @@

.create_curve <- function(x_name, y_name, func, func_name, class_name,
                          pevals, scores = NULL, labels = NULL, x_bins = 1000,
                          keep_pevals = FALSE, ...) {

  # === Validate input arguments ===
  # Create pevals from scores and labels if pevals is missing
  pevals <- .create_src_obj(pevals, "pevals", calc_measures, scores, labels,
                            ...)
  pevals <- .create_src_obj(
    pevals, "pevals", calc_measures, scores, labels,
    ...
  )
  .validate_x_bins(x_bins, allow_zero = TRUE)
  .validate(pevals)

  # === Create a curve ===
  # Calculate a curve
  pb <- pevals[["basic"]]
  crv <- func(attr(pevals, "src")[["tp"]], attr(pevals, "src")[["fp"]],
              pb[[x_name]], pb[[y_name]], x_bins)
  crv <- func(
    attr(pevals, "src")[["tp"]], attr(pevals, "src")[["fp"]],
    pb[[x_name]], pb[[y_name]], x_bins
  )
  .check_cpp_func_error(crv, func_name)

  # Calculate AUC
  auc <- calc_auc(crv[["curve"]][["x"]], crv[["curve"]][["y"]])
  if (auc[["errmsg"]] == "invalid-x-vals") {
    warning(paste0("Invalid ", x_name,
                   " values detected. AUC can be inaccurate."))
    warning(paste0(
      "Invalid ", x_name,
      " values detected. AUC can be inaccurate."
    ))
  } else {
    .check_cpp_func_error(auc, "calc_auc")
  }

@@ -163,26 +175,32 @@

.validate_curve <- function(obj, class_name, func_name) {
  # Validate class items and attributes
  item_names <- c("x", "y", "orig_points")
  attr_names <- c("modname", "dsid", "nn", "np", "auc", "args",
                  "cpp_errmsg1", "cpp_errmsg2", "src", "validated")
  arg_names <- c("x_bins", "na_worst", "na.last", "ties_method", "ties.method",
                 "modname", "dsid", "keep_fmdat", "keep_cmats")
  .validate_basic(obj, class_name, func_name, item_names, attr_names,
                  arg_names)
  attr_names <- c(
    "modname", "dsid", "nn", "np", "auc", "args",
    "cpp_errmsg1", "cpp_errmsg2", "src", "validated"
  )
  arg_names <- c(
    "x_bins", "na_worst", "na.last", "ties_method", "ties.method",
    "modname", "dsid", "keep_fmdat", "keep_cmats"
  )
  .validate_basic(
    obj, class_name, func_name, item_names, attr_names,
    arg_names
  )

  # Check values of class items
  if ((length(obj[["x"]]) != length(obj[["y"]]))
      || (length(obj[["x"]]) != length(obj[["orig_points"]]))) {
  if ((length(obj[["x"]]) != length(obj[["y"]])) ||
    (length(obj[["x"]]) != length(obj[["orig_points"]]))) {
    stop("x, y, and orig_points must be all the same lengths", call. = FALSE)
  } else if (!(length(obj[["x"]]) > 2)) {
    stop("The minimum length of x, y, and orig_points must be 3",
         call. = FALSE)
      call. = FALSE
    )
  }

  # Check values of class attributes
  # AUC
  assertthat::assert_that((attr(obj, "auc") >= 0) && (attr(obj, "auc") <= 1))

}

#

@@ -196,12 +214,18 @@


  # Validate class items and attributes
  item_names <- c("roc", "prc")
  attr_names <- c("modname", "dsid", "nn", "np", "args", "src",
                  "validated")
  arg_names <- c("x_bins", "na_worst", "na.last", "ties_method", "ties.method",
                 "modname", "dsid", "keep_fmdat", "keep_cmats")
  .validate_basic(curves, "curves", "calc_measures", item_names, attr_names,
                  arg_names)
  attr_names <- c(
    "modname", "dsid", "nn", "np", "args", "src",
    "validated"
  )
  arg_names <- c(
    "x_bins", "na_worst", "na.last", "ties_method", "ties.method",
    "modname", "dsid", "keep_fmdat", "keep_cmats"
  )
  .validate_basic(
    curves, "curves", "calc_measures", item_names, attr_names,
    arg_names
  )

  # Check values of class items
  curves[["roc"]] <- .validate(curves[["roc"]])

@@ -5,12 +5,17 @@

  curve_df <- .prepare_autoplot(object)

  # === Create a ggplot object ===
  p <- ggplot2::ggplot(curve_df,
                       ggplot2::aes_string(x = 'x', y = 'y', color = 'x'))
  x_col <- rlang::sym("x")
  y_col <- rlang::sym("y")
  p <- ggplot2::ggplot(
    curve_df,
    ggplot2::aes(x = !!x_col, y = !!y_col, color = !!x_col)
  )
  p <- p + ggplot2::geom_jitter()
  p <- p + ggplot2::coord_flip()
  p <- .geom_basic(p, "Score distributions by rank", NULL, "rank",
                   show_legend = FALSE)
    show_legend = FALSE
  )
}

#

@@ -20,11 +25,18 @@

  curve_df <- .prepare_autoplot(object)

  # === Create a ggplot object ===
  p <- ggplot2::ggplot(curve_df,
                       ggplot2::aes_string(x = 'x', y = 'y', color = 'group'))
  x_col <- rlang::sym("x")
  y_col <- rlang::sym("y")
  group_col <- rlang::sym("group")
  p <- ggplot2::ggplot(
    curve_df,
    ggplot2::aes(x = !!x_col, y = !!y_col, color = !!group_col)
  )
  p <- p + ggplot2::geom_line()
  p <- .geom_basic(p, "TPs, FNs, FPs, and TNs by ranks",
                   "rank", "count", show_legend = TRUE)
    "rank", "count",
    show_legend = TRUE
  )
}

#

@@ -34,47 +46,52 @@

  curve_df <- .prepare_autoplot(object)

  # === Create a ggplot object ===
  p <- ggplot2::ggplot(curve_df,
                       ggplot2::aes_string(x = 'x', y = 'y'))
  x_col <- rlang::sym("x")
  y_col <- rlang::sym("y")
  p <- ggplot2::ggplot(
    curve_df,
    ggplot2::aes(x = !!x_col, y = !!y_col)
  )
  p <- p + ggplot2::geom_line()
  p <- p + ggplot2::facet_wrap(~ group, ncol = 2)
  p <- p + ggplot2::facet_wrap(~group, ncol = 2)

  p <- .geom_basic(p, "Evaluation measures by ranks",
                   "normalized rank", "evaluation value", show_legend = FALSE)
    "normalized rank", "evaluation value",
    show_legend = FALSE
  )
}

#' @rdname autoplot
#' @export
autoplot.sscurves <- function(object, curvetype = c("ROC", "PRC"), ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "l",
                                   def_show_cb = FALSE, def_raw_curves = TRUE,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = FALSE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = TRUE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "l",
    def_show_cb = FALSE, def_raw_curves = TRUE,
    def_add_np_nn = TRUE,
    def_show_legend = FALSE,
    def_ret_grob = FALSE,
    def_reduce_points = TRUE,
    def_multiplot_lib = "patchwork", ...
  )
  arglist[["raw_curves"]] <- TRUE
  arglist[["show_cb"]] <- FALSE
  arglist[["curvetype"]] <- .pmatch_curvetype_rocprc(arglist[["curvetype"]])

  .autoplot_multi(object, arglist)

}

#' @rdname autoplot
#' @export
autoplot.mscurves <- function(object, curvetype = c("ROC", "PRC"), ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "l",
                                   def_show_cb = FALSE, def_raw_curves = TRUE,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = TRUE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = TRUE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "l",
    def_show_cb = FALSE, def_raw_curves = TRUE,
    def_add_np_nn = TRUE,
    def_show_legend = TRUE,
    def_ret_grob = FALSE,
    def_reduce_points = TRUE,
    def_multiplot_lib = "patchwork", ...
  )
  arglist[["raw_curves"]] <- TRUE
  arglist[["show_cb"]] <- FALSE
  arglist[["curvetype"]] <- .pmatch_curvetype_rocprc(arglist[["curvetype"]])

@@ -85,15 +102,15 @@

#' @rdname autoplot
#' @export
autoplot.smcurves <- function(object, curvetype = c("ROC", "PRC"), ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "l",
                                   def_show_cb = TRUE, def_raw_curves = NULL,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = FALSE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = TRUE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "l",
    def_show_cb = TRUE, def_raw_curves = NULL,
    def_add_np_nn = TRUE,
    def_show_legend = FALSE,
    def_ret_grob = FALSE,
    def_reduce_points = TRUE,
    def_multiplot_lib = "patchwork", ...
  )

  arglist[["curvetype"]] <- .pmatch_curvetype_rocprc(arglist[["curvetype"]])


@@ -103,15 +120,15 @@

#' @rdname autoplot
#' @export
autoplot.mmcurves <- function(object, curvetype = c("ROC", "PRC"), ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "l",
                                   def_show_cb = FALSE, def_raw_curves = NULL,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = TRUE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = TRUE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "l",
    def_show_cb = FALSE, def_raw_curves = NULL,
    def_add_np_nn = TRUE,
    def_show_legend = TRUE,
    def_ret_grob = FALSE,
    def_reduce_points = TRUE,
    def_multiplot_lib = "patchwork", ...
  )

  arglist[["curvetype"]] <- .pmatch_curvetype_rocprc(arglist[["curvetype"]])


@@ -122,36 +139,35 @@

#' @export
autoplot.sspoints <- function(object, curvetype = .get_metric_names("basic"),
                              ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "p",
                                   def_show_cb = FALSE, def_raw_curves = TRUE,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = FALSE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = FALSE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "p",
    def_show_cb = FALSE, def_raw_curves = TRUE,
    def_add_np_nn = TRUE,
    def_show_legend = FALSE,
    def_ret_grob = FALSE,
    def_reduce_points = FALSE,
    def_multiplot_lib = "patchwork", ...
  )
  arglist[["raw_curves"]] <- TRUE
  arglist[["show_cb"]] <- FALSE
  arglist[["curvetype"]] <- .pmatch_curvetype_basic(arglist[["curvetype"]])

  .autoplot_multi(object, arglist)

}

#' @rdname autoplot
#' @export
autoplot.mspoints <- function(object, curvetype = .get_metric_names("basic"),
                              ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "p",
                                   def_show_cb = FALSE, def_raw_curves = TRUE,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = TRUE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = FALSE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "p",
    def_show_cb = FALSE, def_raw_curves = TRUE,
    def_add_np_nn = TRUE,
    def_show_legend = TRUE,
    def_ret_grob = FALSE,
    def_reduce_points = FALSE,
    def_multiplot_lib = "patchwork", ...
  )
  arglist[["raw_curves"]] <- TRUE
  arglist[["show_cb"]] <- FALSE
  arglist[["curvetype"]] <- .pmatch_curvetype_basic(arglist[["curvetype"]])

@@ -163,15 +179,15 @@

#' @export
autoplot.smpoints <- function(object, curvetype = .get_metric_names("basic"),
                              ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "p",
                                   def_show_cb = TRUE, def_raw_curves = NULL,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = FALSE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = FALSE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "p",
    def_show_cb = TRUE, def_raw_curves = NULL,
    def_add_np_nn = TRUE,
    def_show_legend = FALSE,
    def_ret_grob = FALSE,
    def_reduce_points = FALSE,
    def_multiplot_lib = "patchwork", ...
  )

  arglist[["curvetype"]] <- .pmatch_curvetype_basic(arglist[["curvetype"]])


@@ -182,15 +198,15 @@

#' @export
autoplot.mmpoints <- function(object, curvetype = .get_metric_names("basic"),
                              ...) {

  arglist <- .get_autoplot_arglist(attr(object, "args"),
                                   def_curvetype = curvetype, def_type = "p",
                                   def_show_cb = FALSE, def_raw_curves = NULL,
                                   def_add_np_nn = TRUE,
                                   def_show_legend = TRUE,
                                   def_ret_grob = FALSE,
                                   def_reduce_points = FALSE,
                                   def_multiplot_lib = "patchwork", ...)
    def_curvetype = curvetype, def_type = "p",
    def_show_cb = FALSE, def_raw_curves = NULL,
    def_add_np_nn = TRUE,
    def_show_legend = TRUE,
    def_ret_grob = FALSE,
    def_reduce_points = FALSE,
    def_multiplot_lib = "patchwork", ...
  )

  arglist[["curvetype"]] <- .pmatch_curvetype_basic(arglist[["curvetype"]])


@@ -43,8 +43,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat)

@@ -62,8 +63,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat)

@@ -75,10 +77,12 @@

#' mm_auc_ci
#'
#' @export
auc_ci <- function(curves, alpha=NULL, dtype=NULL) UseMethod("auc_ci", curves)
auc_ci <- function(curves, alpha = NULL, dtype = NULL) {
  UseMethod("auc_ci", curves)
}

#' @export
auc_ci.default <- function(curves, alpha=NULL, dtype=NULL) {
auc_ci.default <- function(curves, alpha = NULL, dtype = NULL) {
  stop("An object of unknown class is specified")
}


@@ -87,13 +91,16 @@

#
#' @rdname auc_ci
#' @export
auc_ci.aucs <- function(curves, alpha=0.05, dtype="normal") {
auc_ci.aucs <- function(curves, alpha = 0.05, dtype = "normal") {
  # Validation
  .validate(curves)
  assertthat::assert_that(attr(curves, "dataset_type") == "multiple",
                          msg = "'curves' must contain multiple datasets.")
  assertthat::assert_that(assertthat::is.number(alpha),
                          alpha >= 0 && alpha <= 1)
    msg = "'curves' must contain multiple datasets."
  )
  assertthat::assert_that(
    assertthat::is.number(alpha),
    alpha >= 0 && alpha <= 1
  )
  assertthat::assert_that(assertthat::is.string(dtype))

  # Check type of distribution

@@ -102,7 +109,10 @@

  if (!is.na(dype_match)) {
    dtype <- dtype_tab[dype_match]
  }
  err_msg = paste0("'dtype' must be one of ", paste(dtype_tab, collapse = ", "))
  err_msg <- paste0(
    "'dtype' must be one of ",
    paste(dtype_tab, collapse = ", ")
  )
  assertthat::assert_that(dtype %in% dtype_tab, msg = err_msg)

  # Get AUC scores

@@ -122,14 +132,18 @@

      aucs_mean <- mean(aucs_subset$aucs)
      aucs_n <- length(aucs_subset$aucs)
      if (aucs_n < 2) {
        ci_df <- rbind(ci_df,
                       data.frame(modnames = modname,
                                  curvetypes = curvetype,
                                  mean = aucs_mean,
                                  error = 0,
                                  lower_bound = aucs_mean,
                                  upper_bound = aucs_mean,
                                  n = aucs_n))
        ci_df <- rbind(
          ci_df,
          data.frame(
            modnames = modname,
            curvetypes = curvetype,
            mean = aucs_mean,
            error = 0,
            lower_bound = aucs_mean,
            upper_bound = aucs_mean,
            n = aucs_n
          )
        )
        next
      }
      aucs_sd <- sd(aucs_subset$aucs)

@@ -145,16 +159,19 @@

      acus_lower <- max(aucs_mean - aucs_error, 0.0)
      acus_upper <- min(aucs_mean + aucs_error, 1.0)

      ci_df <- rbind(ci_df,
                     data.frame(modnames = modname,
                                curvetypes = curvetype,
                                mean = aucs_mean,
                                error = aucs_error,
                                lower_bound = acus_lower,
                                upper_bound = acus_upper,
                                n = aucs_n))
      ci_df <- rbind(
        ci_df,
        data.frame(
          modnames = modname,
          curvetypes = curvetype,
          mean = aucs_mean,
          error = aucs_error,
          lower_bound = acus_lower,
          upper_bound = acus_upper,
          n = aucs_n
        )
      )
    }

  }

  ci_df

@@ -117,7 +117,6 @@

// Solve tied scores
void solve_ties(std::vector<double>& tp, std::vector<double>& fp,
                unsigned curpos, unsigned ties) {

  const double tied_tp = (tp[curpos] - tp[curpos-ties-1]) / (ties + 1);
  const double tied_fp = (fp[curpos] - fp[curpos-ties-1]) / (ties + 1);
  for (unsigned i = 0; i < ties; ++i) {

@@ -795,7 +794,7 @@

  n_y[vec_size - 2]  = 1;

  // Treat missing values
  for (int i = 0; i < vec_size; ++i) {
  for (unsigned i = 0; i < vec_size; ++i) {
    if (n_y[i] == 0) {
      if (n_y[i-1] != 0 && n_y[i+1] != 0) {
        s_y_val[i] = (s_y_val[i-1] + s_y_val[i+1]) / 2.0;

@@ -847,17 +846,17 @@

  std::vector<double> stot_y;        // Total of squared ys

  // Create all unique x values
  for (int i = 0; i < points.size(); ++i) {
  for (unsigned i = 0; i < static_cast<unsigned>(points.size()); ++i) {
    Rcpp::List c = Rcpp::as<Rcpp::List>(points[i]);
    Rcpp::NumericVector xs = c["x"];

    for (int j = 0; j < xs.size(); ++j) {
    for (unsigned j = 0; j < static_cast<unsigned>(xs.size()); ++j) {
      all_x_vals.insert(xs[j]);
    }
  }

  // Resize vectors
  int vec_size = all_x_vals.size();
  const unsigned vec_size = static_cast<const unsigned>(all_x_vals.size());
  x_val.resize(vec_size, 0.0);
  avg_y.resize(vec_size, 0.0);
  se_y.resize(vec_size, 0.0);

@@ -878,12 +877,12 @@


  // Calculate total
  idx = 0;
  for (int i = 0; i < points.size(); ++i) {
  for (unsigned i = 0; i < static_cast<unsigned>(points.size()); ++i) {
    Rcpp::List c = Rcpp::as<Rcpp::List>(points[i]);
    Rcpp::NumericVector xs = c["x"];
    Rcpp::NumericVector ys = c["y"];

    for (int j = 0; j < ys.size(); ++j) {
    for (unsigned j = 0; j < static_cast<unsigned>(ys.size()); ++j) {
      idx = x_vals_idx[xs[j]];

      tot_y[idx] += ys[j];

@@ -896,8 +895,8 @@

  double exp2;
  double sd;
  double n;
  for (int i = 0; i < vec_size; ++i) {
    n = double(count_y[i]);
  for (unsigned i = 0; i < vec_size; ++i) {
    n = static_cast<double>(count_y[i]);

    // y
    avg_y[i] = tot_y[i] / n;

@@ -929,4 +928,3 @@

929	928		return ret_val;
930	929		}
931	930
932		-

@@ -40,8 +40,8 @@

#'   input with calculated pAUCs and standardized pAUCs.
#'
#' @seealso \code{\link{evalmod}} for generating \code{S3} objects with
#'   performance evaluation measures. \code{\link{pauc}} for retrieving a dataset
#'   of pAUCs.
#'   performance evaluation measures. \code{\link{pauc}} for retrieving
#'   a dataset of pAUCs.
#'
#' @examples
#' \dontrun{

@@ -79,7 +79,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -104,8 +105,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat)

@@ -130,8 +132,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -150,10 +153,12 @@

#' }
#'
#' @export
part <- function(curves, xlim=NULL, ylim=NULL, curvetype=NULL) UseMethod("part", curves)
part <- function(curves, xlim = NULL, ylim = NULL, curvetype = NULL) {
  UseMethod("part", curves)
}

#' @export
part.default <- function(curves, xlim=NULL, ylim=NULL, curvetype=NULL) {
part.default <- function(curves, xlim = NULL, ylim = NULL, curvetype = NULL) {
  stop("An object of unknown class is specified")
}


@@ -206,9 +211,13 @@

  # Calculate partial AUC scores for ROC
  if ("ROC" %in% new_curvetype) {
    if (avg_only) {
      attr(curves, "grp_avg")[["rocs"]] <- .calc_pauc(attr(curves,
                                                           "grp_avg")[["rocs"]],
                                                      xlim, ylim, avg_only)
      attr(curves, "grp_avg")[["rocs"]] <- .calc_pauc(
        attr(
          curves,
          "grp_avg"
        )[["rocs"]],
        xlim, ylim, avg_only
      )
    } else {
      curves[["rocs"]] <- .calc_pauc(curves[["rocs"]], xlim, ylim, avg_only)
    }

@@ -219,9 +228,13 @@

  # Calculate partial AUC scores for precision-recall
  if ("PRC" %in% new_curvetype) {
    if (avg_only) {
      attr(curves, "grp_avg")[["prcs"]] <- .calc_pauc(attr(curves,
                                                           "grp_avg")[["prcs"]],
                                                      xlim, ylim, avg_only)
      attr(curves, "grp_avg")[["prcs"]] <- .calc_pauc(
        attr(
          curves,
          "grp_avg"
        )[["prcs"]],
        xlim, ylim, avg_only
      )
    } else {
      curves[["prcs"]] <- .calc_pauc(curves[["prcs"]], xlim, ylim, avg_only)
    }

@@ -243,7 +256,6 @@

# Calculate partial AUC scores
#
.calc_pauc <- function(curves, xlim, ylim, avg_only) {

  for (i in seq_along(curves)) {
    # Trim x
    x <- curves[[i]][["x"]]

@@ -279,11 +291,11 @@


    # Max 1
    if (pauc > 1) {
      pauc = 1
      pauc <- 1
    }

    if (spauc > 1) {
      spauc = 1
      spauc <- 1
    }

    attr(curves[[i]], "pauc") <- pauc

@@ -300,23 +312,28 @@

# Get pAUCs
#
.gather_paucs <- function(curves) {

  # Collect AUCs of ROC or PRC curves
  ct_len <- 2
  aucs <- attr(curves, "aucs")
  paucs <- data.frame(modnames = aucs$modnames,
                      dsids = aucs$dsids,
                      curvetypes = aucs$curvetypes,
                      paucs = rep(NA, length(aucs$modnames)),
                      spaucs = rep(NA, length(aucs$modnames)),
                      stringsAsFactors = FALSE)
  paucs <- data.frame(
    modnames = aucs$modnames,
    dsids = aucs$dsids,
    curvetypes = aucs$curvetypes,
    paucs = rep(NA, length(aucs$modnames)),
    spaucs = rep(NA, length(aucs$modnames)),
    stringsAsFactors = FALSE
  )

  for (i in seq_along(curves[["rocs"]])) {
    idx <- ct_len * i - 1
    paucs[["paucs"]][idx:(idx + 1)] <- c(attr(curves[["rocs"]][[i]], "pauc"),
                                         attr(curves[["prcs"]][[i]], "pauc"))
    paucs[["spaucs"]][idx:(idx + 1)] <- c(attr(curves[["rocs"]][[i]], "spauc"),
                                          attr(curves[["prcs"]][[i]], "spauc"))
    paucs[["paucs"]][idx:(idx + 1)] <- c(
      attr(curves[["rocs"]][[i]], "pauc"),
      attr(curves[["prcs"]][[i]], "pauc")
    )
    paucs[["spaucs"]][idx:(idx + 1)] <- c(
      attr(curves[["rocs"]][[i]], "spauc"),
      attr(curves[["prcs"]][[i]], "spauc")
    )
  }

  paucs

@@ -326,25 +343,30 @@

# Get pAUCs of average curves
#
.gather_paucs_avg <- function(curves) {

  avg_crvs <- attr(curves, "grp_avg")

  # Collect AUCs of ROC or PRC curves
  ct_len <- 2
  modnames <- attr(avg_crvs[["rocs"]], "uniq_modnames")
  paucs <- data.frame(modnames = rep(modnames, each = ct_len),
                      curvetypes = rep(c("ROC", "PRC"), length(modnames)),
                      paucs = rep(NA, length(modnames) * ct_len),
                      spaucs = rep(NA, length(modnames) * ct_len),
                      stringsAsFactors = FALSE)
  paucs <- data.frame(
    modnames = rep(modnames, each = ct_len),
    curvetypes = rep(c("ROC", "PRC"), length(modnames)),
    paucs = rep(NA, length(modnames) * ct_len),
    spaucs = rep(NA, length(modnames) * ct_len),
    stringsAsFactors = FALSE
  )

  for (i in seq_along(avg_crvs[["rocs"]])) {
    idx <- ct_len * i - 1
    idx2 <- idx + 1
    paucs[["paucs"]][idx:idx2] <- c(attr(avg_crvs[["rocs"]][[i]], "pauc"),
                                    attr(avg_crvs[["prcs"]][[i]], "pauc"))
    paucs[["spaucs"]][idx:idx2] <- c(attr(avg_crvs[["rocs"]][[i]], "spauc"),
                                     attr(avg_crvs[["prcs"]][[i]], "spauc"))
    paucs[["paucs"]][idx:idx2] <- c(
      attr(avg_crvs[["rocs"]][[i]], "pauc"),
      attr(avg_crvs[["prcs"]][[i]], "pauc")
    )
    paucs[["spaucs"]][idx:idx2] <- c(
      attr(avg_crvs[["rocs"]][[i]], "spauc"),
      attr(avg_crvs[["prcs"]][[i]], "spauc")
    )
  }

  paucs

@@ -11,10 +11,14 @@

  cat("    === Input data ===\n\n")

  data_info <- attr(x, "data_info")
  rownames(data_info) <- format(rownames(data_info), width = 4,
                                justify = "right")
  colnames(data_info) <- c("Model name", "Dataset ID", "# of negatives",
                           "# of positives")
  rownames(data_info) <- format(rownames(data_info),
    width = 4,
    justify = "right"
  )
  colnames(data_info) <- c(
    "Model name", "Dataset ID", "# of negatives",
    "# of positives"
  )

  print.data.frame(data_info, print.gap = 1)


@@ -51,8 +55,10 @@

      colnames(paucs) <- c("Model name", "Curve type", "pAUC", "Standardized")
    } else {
      cat("    === partial AUCs ===\n")
      colnames(paucs) <- c("Model name", "Dataset ID", "Curve type", "pAUC",
                           "Standardized")
      colnames(paucs) <- c(
        "Model name", "Dataset ID", "Curve type", "pAUC",
        "Standardized"
      )
    }

    cat("\n")

@@ -88,12 +94,18 @@

  cat("\n\n")

  eval_summary <- attr(x, "eval_summary")
  rownames(eval_summary) <- format(rownames(eval_summary), width = 4,
                                   justify = "right")
  colnames(eval_summary) <- c("Model", "ID", "Meas.", "Min.",
                              "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.")
  evaltypes <- c("rank", "score", "label", "err", "acc", "sp", "sn", "prec",
                 "mcc", "fscore")
  rownames(eval_summary) <- format(rownames(eval_summary),
    width = 4,
    justify = "right"
  )
  colnames(eval_summary) <- c(
    "Model", "ID", "Meas.", "Min.",
    "1st Qu.", "Median", "Mean", "3rd Qu.", "Max."
  )
  evaltypes <- c(
    "rank", "score", "label", "err", "acc", "sp", "sn", "prec",
    "mcc", "fscore"
  )
  eval_summary[, "Meas."] <- evaltypes

  print.data.frame(eval_summary, print.gap = 1)

@@ -115,10 +127,14 @@

  cat("    === Input data ===\n\n")

  data_info <- attr(x, "data_info")
  rownames(data_info) <- format(rownames(data_info), width = 4,
                                justify = "right")
  colnames(data_info) <- c("Model name", "Dataset ID", "# of negatives",
                           "# of positives")
  rownames(data_info) <- format(rownames(data_info),
    width = 4,
    justify = "right"
  )
  colnames(data_info) <- c(
    "Model name", "Dataset ID", "# of negatives",
    "# of positives"
  )

  print.data.frame(data_info, print.gap = 1)
  cat("\n\n")

@@ -5,7 +5,6 @@

                            calc_avg = FALSE, cb_alpha = 0.05,
                            raw_curves = FALSE, na_worst = TRUE,
                            ties_method = "equiv") {

  # === Calculate AUC ROC ===
  plfunc <- function(s) {
    # AUC with the U statistic

@@ -15,22 +14,29 @@

      } else {
        cl <- "negative"
      }
      err_msg <- paste0("AUCs with the U statistic cannot be calculated. ",
                        "Only a single class (", cl, ") ",
                        "found in dataset (modname: ", attr(mdat[[s]], "modname"),
                        ", dsid: ",attr(mdat[[s]], "dsid"), ").")
      err_msg <- paste0(
        "AUCs with the U statistic cannot be calculated. ",
        "Only a single class (", cl, ") ",
        "found in dataset (modname: ",
        attr(mdat[[s]], "modname"),
        ", dsid: ", attr(mdat[[s]], "dsid"), ")."
      )
      stop(err_msg, call. = FALSE)
    }
    uauc <- calc_auc_with_u(mdat[[s]], na_worst = na_worst,
                            ties_method = ties_method)
    calc_auc_with_u(mdat[[s]],
      na_worst = na_worst,
      ties_method = ties_method
    )
  }
  aucrocs <- lapply(seq_along(mdat), plfunc)
  auc.df <- .summarize_uauc_results(aucrocs, attr(mdat, "uniq_modnames"),
                                    attr(mdat, "uniq_dsids"), calc_avg,
                                    cb_alpha, raw_curves)
  auc_df <- .summarize_uauc_results(
    aucrocs, attr(mdat, "uniq_modnames"),
    attr(mdat, "uniq_dsids"), calc_avg,
    cb_alpha, raw_curves
  )

  # === Create an S3 object ===
  s3obj <- structure(auc.df, class = "aucroc")
  s3obj <- structure(auc_df, class = "aucroc")

  # Set attributes
  attr(s3obj, "data_info") <- attr(mdat, "data_info")

@@ -38,12 +44,14 @@

  attr(s3obj, "uniq_dsids") <- attr(mdat, "uniq_dsids")
  attr(s3obj, "model_type") <- model_type
  attr(s3obj, "dataset_type") <- dataset_type
  attr(s3obj, "args") <- list(mode = "aucroc",
                              calc_avg = calc_avg,
                              cb_alpha = cb_alpha,
                              raw_curves = raw_curves,
                              na_worst = na_worst,
                              ties_method = ties_method)
  attr(s3obj, "args") <- list(
    mode = "aucroc",
    calc_avg = calc_avg,
    cb_alpha = cb_alpha,
    raw_curves = raw_curves,
    na_worst = na_worst,
    ties_method = ties_method
  )
  attr(s3obj, "validated") <- FALSE

  # Call .validate.class_name()

@@ -61,12 +69,18 @@


  # Validate class items and attributes
  item_names <- NULL
  attr_names <- c("data_info", "uniq_modnames", "uniq_dsids",
                  "model_type", "dataset_type", "args", "validated")
  arg_names <- c("mode", "calc_avg", "cb_alpha", "raw_curves", "na_worst",
                 "ties_method")
  .validate_basic(aucroc, "aucroc", ".pl_main_aucroc", item_names,
                  attr_names, arg_names)
  attr_names <- c(
    "data_info", "uniq_modnames", "uniq_dsids",
    "model_type", "dataset_type", "args", "validated"
  )
  arg_names <- c(
    "mode", "calc_avg", "cb_alpha", "raw_curves", "na_worst",
    "ties_method"
  )
  .validate_basic(
    aucroc, "aucroc", ".pl_main_aucroc", item_names,
    attr_names, arg_names
  )

  attr(aucroc, "validated") <- TRUE
  aucroc

@@ -93,12 +107,13 @@

      vustat[i] <- aucs[[i]]$ustat
    }

    auc_df <- data.frame(modnames = vmodname,
                         dsids = vdsid,
                         aucs = vaucs,
                         ustats = vustat)
    auc_df <- data.frame(
      modnames = vmodname,
      dsids = vdsid,
      aucs = vaucs,
      ustats = vustat
    )
  }

  list(uaucs = auc_df)
}


@@ -8,12 +8,18 @@

#'
#'   \tabular{ll}{
#'     \strong{Function} \tab \strong{Description} \cr
#'     \code{\link{evalmod}}            \tab Main function to calculate evaluation measures \cr
#'     \code{\link{mmdata}}             \tab Reformat input data for performance evaluation calculation \cr
#'     \code{\link{join_scores}}        \tab Join scores of multiple models into a list \cr
#'     \code{\link{join_labels}}        \tab Join observed labels of multiple test datasets into a list \cr
#'     \code{\link{create_sim_samples}} \tab Create random samples for simulations \cr
#'     \code{\link{format_nfold}}       \tab Create n-fold cross validation dataset from data frame
#'     \code{\link{evalmod}}
#'           \tab Main function to calculate evaluation measures \cr
#'     \code{\link{mmdata}}
#'           \tab Reformat input data for performance evaluation calculation \cr
#'     \code{\link{join_scores}}
#'           \tab Join scores of multiple models into a list \cr
#'     \code{\link{join_labels}}
#'           \tab Join observed labels of multiple test datasets into a list \cr
#'     \code{\link{create_sim_samples}}
#'           \tab Create random samples for simulations \cr
#'     \code{\link{format_nfold}}
#'           \tab Create n-fold cross validation dataset from data frame
#'   }
#'
#' @section S3 generics:

@@ -21,16 +27,36 @@

#'  \code{S3} objects generated by the \code{\link{evalmod}} function.
#'
#'   \tabular{lll}{
#'     \strong{S3 generic} \tab \strong{Library} \tab \strong{Description} \cr
#'     \code{print}           \tab base      \tab Print the calculation results and the summary of the test data \cr
#'     \code{\link{as.data.frame}} \tab base \tab Convert a precrec object to a data frame \cr
#'     \code{\link{plot}}     \tab graphics  \tab Plot performance evaluation measures \cr
#'     \code{\link{autoplot}} \tab ggplot2   \tab Plot performance evaluation measures with ggplot2  \cr
#'     \code{\link{fortify}}  \tab ggplot2   \tab Prepare a data frame for ggplot2 \cr
#'     \code{\link{auc}}      \tab precrec   \tab Make a data frame with AUC scores \cr
#'     \code{\link{part}}     \tab precrec   \tab Calculate partial curves and partial AUC scores \cr
#'     \code{\link{pauc}}     \tab precrec   \tab Make a data frame with pAUC scores \cr
#'     \code{\link{auc_ci}}   \tab precrec   \tab Calculate confidence intervals of AUC scores
#'     \strong{S3 generic}
#'     \tab \strong{Library}
#'     \tab \strong{Description} \cr
#'     \code{print}
#'     \tab base
#'     \tab Print the calculation results and the summary of the test data \cr
#'     \code{\link{as.data.frame}}
#'     \tab base
#'     \tab Convert a precrec object to a data frame \cr
#'     \code{\link{plot}}
#'     \tab graphics
#'     \tab Plot performance evaluation measures \cr
#'     \code{\link{autoplot}}
#'     \tab ggplot2
#'     \tab Plot performance evaluation measures with ggplot2  \cr
#'     \code{\link{fortify}}
#'     \tab ggplot2
#'     \tab Prepare a data frame for ggplot2 \cr
#'     \code{\link{auc}}
#'     \tab precrec
#'     \tab Make a data frame with AUC scores \cr
#'     \code{\link{part}}
#'     \tab precrec
#'     \tab Calculate partial curves and partial AUC scores \cr
#'     \code{\link{pauc}}
#'     \tab precrec
#'     \tab Make a data frame with pAUC scores \cr
#'     \code{\link{auc_ci}}
#'     \tab precrec
#'     \tab Calculate confidence intervals of AUC scores
#'   }
#'
#' @section Performance measure calculations:

@@ -53,18 +79,20 @@

#'  five different performance levels.
#'
#' @section Data visualization:
#' \code{\link{plot}} takes an \code{S3} object generated by \code{\link{evalmod}} as input
#' and plot corresponding curves.
#' \code{\link{plot}} takes an \code{S3} object generated
#' by \code{\link{evalmod}} as input and plot corresponding curves.
#'
#' \code{\link{autoplot}} uses \code{ggplot} to plot curves.
#'
#' @section Result retrieval:
#' \code{\link{as.data.frame}} takes an \code{S3} object generated by \code{\link{evalmod}}
#' as input and and returns a data frame with calculated curve points.
#' \code{\link{as.data.frame}} takes an \code{S3} object generated
#' by \code{\link{evalmod}} as input and and returns a data frame
#' with calculated curve points.
#'
#' \code{\link{auc}} and \code{\link{pauc}} returns a data frame with AUC scores
#' and partial AUC scores, respectively. \code{\link{auc_ci}} returns confidence intervals
#' of AUCs for both ROC and precision-recall curves.
#' and partial AUC scores, respectively. \code{\link{auc_ci}}
#' returns confidence intervals of AUCs for both ROC
#' and precision-recall curves.
#'
#'
#' @docType package

@@ -75,8 +103,10 @@

#' @importFrom ggplot2 autoplot
#' @importFrom ggplot2 fortify
#' @importFrom grDevices col2rgb rainbow rgb
#' @importFrom graphics abline layout legend lines matplot par plot plot.new polygon
#' @importFrom graphics abline layout legend lines
#' @importFrom graphics matplot plot plot.new polygon
#' @importFrom methods is
#' @importFrom rlang sym
#' @importFrom stats qnorm rbeta rnorm sd qt
#' @importFrom data.table frank
#'

@@ -52,7 +52,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -70,8 +71,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -89,8 +91,9 @@

#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#'                modnames = samps[["modnames"]],
#'                dsids = samps[["dsids"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -4,11 +4,11 @@

calc_auc_with_u <- function(sdat, scores = NULL, labels = NULL, na_worst = TRUE,
                            ties_method = "equiv", keep_sdat = FALSE,
                            ustat_method = "frank", ...) {

  # === Validate input arguments ===
  # Create sdat from scores and labels if sdat is missing
  sdat <- .create_src_obj(sdat, "sdat", reformat_data, scores, labels,
                          mode = "aucroc", ...)
    mode = "aucroc", ...
  )
  .validate(sdat)

  # === Calculate AUCs (ROC) ===

@@ -18,30 +18,34 @@

    dt_loaded <- .load_data_table()
    if (dt_loaded) {
      if (na_worst) {
        na.last <- FALSE
        na_last <- FALSE
      } else {
        na.last <- TRUE
        na_last <- TRUE
      }
      if (ties_method == "random") {
        ties.method <- "random"
        ties_method <- "random"
      } else {
        ties.method <- "average"
        ties_method <- "average"
      }

      frank_func <- function(x) {
        data.table::frank(x, na.last = na.last, ties.method = ties.method)
        data.table::frank(x, na.last = na_last, ties.method = ties_method)
      }

      uauc <- calc_uauc_frank(attr(sdat, "np"), attr(sdat, "nn"),
                              sdat[["scores"]], sdat[["labels"]],
                              na.last, ties.method, frank_func)
      uauc <- calc_uauc_frank(
        attr(sdat, "np"), attr(sdat, "nn"),
        sdat[["scores"]], sdat[["labels"]],
        na_last, ties_method, frank_func
      )
      .check_cpp_func_error(uauc, "calc_uauc_fsort")
    }
  }

  if (ustat_method == "sort" || (ustat_method == "frank" && !dt_loaded)) {
    uauc <- calc_uauc(attr(sdat, "np"), attr(sdat, "nn"), sdat[["scores"]],
                      sdat[["labels"]], na_worst, ties_method)
    uauc <- calc_uauc(
      attr(sdat, "np"), attr(sdat, "nn"), sdat[["scores"]],
      sdat[["labels"]], na_worst, ties_method
    )
    .check_cpp_func_error(uauc, "calc_uauc")
  }


@@ -79,17 +83,25 @@


  # Validate class items and attributes
  item_names <- "auc"
  attr_names <- c("modname", "dsid", "nn", "np", "args", "cpp_errmsg",
                  "src", "validated")
  arg_names <- c("na_worst", "na.last", "ties_method", "ties.method",
                 "modname", "dsid", "keep_fmdat")
  .validate_basic(uauc, "uauc", "calc_auc_with_u", item_names, attr_names,
                  arg_names)
  attr_names <- c(
    "modname", "dsid", "nn", "np", "args", "cpp_errmsg",
    "src", "validated"
  )
  arg_names <- c(
    "na_worst", "na.last", "ties_method", "ties.method",
    "modname", "dsid", "keep_fmdat"
  )
  .validate_basic(
    uauc, "uauc", "calc_auc_with_u", item_names, attr_names,
    arg_names
  )

  # AUC
  auc <- uauc[["auc"]]
  assertthat::assert_that(assertthat::is.number(auc),
                          auc >= 0, auc <= 1)
  assertthat::assert_that(
    assertthat::is.number(auc),
    auc >= 0, auc <= 1
  )

  attr(uauc, "validated") <- TRUE
  uauc

@@ -66,8 +66,10 @@

#' @export
join_scores <- function(..., byrow = FALSE, chklen = TRUE) {
  # Call join datasets
  .join_datasets(..., efunc_vtype = .validate_scores, efunc_nrow = NULL,
                 byrow = byrow, chklen = chklen)
  .join_datasets(...,
    efunc_vtype = .validate_scores, efunc_nrow = NULL,
    byrow = byrow, chklen = chklen
  )
}

#' Join observed labels of multiple test datasets into a list

@@ -137,8 +139,10 @@

#' @export
join_labels <- function(..., byrow = FALSE, chklen = TRUE) {
  # Call join datasets
  .join_datasets(..., efunc_vtype = .validate_labels, efunc_nrow = NULL,
                 byrow = byrow, chklen = chklen)
  .join_datasets(...,
    efunc_vtype = .validate_labels, efunc_nrow = NULL,
    byrow = byrow, chklen = chklen
  )
}

#

@@ -146,11 +150,12 @@

#
.join_datasets <- function(..., efunc_vtype = NULL, efunc_nrow = NULL,
                           byrow = FALSE, chklen = TRUE) {

  # Validate arguments
  .validate_join_datasets_args(..., efunc_vtype = efunc_vtype,
                               efunc_nrow = efunc_nrow, byrow = byrow,
                               chklen = chklen)
  .validate_join_datasets_args(...,
    efunc_vtype = efunc_vtype,
    efunc_nrow = efunc_nrow, byrow = byrow,
    chklen = chklen
  )

  # Set a default error function for checking values
  if (is.null(efunc_vtype)) {

@@ -182,9 +187,9 @@

      cdat <- c(cdat, list(ds))
    } else if (is.matrix(ds) || is.data.frame(ds)) {
      if (byrow) {
        cdat <- c(cdat, lapply(seq(nrow(ds)), function(i) ds[i, ]))
        cdat <- c(cdat, lapply(seq_len(nrow(ds)), function(i) ds[i, ]))
      } else {
        cdat <- c(cdat, lapply(seq(ncol(ds)), function(j) ds[, j]))
        cdat <- c(cdat, lapply(seq_len(ncol(ds)), function(j) ds[, j]))
      }
    } else if (is.array(ds)) {
      if (length(dim(ds)) == 1) {

@@ -235,7 +240,6 @@

#
.validate_join_datasets_args <- function(..., efunc_vtype, efunc_nrow, byrow,
                                         chklen) {

  # Check ...
  arglist <- list(...)
  if (length(arglist) == 0) {

@@ -243,25 +247,28 @@

  }

  # Check efunc_vtype
  if (!is.null(efunc_vtype)
      && (!methods::is(efunc_vtype, "function")
          || length(as.list(formals(efunc_vtype))) != 1)) {
  if (!is.null(efunc_vtype) &&
    (!methods::is(efunc_vtype, "function") ||
      length(as.list(formals(efunc_vtype))) != 1)) {
    stop("efunc_vtype must be a function with 1 argument", call. = FALSE)
  }

  # Check efunc_nrow
  if (!is.null(efunc_nrow)
      && (!methods::is(efunc_nrow, "function")
          || length(as.list(formals(efunc_nrow))) != 2)) {
  if (!is.null(efunc_nrow) &&
    (!methods::is(efunc_nrow, "function") ||
      length(as.list(formals(efunc_nrow))) != 2)) {
    stop("efunc_nrow must be a function with 2 arguments", call. = FALSE)
  }

  # Check byrow
  assertthat::assert_that(assertthat::is.flag(byrow),
                          assertthat::noNA(byrow))
  assertthat::assert_that(
    assertthat::is.flag(byrow),
    assertthat::noNA(byrow)
  )

  # Check chklen
  assertthat::assert_that(assertthat::is.flag(chklen),
                          assertthat::noNA(chklen))

  assertthat::assert_that(
    assertthat::is.flag(chklen),
    assertthat::noNA(chklen)
  )
}

@@ -103,7 +103,6 @@

103	103		#' with \pkg{ggplot2}.
104	104		#'
105	105		#' @examples
106		-	#'
107	106		#' \dontrun{
108	107		#' ##################################################
109	108		#' ### Single model & single test dataset

@@ -125,8 +124,10 @@

#' plot(sscurves, curvetype = "PRC")
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
#'                     labels = P10N10$labels)
#' sspoints <- evalmod(
#'   mode = "basic", scores = P10N10$scores,
#'   labels = P10N10$labels
#' )
#'
#' ## Plot normalized ranks vs. basic evaluation measures
#' plot(sspoints)

@@ -142,7 +143,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -170,8 +172,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -199,8 +202,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -229,9 +233,11 @@

#' 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)
#' 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)

@@ -247,8 +253,7 @@

#'
#' ## Normalized ranks vs. average basic evaluation measures
#' plot(cvpoints)
#'
#'}
#' }
#' @name plot
NULL


@@ -279,7 +284,6 @@

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

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

@@ -296,8 +300,8 @@

        return("specificity")
      }

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


@@ -305,8 +309,8 @@

        return("precision")
      }

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


@@ -355,7 +359,8 @@

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

  if (is.null(arglist[["raw_curves"]])) {

@@ -369,7 +374,8 @@

  }
  if (!evalmod_args[["raw_curves"]] && arglist[["raw_curves"]]) {
    stop("Invalid raw_curves. Inconsistent with the value of evalmod.",
         call. = FALSE)
      call. = FALSE
    )
  }

  if (is.null(arglist[["add_np_nn"]])) {

@@ -381,7 +387,6 @@

  }

  arglist

}

#

@@ -396,12 +401,12 @@


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

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

  # === Validate input arguments ===

@@ -422,9 +427,11 @@

  }

  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)
    .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 = "")

@@ -443,14 +450,13 @@

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

  if (ctype_len == 1) {
    nrow1 <- 2
    ncol1 <- 1
    mat1 <- c(1, 2)
    mat2 <- 1
    heights <- c(0.85, 0.15)
  } else  if (ctype_len == 2) {
  } else if (ctype_len == 2) {
    nrow1 <- 2
    ncol1 <- 2
    mat1 <- c(1, 2, 3, 3)

@@ -495,7 +501,6 @@

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

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


@@ -512,9 +517,11 @@

  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)
  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
  )
}

#

@@ -558,8 +565,10 @@


  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)
  graphics::plot(1,
    type = "n", main = main, xlab = xlab, ylab = ylab,
    ylim = ylim, xlim = xlim
  )

  if (length(avgcurves) == 1) {
    lcols <- "blue"

@@ -594,15 +603,21 @@

    }

    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))
    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))
  graphics::lines(x, y,
    type = type, lty = 1, pch = 19,
    col = grDevices::rgb(b[1], b[2], b[3], 200,
      maxColorValue = 255
    )
  )
}

#

@@ -611,7 +626,6 @@

.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"]]


@@ -630,19 +644,24 @@


  # === Create a plot ===
  if (show_cb) {
    .plot_avg(x, type, tlist[["ctype"]], main, tlist[["xlab"]],
              tlist[["ylab"]], 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"]])
    .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)
    .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)
  }

@@ -654,7 +673,7 @@

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

  if (curvetype == "ROC") {
    tlist[["main"]] <- "ROC"

@@ -667,15 +686,20 @@

    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")
    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))
      main <- paste0(
        toupper(substring(curvetype, 1, 1)),
        substring(curvetype, 2)
      )
    }
    tlist[["main"]] <- main
    tlist[["xlab"]] <- "normalized rank"

@@ -694,10 +718,12 @@

    withr::local_par(list(mar = c(0, 0, 0, 0), pty = "m"))
    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), alpha = 1),
                     horiz = TRUE)
    graphics::legend(
      x = "top", lty = 1,
      legend = gnames,
      col = grDevices::rainbow(length(gnames), alpha = 1),
      horiz = TRUE
    )
  }
}


@@ -715,16 +741,20 @@

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


@@ -744,6 +774,8 @@

744	774		} else {
745	775		xlim <- c(0, 1)
746	776		}
	777	+
	778	+	xlim
747	779		}
748	780
749	781		#

@@ -759,4 +791,6 @@

759	791		} else {
760	792		ylim <- c(0, 1)
761	793		}
	794	+
	795	+	ylim
762	796		}

@@ -91,8 +91,10 @@

#' p_prc
#'
#' ## Generate an sspoints object that contains basic evaluation measures
#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
#'                     labels = P10N10$labels)
#' sspoints <- evalmod(
#'   mode = "basic", scores = P10N10$scores,
#'   labels = P10N10$labels
#' )
#' ## Fortify sspoints
#' ssdf <- fortify(sspoints)
#'

@@ -109,7 +111,8 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)

@@ -155,8 +158,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -192,8 +196,9 @@

#' 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")
#'   stat = "identity", alpha = 0.25,
#'   fill = "grey25"
#' )
#' p_prec <- p_prec + geom_point(aes(x = x, y = y))
#' p_prec
#'

@@ -205,8 +210,9 @@

#' ## 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"]])
#'   modnames = samps[["modnames"]],
#'   dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)

@@ -242,8 +248,9 @@

#' 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")
#'   stat = "identity", alpha = 0.25,
#'   fill = "grey25"
#' )
#' p_prec <- p_prec + geom_point(aes(x = x, y = y, color = modname))
#' p_prec
#' }

@@ -256,7 +263,6 @@

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

  arglist <- list(...)

  if (!is.null(def_raw_curves)) {

@@ -5,15 +5,16 @@

                          modname = as.character(NA), dsid = 1L,
                          posclass = NULL, na_worst = TRUE,
                          ties_method = "equiv", mode = "rocprc", ...) {

  # === Validate input arguments ===
  new_ties_method <- .pmatch_tiesmethod(ties_method, ...)
  new_na_worst <- .get_new_naworst(na_worst, ...)
  new_mode <- .pmatch_mode(mode)
  .validate_reformat_data_args(scores, labels, modname = modname, dsid = dsid,
                               posclass = posclass, na_worst = new_na_worst,
                               ties_method = new_ties_method, mode = new_mode,
                               ...)
  .validate_reformat_data_args(scores, labels,
    modname = modname, dsid = dsid,
    posclass = posclass, na_worst = new_na_worst,
    ties_method = new_ties_method, mode = new_mode,
    ...
  )

  # === Reformat input data ===
  # Get a factor with "positive" and "negative"

@@ -21,22 +22,31 @@


  if (mode == "aucroc") {
    # === Create an S3 object ===
    s3obj <- structure(list(scores = scores,
                            labels = fmtlabs[["labels"]]),
                       class = "sdat")
    s3obj <- structure(
      list(
        scores = scores,
        labels = fmtlabs[["labels"]]
      ),
      class = "sdat"
    )
  } else {
    # Get score ranks and sorted indices
    sranks <- .rank_scores(scores, new_na_worst, new_ties_method,
                           validate = FALSE)
      validate = FALSE
    )
    ranks <- sranks[["ranks"]]
    rank_idx <- sranks[["rank_idx"]]

    # === Create an S3 object ===
    s3obj <- structure(list(scores = scores,
                            labels = fmtlabs[["labels"]],
                            ranks = ranks,
                            rank_idx = rank_idx),
                       class = "fmdat")
    s3obj <- structure(
      list(
        scores = scores,
        labels = fmtlabs[["labels"]],
        ranks = ranks,
        rank_idx = rank_idx
      ),
      class = "fmdat"
    )
  }

  # Set attributes

@@ -44,9 +54,11 @@

  attr(s3obj, "dsid") <- dsid
  attr(s3obj, "nn") <- fmtlabs[["nn"]]
  attr(s3obj, "np") <- fmtlabs[["np"]]
  attr(s3obj, "args") <- list(posclass = posclass, na_worst = new_na_worst,
                              ties_method = new_ties_method,
                              modname = modname, dsid = dsid)
  attr(s3obj, "args") <- list(
    posclass = posclass, na_worst = new_na_worst,
    ties_method = new_ties_method,
    modname = modname, dsid = dsid
  )
  attr(s3obj, "validated") <- FALSE

  # Call .validate.fmdat() / .validate.sdat()

@@ -88,7 +100,6 @@

#
.rank_scores <- function(scores, na_worst = TRUE, ties_method = "equiv",
                         validate = TRUE) {

  # === Validate input arguments ===
  if (validate) {
    .validate_scores(scores)

@@ -97,7 +108,6 @@

  }

  # === Create ranks ===
  #   ranks <- rank(scores, na_worst, ties_method)
  sranks <- get_score_ranks(scores, na_worst, ties_method)
  .check_cpp_func_error(sranks, "get_score_ranks")


@@ -110,12 +120,12 @@

.validate_reformat_data_args <- function(scores, labels, modname, dsid,
                                         posclass, na_worst, ties_method,
                                         mode, ...) {

  # Check '...'
  arglist <- list(...)
  if (!is.null(names(arglist))) {
    stop(paste0("Invalid arguments: ", paste(names(arglist), collapse = ", ")),
         call. = FALSE)
      call. = FALSE
    )
  }

  # Check scores and labels

@@ -138,7 +148,6 @@


  # Check mode
  .validate_mode(mode)

}

#

@@ -154,30 +163,38 @@

  item_names <- c("scores", "labels", "ranks", "rank_idx")
  attr_names <- c("modname", "dsid", "nn", "np", "args", "validated")
  arg_names <- c("posclass", "na_worst", "ties_method", "modname", "dsid")
  .validate_basic(fmdat, "fmdat", "reformat_data", item_names, attr_names,
                  arg_names)
  .validate_basic(
    fmdat, "fmdat", "reformat_data", item_names, attr_names,
    arg_names
  )

  # Check values of class items
  if (length(fmdat[["labels"]]) == 0
      || length(fmdat[["labels"]]) != length(fmdat[["ranks"]])
      || length(fmdat[["labels"]]) != length(fmdat[["rank_idx"]])) {
  if (length(fmdat[["labels"]]) == 0 ||
    length(fmdat[["labels"]]) != length(fmdat[["ranks"]]) ||
    length(fmdat[["labels"]]) != length(fmdat[["rank_idx"]])) {
    stop("List items in fmdat must be all the same lengths", call. = FALSE)
  }

  # Labels
  assertthat::assert_that(is.atomic(fmdat[["labels"]]),
                          is.vector(fmdat[["labels"]]),
                          is.numeric(fmdat[["labels"]]))
  assertthat::assert_that(
    is.atomic(fmdat[["labels"]]),
    is.vector(fmdat[["labels"]]),
    is.numeric(fmdat[["labels"]])
  )

  # Ranks
  assertthat::assert_that(is.atomic(fmdat[["ranks"]]),
                          is.vector(fmdat[["ranks"]]),
                          is.numeric(fmdat[["ranks"]]))
  assertthat::assert_that(
    is.atomic(fmdat[["ranks"]]),
    is.vector(fmdat[["ranks"]]),
    is.numeric(fmdat[["ranks"]])
  )

  # Rank index
  assertthat::assert_that(is.atomic(fmdat[["rank_idx"]]),
                          is.vector(fmdat[["rank_idx"]]),
                          is.integer(fmdat[["rank_idx"]]))
  assertthat::assert_that(
    is.atomic(fmdat[["rank_idx"]]),
    is.vector(fmdat[["rank_idx"]]),
    is.integer(fmdat[["rank_idx"]])
  )


329	349		#
330	350		.dataframe_curve <- function(obj, uniq_modnames, uniq_dsids, modnames, dsids,
331	351		dsid_modnames, curvetype_names) {
332		-
333	352		curve_df <- NULL
334	353		for (curvetype in names(curvetype_names)) {
335	354		curves <- obj[[curvetype_names[[curvetype]]]]

389	418		# Process ... for curve objects
390	419		#
391	420		.get_dataframe_arglist <- function(evalmod_args, def_raw_curves, ...) {
392		-
393	421		arglist <- list(...)
394	422
395	423		if (is.null(arglist[["raw_curves"]])) {

329	337		def_raw_curves, def_add_np_nn,
330	338		def_show_legend, def_ret_grob,
331	339		def_reduce_points, def_multiplot_lib, ...) {
332		-
333	340		arglist <- list(...)
334	341
335	342		if (is.null(arglist[["curvetype"]])) {

425	438		.load_grid <- function() {
426	439		if (!requireNamespace("grid", quietly = TRUE)) {
427	440		stop("grid is required to perform this function. Please install it.",
428		-	call. = FALSE)
	441	+	call. = FALSE
	442	+	)
429	443		}
430	444		}
431	445
432	446		#
433	447		# Load gridExtra
434	448		#
435		-	.load_gridExtra <- function() {
	449	+	.load_gridextra <- function() {
436	450		if (!requireNamespace("gridExtra", quietly = TRUE)) {
437	451		stop("gridExtra is required to perform this function. Please install it.",
438		-	call. = FALSE)
	452	+	call. = FALSE
	453	+	)
439	454		}
440	455		}
441	456

446	461		if (requireNamespace("patchwork", quietly = TRUE)) {
447	462		return(TRUE)
448	463		} else {
449		-	warning("patchwork is not installed. grid and gridExtra will be used instead.",
450		-	call. = FALSE)
	464	+	warning(
	465	+	paste0(
	466	+	"patchwork is not installed. ",
	467	+	"grid and gridExtra will be used instead."
	468	+	),
	469	+	call. = FALSE
	470	+	)
451	471		return(FALSE)
452	472		}
453	473		}

35	35		#' head(M2N50F5)
36	36		#'
37	37		#' ## Convert with format_nfold
38		-	#' nfold_list1 <- format_nfold(nfold_df = M2N50F5, score_cols = c(1, 2),
39		-	#' lab_col = 3, fold_col = 4)
	38	+	#' nfold_list1 <- format_nfold(
	39	+	#' nfold_df = M2N50F5, score_cols = c(1, 2),
	40	+	#' lab_col = 3, fold_col = 4
	41	+	#' )
40	42		#'
41	43		#' ## Show the list structure
42	44		#' str(nfold_list1)

49	51		#' ###
50	52		#'
51	53		#' ## Convert with format_nfold
52		-	#' nfold_list2 <- format_nfold(nfold_df = M2N50F5, score_cols = 1,
53		-	#' lab_col = 3, fold_col = 4)
	54	+	#' nfold_list2 <- format_nfold(
	55	+	#' nfold_df = M2N50F5, score_cols = 1,
	56	+	#' lab_col = 3, fold_col = 4
	57	+	#' )
54	58		#'
55	59		#' ## Show the list structure
56	60		#' str(nfold_list2)

63	67		#' ###
64	68		#'
65	69		#' ## Convert with format_nfold
66		-	#' nfold_list3 <- format_nfold(nfold_df = M2N50F5,
67		-	#' score_cols = c("score1", "score2"),
68		-	#' lab_col = "label", fold_col = "fold")
	70	+	#' nfold_list3 <- format_nfold(
	71	+	#' nfold_df = M2N50F5,
	72	+	#' score_cols = c("score1", "score2"),
	73	+	#' lab_col = "label", fold_col = "fold"
	74	+	#' )
69	75		#'
70	76		#' ## Show the list structure
71	77		#' str(nfold_list3)

74	80		#'
75	81		#' @export
76	82		format_nfold <- function(nfold_df, score_cols, lab_col, fold_col) {
77		-
78	83		# Validate arguments
79	84		.validate_format_nfold_args(nfold_df, score_cols, lab_col, fold_col)
80	85

113	118		#
114	119		# Validate arguments of format_nfold()
115	120		#
116		-	.validate_format_nfold_args <- function(nfold_df, score_cols, lab_col, fold_col) {
117		-
	121	+	.validate_format_nfold_args <- function(nfold_df, score_cols,
	122	+	lab_col, fold_col) {
118	123		if (!is.data.frame(nfold_df)) {
119	124		stop("nfold_df must be a data frame.", call. = FALSE)
120	125		}

127	132
128	133		# Check fold column name
129	134		.validate_fold_col(fold_col, nfold_df)
130		-
131	135		}
132		-

23	23		#' @return The \code{auc} function returns a data frame with AUC scores.
24	24		#'
25	25		#' @seealso \code{\link{evalmod}} for generating \code{S3} objects with
26		-	#' performance evaluation measures. \code{\link{pauc}} for retrieving a dataset
27		-	#' of pAUCs.
	26	+	#' performance evaluation measures. \code{\link{pauc}} for retrieving
	27	+	#' a dataset of pAUCs.
28	28		#'
29	29		#' @examples
30	30		#'

49	49		#' ## Create sample datasets with 100 positives and 100 negatives
50	50		#' samps <- create_sim_samples(1, 100, 100, "all")
51	51		#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
52		-	#' modnames = samps[["modnames"]])
	52	+	#' modnames = samps[["modnames"]]
	53	+	#' )
53	54		#'
54	55		#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
55	56		#' mscurves <- evalmod(mdat)

65	66		#' ## Create sample datasets with 100 positives and 100 negatives
66	67		#' samps <- create_sim_samples(4, 100, 100, "good_er")
67	68		#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
68		-	#' modnames = samps[["modnames"]],
69		-	#' dsids = samps[["dsids"]])
	69	+	#' modnames = samps[["modnames"]],
	70	+	#' dsids = samps[["dsids"]]
	71	+	#' )
70	72		#'
71	73		#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
72	74		#' smcurves <- evalmod(mdat, raw_curves = TRUE)

4	4		#' \code{\link{evalmod}} to a data frame.
5	5		#'
6	6		#' @param x An \code{S3} object generated by \code{\link{evalmod}}.
7		-	#' The \code{as.data.frame} function takes one of the following \code{S3} objects.
	7	+	#' The \code{as.data.frame} function takes
	8	+	#' one of the following \code{S3} objects.
8	9		#'
9	10		#' \enumerate{
10	11		#'

315	324		#'
316	325		#' ## Normalized ranks vs. average basic evaluation measures
317	326		#' autoplot(cvpoints)
318		-	#'
319	327		#' }
320	328		#'
321	329		#' @name autoplot

359	367		}
360	368		if (!evalmod_args[["raw_curves"]] && arglist[["raw_curves"]]) {
361	369		stop("Invalid raw_curves. Inconsistent with the value of evalmod.",
362		-	call. = FALSE)
	370	+	call. = FALSE
	371	+	)
363	372		}
364	373
365	374		if (is.null(arglist[["add_np_nn"]])) {

63	64		#' performance evaluation measures.
64	65		#'
65	66		#' @examples
66		-	#'
67	67		#' \dontrun{
68	68		#' ##################################################
69	69		#' ### Single model & single test dataset

82	82		#' head(sscurves.df)
83	83		#'
84	84		#' ## Generate an sspoints object that contains basic evaluation measures
85		-	#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
86		-	#' labels = P10N10$labels)
	85	+	#' sspoints <- evalmod(
	86	+	#' mode = "basic", scores = P10N10$scores,
	87	+	#' labels = P10N10$labels
	88	+	#' )
87	89		#' ## Convert sspoints to a data frame
88	90		#' sspoints.df <- as.data.frame(sspoints)
89	91		#'

126	129		#' ## Create sample datasets with 100 positives and 100 negatives
127	130		#' samps <- create_sim_samples(10, 100, 100, "good_er")
128	131		#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
129		-	#' modnames = samps[["modnames"]],
130		-	#' dsids = samps[["dsids"]])
	132	+	#' modnames = samps[["modnames"]],
	133	+	#' dsids = samps[["dsids"]]
	134	+	#' )
131	135		#'
132	136		#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
133	137		#' smcurves <- evalmod(mdat, raw_curves = TRUE)

185	190		#' data(M2N50F5)
186	191		#'
187	192		#' ## Speficy nessesary columns to create mdat
188		-	#' cvdat <- mmdata(nfold_df = M2N50F5, score_cols = c(1, 2),
189		-	#' lab_col = 3, fold_col = 4,
190		-	#' modnames = c("m1", "m2"), dsids = 1:5)
	193	+	#' cvdat <- mmdata(
	194	+	#' nfold_df = M2N50F5, score_cols = c(1, 2),
	195	+	#' lab_col = 3, fold_col = 4,
	196	+	#' modnames = c("m1", "m2"), dsids = 1:5
	197	+	#' )
191	198		#'
192	199		#' ## Generate an mmcurve object that contains ROC and Precision-Recall curves
193	200		#' cvcurves <- evalmod(cvdat)

214	221		#'
215	222		#' ## mode = "aucroc"
216	223		#' data(P10N10)
217		-	#' uauc1 <- evalmod(scores = P10N10$scores, labels = P10N10$labels,
218		-	#' mode="aucroc")
	224	+	#' uauc1 <- evalmod(
	225	+	#' scores = P10N10$scores, labels = P10N10$labels,
	226	+	#' mode = "aucroc"
	227	+	#' )
219	228		#'
220	229		#' # as.data.frame 'aucroc'
221	230		#' as.data.frame(uauc1)

271	281		} else {
272	282		x_bins <- 0
273	283		}
274		-
275	284		} else if (new_mode == "basic") {
276		-	curvetype_names <- list(score = "score", label = "label", error = "err",
277		-	accuracy = "acc", specificity = "sp",
278		-	sensitivity = "sn", precision = "prec", mcc = "mcc",
279		-	fscore = "fscore")
	285	+	curvetype_names <- list(
	286	+	score = "score", label = "label", error = "err",
	287	+	accuracy = "acc", specificity = "sp",
	288	+	sensitivity = "sn", precision = "prec", mcc = "mcc",
	289	+	fscore = "fscore"
	290	+	)
280	291		x_bins <- 0
281	292		}
282	293
283	294		# Make dsis-modname pairs
284	295		dsid_modnames <- paste(attr(obj, "data_info")$modnames,
285		-	attr(obj, "data_info")$dsids, sep = ":")
	296	+	attr(obj, "data_info")$dsids,
	297	+	sep = ":"
	298	+	)
286	299
287	300		# Create curve_df
288	301		if (raw_curves) {
289	302		if (use_rcpp) {
290		-	list_df <- convert_curve_df(obj, uniq_modnames, as.character(uniq_dsids),
291		-	match(modnames, uniq_modnames),
292		-	match(dsids, uniq_dsids),
293		-	dsid_modnames, curvetype_names, x_bins)
	303	+	list_df <- convert_curve_df(
	304	+	obj, uniq_modnames, as.character(uniq_dsids),
	305	+	match(modnames, uniq_modnames),
	306	+	match(dsids, uniq_dsids),
	307	+	dsid_modnames, curvetype_names, x_bins
	308	+	)
294	309		.check_cpp_func_error(list_df, "convert_curve_df")
295	310		curve_df <- list_df[["df"]]
296	311		} else {
297		-	curve_df <- .dataframe_curve(obj, uniq_modnames, uniq_dsids, modnames,
298		-	dsids, dsid_modnames, curvetype_names)
	312	+	curve_df <- .dataframe_curve(
	313	+	obj, uniq_modnames, uniq_dsids, modnames,
	314	+	dsids, dsid_modnames, curvetype_names
	315	+	)
299	316		warning("R version of .dataframe_common is used")
300	317		}
301	318		} else {
302	319		if (use_rcpp) {
303		-	list_df <- convert_curve_avg_df(attr(obj, "grp_avg"), uniq_modnames,
304		-	match(modnames, uniq_modnames),
305		-	curvetype_names, x_bins)
	320	+	list_df <- convert_curve_avg_df(
	321	+	attr(obj, "grp_avg"), uniq_modnames,
	322	+	match(modnames, uniq_modnames),
	323	+	curvetype_names, x_bins
	324	+	)
306	325		.check_cpp_func_error(list_df, "convert_curve_avg_df")
307	326		curve_df <- list_df[["df"]]
308	327		} else {
309		-	curve_df <- .dataframe_curve_avg(obj, uniq_modnames, uniq_dsids, modnames,
310		-	dsids, dsid_modnames, curvetype_names)
	328	+	curve_df <- .dataframe_curve_avg(
	329	+	obj, uniq_modnames, uniq_dsids, modnames,
	330	+	dsids, dsid_modnames, curvetype_names
	331	+	)
311	332		warning("R version of .dataframe_common is used")
312	333		}
313		-
314	334		}
315	335
316	336		if (!check_ggplot) {
317	337		if ("dsid_modname" %in% names(curve_df)) {
318		-	curve_df <- with(curve_df, subset(curve_df, select = -dsid_modname))
	338	+	curve_df[["dsid_modname"]] <- NULL
319	339		}
320	340		colnum <- ncol(curve_df)
321	341		names(curve_df) <- c(names(curve_df)[1:(colnum - 1)], "type")

339	358
340	359		modname <- factor(rep(modnames[i], length(x)), levels = uniq_modnames)
341	360		dsid <- factor(rep(dsids[i], length(x)), levels = uniq_dsids)
342		-	dsid_modname <- factor(rep(paste(modnames[i], dsids[i], sep = ":"),
343		-	length(x)),
344		-	levels = dsid_modnames)
	361	+	dsid_modname <- factor(
	362	+	rep(
	363	+	paste(modnames[i], dsids[i], sep = ":"),
	364	+	length(x)
	365	+	),
	366	+	levels = dsid_modnames
	367	+	)
345	368		curvename <- factor(rep(curvetype, length(x)),
346		-	levels = names(curvetype_names))
347		-	curve_df <- rbind(curve_df, data.frame(x = x, y = y, modname = modname,
348		-	dsid = dsid,
349		-	dsid_modname = dsid_modname,
350		-	curvetype = curvename))
	369	+	levels = names(curvetype_names)
	370	+	)
	371	+	curve_df <- rbind(curve_df, data.frame(
	372	+	x = x, y = y, modname = modname,
	373	+	dsid = dsid,
	374	+	dsid_modname = dsid_modname,
	375	+	curvetype = curvename
	376	+	))
351	377		}
352	378		}
353	379

357	383		#
358	384		# Make a dataframe for plotting with average curves
359	385		#
360		-	.dataframe_curve_avg <- function(obj, uniq_modnames, uniq_dsids, modnames, dsids,
361		-	dsid_modnames, curvetype_names) {
362		-
	386	+	.dataframe_curve_avg <- function(obj, uniq_modnames, uniq_dsids, modnames,
	387	+	dsids, dsid_modnames, curvetype_names) {
363	388		grp_avg <- attr(obj, "grp_avg")
364	389		curve_df <- NULL
365	390		for (curvetype in names(curvetype_names)) {

372	397		ymax <- avgcurves[[i]][["y_ci_h"]]
373	398
374	399		modname <- factor(rep(uniq_modnames[i], length(x)),
375		-	levels = uniq_modnames)
	400	+	levels = uniq_modnames
	401	+	)
376	402		curvename <- factor(rep(curvetype, length(x)),
377		-	levels = names(curvetype_names))
378		-	curve_df <- rbind(curve_df, data.frame(x = x, y = y,
379		-	ymin = ymin, ymax = ymax,
380		-	modname = modname,
381		-	curvetype = curvename))
	403	+	levels = names(curvetype_names)
	404	+	)
	405	+	curve_df <- rbind(curve_df, data.frame(
	406	+	x = x, y = y,
	407	+	ymin = ymin, ymax = ymax,
	408	+	modname = modname,
	409	+	curvetype = curvename
	410	+	))
382	411		}
383	412		}
384	413

160	160		#' autoplot(sscurves, curvetype = "PRC")
161	161		#'
162	162		#' ## Generate an sspoints object that contains basic evaluation measures
163		-	#' sspoints <- evalmod(mode = "basic", scores = P10N10$scores,
164		-	#' labels = P10N10$labels)
	163	+	#' sspoints <- evalmod(
	164	+	#' mode = "basic", scores = P10N10$scores,
	165	+	#' labels = P10N10$labels
	166	+	#' )
165	167		#'
166	168		#' ## Normalized ranks vs. basic evaluation measures
167	169		#' autoplot(sspoints)

Updating our web app

272	277		#'
273	278		#' ## Reduced/Full supporting points
274	279		#' sampmm <- create_sim_samples(4, 5000, 5000)
275		-	#' mdatmm <- mmdata(sampmm$scores, sampmm$labels, modnames = c("m1", "m2"),
276		-	#' dsids = c(1, 2), expd_first = "modnames")
	280	+	#' mdatmm <- mmdata(sampmm$scores, sampmm$labels,
	281	+	#' modnames = c("m1", "m2"),
	282	+	#' dsids = c(1, 2), expd_first = "modnames"
	283	+	#' )
277	284		#' evalmm <- evalmod(mdatmm, raw_curves = TRUE)
278	285		#'
279	286		#' # Reduced supporting point

345	352		}
346	353		if (!evalmod_args[["calc_avg"]] && arglist[["show_cb"]]) {
347	354		stop("Invalid show_cb. Inconsistent with calc_avg of evalmod.",
348		-	call. = FALSE)
	355	+	call. = FALSE
	356	+	)
349	357		}
350	358
351	359		if (is.null(arglist[["raw_curves"]])) {

413	422		#
414	423		.load_ggplot2 <- function() {
415	424		if (!requireNamespace("ggplot2", quietly = TRUE)) {
416		-	stop(paste("ggplot2 is required to perform this function.",
417		-	"Please install it."),
418		-	call. = FALSE)
	425	+	stop(
	426	+	paste(
	427	+	"ggplot2 is required to perform this function.",
	428	+	"Please install it."
	429	+	),
	430	+	call. = FALSE
	431	+	)
419	432		}
420	433		}
421	434

466	486
467	487		show_cb <- arglist[["show_cb"]]
468	488		if (!attr(object, "args")$calc_avg) {
469		-	show_cb = FALSE
	489	+	show_cb <- FALSE
470	490		}
471	491
472	492		raw_curves <- arglist[["raw_curves"]]
473	493		if (show_cb) {
474		-	raw_curves = FALSE
	494	+	raw_curves <- FALSE
475	495		}
476	496
477	497		# === Check package availability ===
478	498		.load_ggplot2()
479		-	avail_pathwork <- .load_ggplot2()
480	499		.validate(object)
481	500		.check_curvetype(curvetype, object)
482	501		.check_type(type)

488	507		.check_multiplot_lib(multiplot_lib)
489	508
490	509		# === Create a ggplot object for ROC&PRC, ROC, or PRC ===
491		-	curve_df <- ggplot2::fortify(object, raw_curves = raw_curves,
492		-	reduce_points = reduce_points)
	510	+	curve_df <- ggplot2::fortify(object,
	511	+	raw_curves = raw_curves,
	512	+	reduce_points = reduce_points
	513	+	)
493	514
494	515		func_plot <- function(ctype) {
495		-	.autoplot_single(object, curve_df, curvetype = ctype, type = type,
496		-	show_cb = show_cb, raw_curves = raw_curves,
497		-	reduce_points = reduce_points, show_legend = show_legend,
498		-	add_np_nn = add_np_nn)
	516	+	.autoplot_single(object, curve_df,
	517	+	curvetype = ctype, type = type,
	518	+	show_cb = show_cb, raw_curves = raw_curves,
	519	+	reduce_points = reduce_points, show_legend = show_legend,
	520	+	add_np_nn = add_np_nn
	521	+	)
499	522		}
500	523		lcurves <- lapply(curvetype, func_plot)
501	524		names(lcurves) <- curvetype
502	525
503	526		if (length(lcurves) > 1) {
504		-	do.call(.combine_plots, c(lcurves, show_legend = show_legend,
505		-	ret_grob = ret_grob, multiplot_lib = multiplot_lib,
506		-	nplots = length(lcurves)))
	527	+	do.call(.combine_plots, c(lcurves,
	528	+	show_legend = show_legend,
	529	+	ret_grob = ret_grob,
	530	+	multiplot_lib = multiplot_lib,
	531	+	nplots = length(lcurves)
	532	+	))
507	533		} else {
508	534		lcurves[[1]]
509	535		}

520	546		plots <- list(...)
521	547
522	548		g <- ggplot2::ggplotGrob(plots[[1]]
523		-	+ ggplot2::theme(legend.position = "bottom"))$grobs
	549	+	+ ggplot2::theme(legend.position = "bottom"))$grobs
524	550		legend <- g[[which(lapply(g, function(x) x$name) == "guide-box")]]
525	551		lheight <- sum(legend$height)
526	552

531	557		do.call(fncol, lapply(plots, fnolegend)),
532	558		legend,
533	559		heights = grid::unit.c(grid::unit(1, "npc") - lheight, lheight),
534		-	ncol = 1)
	560	+	ncol = 1
	561	+	)
535	562		}
536	563
537	564		#

574	601		if (show_legend) {
575	602		p <- p + patchwork::plot_layout(guides = "collect")
576	603		if (length(plotlist) > 2) {
577		-	p <- p + ggplot2::theme(legend.position = 'bottom')
	604	+	p <- p + ggplot2::theme(legend.position = "bottom")
578	605		}
579	606		}
580	607

594	621		}
595	622		if (multiplot_lib == "grid") {
596	623		.load_grid()
597		-	.load_gridExtra()
598		-	.combine_plots_grid(..., show_legend = show_legend, ret_grob = ret_grob, nplots = nplots)
	624	+	.load_gridextra()
	625	+	.combine_plots_grid(...,
	626	+	show_legend = show_legend,
	627	+	ret_grob = ret_grob, nplots = nplots
	628	+	)
599	629		}
600	630		}
601	631

606	636		show_cb = FALSE, raw_curves = FALSE,
607	637		reduce_points = TRUE, show_legend = FALSE,
608	638		add_np_nn = TRUE, ...) {
609		-
610		-	curve_df <- .prepare_autoplot(object, curve_df = curve_df,
611		-	curvetype = curvetype,
612		-	raw_curves = raw_curves,
613		-	reduce_points = reduce_points, ...)
	639	+	curve_df <- .prepare_autoplot(object,
	640	+	curve_df = curve_df,
	641	+	curvetype = curvetype,
	642	+	raw_curves = raw_curves,
	643	+	reduce_points = reduce_points, ...
	644	+	)
614	645
615	646		# === Create a ggplot object ===
	647	+	x_col <- rlang::sym("x")
	648	+	y_col <- rlang::sym("y")
	649	+	ymin_col <- rlang::sym("ymin")
	650	+	ymax_col <- rlang::sym("ymax")
	651	+	modname_col <- rlang::sym("modname")
	652	+	dsid_modname_col <- rlang::sym("dsid_modname")
616	653		if (show_cb) {
617		-	p <- ggplot2::ggplot(curve_df,
618		-	ggplot2::aes_string(x = 'x', y = 'y',
619		-	ymin = 'ymin', ymax = 'ymax'))
	654	+	p <- ggplot2::ggplot(
	655	+	curve_df,
	656	+	ggplot2::aes(
	657	+	x = !!x_col, y = !!y_col,
	658	+	ymin = !!ymin_col, ymax = !!ymax_col
	659	+	)
	660	+	)
620	661		if (type == "l") {
621		-	p <- p + ggplot2::geom_smooth(ggplot2::aes_string(color = 'modname'),
622		-	stat = "identity", na.rm = TRUE,
623		-	size = 0.5)
	662	+	p <- p + ggplot2::geom_smooth(ggplot2::aes(color = !!modname_col),
	663	+	stat = "identity", na.rm = TRUE,
	664	+	linewidth = 0.5
	665	+	)
624	666		} else if (type == "b" \|\| type == "p") {
625		-	p <- p + ggplot2::geom_ribbon(ggplot2::aes_string(ymin = 'ymin',
626		-	ymax = 'ymax',
627		-	group = 'modname'),
628		-	stat = "identity", alpha = 0.25,
629		-	fill = "grey25", na.rm = TRUE)
	667	+	p <- p + ggplot2::geom_ribbon(
	668	+	ggplot2::aes(
	669	+	ymin = !!ymin_col,
	670	+	ymax = !!ymax_col,
	671	+	group = !!modname_col
	672	+	),
	673	+	stat = "identity", alpha = 0.25,
	674	+	fill = "grey25", na.rm = TRUE
	675	+	)
630	676		if (type == "b") {
631		-	p <- p + ggplot2::geom_line(ggplot2::aes_string(color = 'modname'),
632		-	alpha = 0.25, na.rm = TRUE)
	677	+	p <- p + ggplot2::geom_line(ggplot2::aes(color = !!modname_col),
	678	+	alpha = 0.25, na.rm = TRUE
	679	+	)
633	680		}
634		-	p <- p + ggplot2::geom_point(ggplot2::aes_string(x = 'x', y = 'y',
635		-	color = 'modname'),
636		-	na.rm = TRUE)
	681	+	p <- p + ggplot2::geom_point(
	682	+	ggplot2::aes(
	683	+	x = !!x_col, y = !!y_col,
	684	+	color = !!modname_col
	685	+	),
	686	+	na.rm = TRUE
	687	+	)
637	688		}
638	689		} else if (raw_curves) {
639		-	p <- ggplot2::ggplot(curve_df,
640		-	ggplot2::aes_string(x = 'x', y = 'y',
641		-	group = 'dsid_modname',
642		-	color = 'modname'))
	690	+	p <- ggplot2::ggplot(
	691	+	curve_df,
	692	+	ggplot2::aes(
	693	+	x = !!x_col, y = !!y_col,
	694	+	group = !!dsid_modname_col,
	695	+	color = !!modname_col
	696	+	)
	697	+	)
643	698
644	699		if (type == "l") {
645	700		p <- p + ggplot2::geom_line(na.rm = TRUE)