R/type_conversions.R

In mbadge/AnalysisToolkitR: Objects and Functions for general data analysis

#' @include Classifiers-class.R
NULL

#' Find an operating point for a ClassifierCurve by sensitivity specification.
#'
#' @name as
#' @family ClassifierCurve
#'
#' @param classifier ClassifierCurve instance
#'
#' @return S4 ClassifierPoint instance
#'
#' @export
#' @examples \dontrun{
#'   as(ClassifierCurve(pY=rnorm(10), Y=runif(10, 0, 1) %>% round(0)), "ClassifierPoint")
#' }
setAs("ClassifierCurve", "ClassifierPoint",
      function(from) {
          #as.ClassifierPoint.ClassifierCurve <- function(Classifier, sens_thres=0.8) {

          # TPR == sensitivity, find the corresponding tpr from ROCR roc points
          preds <- ROCR::prediction(predictions=from@pY, labels=from@Y)
          perf <- preds %>% ROCR::performance("tpr", "fpr")
          tprs <- perf@y.values %>% unlist()

          i_thres <- Position(purrr::as_mapper(~ . >= 0.8), tprs)

          class_thres <- perf@alpha.values %>% unlist %>% `[`(i_thres)

          message('Sensitivity ', 0.8, ' reached with classification cutoff ',
                  sprintf("%.2f", class_thres), '\n')

          Y_ = from@pY > class_thres


          #! Add method to find operating point based on the prevalence
          ClassifierPoint(Y_ = Y_, Y = from@Y, id = from@id)
      }
)



# as.ClassifierCurve.train <- function(model) {
#     #stopifnot(class(model) == "train")
#     out_pred_df <- model$pred                  # out-of-sample predictions from all folds
#     train_dat <- model$trainingData %>% as.data.frame  # contains `case_seq`
#     demigod <- train_dat %>%
#         tibble::rownames_to_column(var="case_seq") %>%
#         tibble::rowid_to_column(var="rowIndex") %>%
#         dplyr::inner_join(out_pred_df, by="rowIndex")
#
#     pY <- select(demigod, case_seq, pY=true) %>%
#         tibble::deframe()
#     Y <- select(demigod, case_seq, Y=obs) %>%
#         tibble::deframe()
#     pred <- ROCR::prediction(predictions=pY, labels=Y)
#     new("ClassifierCurve", pY=pY, Y=Y, pred=pred)
# }