R/Classifiers-class.R

#' Classifier Abstract Base Class.
#'
#' @name Classifier
#'
#' @slot Y logical or binary integer. the true labels.
#' @slot id character. Image IDs corresponding to the true labels.
#'
#' @export
#' @family classifiers
setClass("Classifier",  # Abstract Base Class for a Continuous or Discrete Binary Classifier
         slots = list(Y = "logical",
                      id = "character"))


setClass("ClassifierCurve",
         contains = "Classifier",
         slots = list(pY = "numeric"))
#' A classifier that computes positive class probability
#'
#' Prediction object not included here because the objects become hard to inspect.
#' All Y labels must be present; if Y_ contains NAs,
#' they will be removed, along with the associated Y.
#'
#' @slot pY numeric. predicted proabability of positive class.
#' @slot id labels. must be coercible to character.
#' @inheritParams Classifier
#'
#' @return newly instantiated ClassifierCurve obj
#' @export
#' @examples
#' ClassifierCurve(pY=rnorm(10), Y=runif(10, 0, 1) > 0.5)  # Using logical Y
#' ClassifierCurve(pY=rnorm(10), Y=runif(10, 0, 1) %>% round(0))  # Using integer
#' ClassifierCurve(pY=c(NA, rnorm(10)), Y=c(1, runif(10, 0, 1)) %>% round(0))
ClassifierCurve <- function(pY, Y, id=NULL) {
    stopifnot(length(pY) == length(Y))
    if (is.null(id)) {id=1:length(Y)}  # default ids
    # coerce binary integers to logicals
    if (is.numeric(Y) && `==`(dplyr::n_distinct(Y), 2) && `==`(max(Y), 1) && `==`(min(Y), 0)) {
        Y <- `==`(Y, 0)
    }


    stopifnot(all(compose(`!`, is.na)(Y)))
    # Remove entries with missing values
    missing_idx <- which(is.na(pY))
    if (!is_empty(missing_idx)) {
        warning(str_c(length(missing_idx),
                      " missing values found in pY. Removing these,",
                      " and their corresponding Y values."))
        pY <- pY[-missing_idx]
        Y <- Y[-missing_idx]
        id <- id[-missing_idx]
    }

    new("ClassifierCurve", pY = pY, Y = Y, id=as.character(id))
}



setClass("ClassifierPoint",
         contains = "Classifier",
         slots = list(Y_ = "logical"))
#' Binary Classifier.
#'
#' @slot Y_ logical.
#'
#' @export
#' @examples
#' \dontrun{
#' ClassifierPoint(Y_=rnorm(10) > 0.5, Y=rnorm(10) > 0.5)
#' }
ClassifierPoint <- function(Y_, Y, id){
    if (missing(id)) {id=as.character(1:length(Y))}
    new("ClassifierPoint", Y_ = Y_, Y = Y, id=id)
}
mbadge/AnalysisToolkitR documentation built on May 27, 2019, 1:08 p.m.