R/convex_accept.R

Defines functions convex_accept

#' @importFrom stringr str_locate
convex_accept <- function(param_values, target_values, candidate_param, patience = 1){
  
  if(length(param_values) != length(target_values)){
    stop('Length of param_values and target_values are different')
  }
  
  
  if(length(param_values) <= 1){
    return(TRUE)
  }

  param_order <- order(param_values)
  
  param_values <- param_values[param_order]
  target_values <- target_values[param_order]
  
  s <- ''
  
  for(i in 2:length(param_values)){
    if(target_values[i] <= target_values[i-1]){
      s <- paste0(s, '-')
    }else{
      s <- paste0(s, '+')
    }
  }
  
  s <- paste0('-', s, '+')
  param_values <- c(-Inf, param_values, +Inf)
  
  idx <- str_locate(s, paste(rep("\\+", patience), collapse=""))[1]
  
  #c(param_values[idx - 1], param_values[idx + 1])
  candidate_param > param_values[idx - 1] && candidate_param < param_values[idx + 1]
}
artichaud1/tidytune documentation built on May 20, 2019, 9:13 p.m.