R/predict_precision_recall.R

In neurogenomics/EpiCompare: Comparison, Benchmarking & QC of Epigenomic Datasets

#' Predict precision-recall
#' 
#' Predict specific values of precision or recall by fitting a model to
#' a precision-recall curve. 
#' Predictions that are <0 will automatically be set to 0.
#' Predictions that are >100 will automatically be set to 100.
#' @param pr_df Precision-recall data.frame generated by 
#' \link[EpiCompare]{precision_recall}.
#' @param fun Function to fit the data with.
#' @param precision Precision values to predict recall from.
#' @param recall Recall values to predict precision from. 
#' @returns A named list of fitted models and predictions.
#' @source \href{https://stackoverflow.com/a/27796497}{
#' Fix for producing NAs from loess fun.}
#' 
#' @export
#' @importFrom data.table rbindlist
#' @examples 
#' data("CnR_H3K27ac")
#' data("CnT_H3K27ac")
#' data("encode_H3K27ac")
#' peakfiles <- list(CnR_H3K27ac=CnR_H3K27ac, CnT_H3K27ac=CnT_H3K27ac)
#' reference <- list("encode_H3K27ac" = encode_H3K27ac)
#' pr_df <- precision_recall(peakfiles = peakfiles,
#'                           reference = reference)
#' predictions <- predict_precision_recall(pr_df = pr_df)           
predict_precision_recall <- function(pr_df,
                                     fun=stats::loess,
                                     precision=seq(10,100,10),
                                     recall=seq(10,100,10)){
    # devoptera::args2vars(EpiCompare::predict_precision_recall) 
    
    peaklist1 <- peaklist2 <- NULL;
    
     res <- lapply(stats::setNames(unique(pr_df$peaklist1),
                                   unique(pr_df$peaklist1)),
                   function(p1){ 
         messager("Making predictions for peaklist1:",p1)
         lapply(stats::setNames(unique(pr_df$peaklist2),
                                unique(pr_df$peaklist2)),
                function(p2){ 
             messager("Making predictions for peaklist2:",p2)
             pr_sub <- pr_df[peaklist1==p1 & peaklist2==p2,]
             data.table::rbindlist(
                 #### Predict recall from precision ####
                list(
                    predict_values(df = pr_sub,
                                   fun = fun,
                                   values = precision, 
                                   input_var = "precision", 
                                   predicted_var = "recall"),
                    
                    #### Predict precision from recall  ####
                    predict_values(df = pr_sub, 
                                   fun = fun,
                                   values = recall, 
                                   input_var = "recall", 
                                   predicted_var = "precision")
                )
            )
         }) |> data.table::rbindlist(use.names = TRUE, idcol = "peaklist2") 
     }) |> data.table::rbindlist(use.names = TRUE, idcol = "peaklist1")
    #### Return ####
    return(res)
}