R/metric_confusion_matrix.R

In gloverd2/admr: Contains standard functions for Admiral Advance Analytics

#' metric_confusion_matrix
#' @description
#' Returns a confusion matrix showing true(/false) positives(/negatives)
#' Note: Predictions should be annualized (independent of exposure)
#'
#'
#' @section Inputs:
#' @template param-metric_classification
#'
#' @return confusion matrix for the classification. Col names are \code{c("actual.1", "actual.0")} and Row names are c("predicted.1", "predicted.0")
#' @export
#'
#' @examples
#'
#' metric_confusion_matrix(actual=c(0,1,0,0), predicted=c(0.1,0.9,0.4,0.6))
#'
metric_confusion_matrix <- function(actual, predicted, weight=NULL, na.rm=FALSE, threshold=0.5){

  # Error catching
  metric_error_checking_classification(actual, predicted, weight, na.rm, threshold)

  # Use no weighting if none given
  if (is.null(weight)){weight <- rep(1, length(actual))}

  # If na.rm==FALSE and there are any NAs return Na
  if (na.rm==FALSE & any(c(is.na(actual), is.na(predicted), is.na(weight)))){
    confusion_mat <- matrix(data=NA, ncol=2, nrow=2)
    colnames(confusion_mat) <- c("actual.1", "actual.0")
    rownames(confusion_mat) <- c("predicted.1", "predicted.0")
    return(confusion_mat)
  }

  # Create empty confusion matrix with correct col and row names
  confusion_mat <- matrix(data=0, ncol=2, nrow=2)
  colnames(confusion_mat) <- c("actual.1", "actual.0")
  rownames(confusion_mat) <- c("predicted.1", "predicted.0")

  # loop over every observation
  for (ii in 1:length(actual)){

    #Skip any observations with NAs
    if (is.na(actual[ii]) | is.na(predicted[ii]) | is.na(weight[ii])){next}

    # Error checking already done
    if (actual[ii]==0){act_lab="actual.0"}
    else{act_lab="actual.1"}

    # Error checking already done
    if (predicted[ii] < threshold){pred_lab="predicted.0"}
    else{pred_lab="predicted.1"}

    # Increment correct field
    confusion_mat[pred_lab, act_lab] <- (confusion_mat[pred_lab, act_lab] + weight[ii])
  }

  return(confusion_mat)

}