R/multi_convex_accept.R

In artichaud1/cook: A package for Tidy Hyperparameter Tuning

#' Accept/reject parameters based on univariate convexity assumption.
#' @description This function can be used to speed up parameter tuning when it is reasonable
#' to assume that the loss function is convex with respect to it's parameters, taken one at a time.
#' @details Most machine learning algorithms have parameter(s) that control complexity, e.g. number
#' of layers and number of hidden nodes for a neural network, max_depth for boosted trees, etc.
#' Usually, the loss function is convex with respect to these parameters, i.e. given all the other
#' parameters, it first decreases as the complexity parameter is increased, reaches a minimum, then
#' starts increasing. 
#'     This function avoids exploring areas of the parameters beyond the 
#' minimum of the function. 
#' @param params_df Combinations of parameters previously encountered.
#' @param scores Corresponding score values previously encountered.
#' @param candidate_param New parameter combination to accept/reject.
#' @param convex_params Names of the parameters with regards to which the loss function 
#' should be considered convex. If NULL, will choose all numeric params.
#' @param patience After how many increases in target value should we reject a parameter value ?
#' @export
#' @importFrom purrr map_lgl 
#' @examples 
#' library(dplyr)
#' 
#' optim_path_df <- 
#'   tribble(
#'     ~x1, ~x2, ~y,
#'       4,   1, 10,
#'       4,   2, 9 ,
#'       4,   3, 8 ,
#'       4,   4, 8.5,
#'       5,   1, 11,
#'       5,   2, 10,
#'       5,   3, 7
#'   )
#' 
#' 
#' target_var <- 'y'
#' 
#' candidate_param <- c(x1 = 6, x2 = 2)
#' 
#' multi_convex_accept(optim_path_df, target_var, candidate_param)

multi_convex_accept <- function(params_df, 
                                scores, 
                                candidate_param,
                                convex_params = NULL,
                                patience = 1){
  
  if(is.null(params_df)){
    return(TRUE)
  }
  
  if(is.null(convex_params)){
    convex_params <- names(params_df)[map_lgl(names(params_df), 
                                                  ~ is.numeric(params_df[[.]]))]
  }
  
  accept <- TRUE
  
  for(param_name in convex_params){
    neighbors_idx <- find_neighbors_idx(params_df, candidate_param, param_name)
    
    if(length(neighbors_idx) > 0){
      neighbors_df <- params_df[neighbors_idx, ]
      param_values <- neighbors_df[[param_name]]
      target_values <- scores[neighbors_idx]
      accept <- accept && convex_accept(param_values, 
                                        target_values, 
                                        candidate_param[[param_name]],
                                        patience = patience)  
    }
  
    if(!accept) break
  }
  
  accept
}