R/select_stat_cols.R

Defines functions select_stat_cols

Documented in select_stat_cols

#' Helper function to select only the relevant columns for statistical testing
#'
#' @import dplyr
#'
#' @param data \code{data.frame} of classification accuracy results
#' @param by_set \code{Boolean} specifying whether you want to compare feature sets (if \code{TRUE}) or individual features (if \code{FALSE}).
#' @param hypothesis \code{character} denoting whether p-values should be calculated for each feature set or feature (depending on \code{by_set} argument) individually relative to the null if \code{use_null = TRUE} in \code{tsfeature_classifier} through \code{"null"}, or whether pairwise comparisons between each set or feature should be conducted on main model fits only through \code{"pairwise"}.
#' @param metric \code{character} denoting the classification performance metric to use in statistical testing. Can be one of \code{"accuracy"}, \code{"precision"}, \code{"recall"}, \code{"f1"}. Defaults to \code{"accuracy"}
#' @returns object of class \code{data.frame}
#' @author Trent Henderson
#'

select_stat_cols <- function(data, by_set, metric, hypothesis){

  if(hypothesis == "null"){
    if(by_set){
      if(metric == "accuracy"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$feature_set, .data$accuracy)) %>% dplyr::rename(mymetric = .data$accuracy)
      } else if(metric == "precision"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$feature_set, .data$mean_precision)) %>% dplyr::rename(mymetric = .data$mean_precision)
      } else if(metric == "recall"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$feature_set, .data$mean_recall)) %>% dplyr::rename(mymetric = .data$mean_recall)
      } else{
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$feature_set, .data$mean_f1_score)) %>% dplyr::rename(mymetric = .data$mean_recall)
      }
    } else{
      if(metric == "accuracy"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$names, .data$accuracy)) %>% dplyr::rename(mymetric = .data$accuracy)
      } else if(metric == "precision"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$names, .data$mean_precision)) %>% dplyr::rename(mymetric = .data$mean_precision)
      } else if(metric == "recall"){
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$names, .data$mean_recall)) %>% dplyr::rename(mymetric = .data$mean_recall)
      } else{
        tmp <- data %>% dplyr::select(c(.data$model_type, .data$names, .data$mean_f1_score)) %>% dplyr::rename(mymetric = .data$mean_f1_score)
      }
    }
  } else{
    if(by_set){
      if(metric == "accuracy"){
        tmp <- data %>% dplyr::select(c(.data$feature_set, .data$accuracy)) %>% dplyr::rename(mymetric = .data$accuracy)
      } else if(metric == "precision"){
        tmp <- data %>% dplyr::select(c(.data$feature_set, .data$mean_precision)) %>% dplyr::rename(mymetric = .data$mean_precision)
      } else if(metric == "recall"){
        tmp <- data %>% dplyr::select(c(.data$feature_set, .data$mean_recall)) %>% dplyr::rename(mymetric = .data$mean_recall)
      } else{
        tmp <- data %>% dplyr::select(c(.data$feature_set, .data$mean_f1_score)) %>% dplyr::rename(mymetric = .data$mean_f1_score)
      }
    } else{
      if(metric == "accuracy"){
        tmp <- data %>% dplyr::select(c(.data$names, .data$accuracy)) %>% dplyr::rename(mymetric = .data$accuracy)
      } else if(metric == "precision"){
        tmp <- data %>% dplyr::select(c(.data$names, .data$mean_precision)) %>% dplyr::rename(mymetric = .data$mean_precision)
      } else if(metric == "recall"){
        tmp <- data %>% dplyr::select(c(.data$names, .data$mean_recall)) %>% dplyr::rename(mymetric = .data$mean_recall)
      } else{
        tmp <- data %>% dplyr::select(c(.data$names, .data$mean_f1_score)) %>% dplyr::rename(mymetric = .data$mean_f1_score)
      }
    }
  }

  return(tmp)
}

Try the theftdlc package in your browser

Any scripts or data that you put into this service are public.

theftdlc documentation built on Aug. 8, 2025, 6:30 p.m.