Binning Columns in Remote Tables: make case when

.make_case_when_fn.R

.make_case_when_fn <- function(column_name, cut_vector){
    # get names in various formats
    s_column_name     <- rlang::sym(column_name)

    # the vector shouldn't have names, but if it has them, use those names instead of the
    # canned ones then NULL out the names
    if (!is.null(names(cut_vector))){
        cut_names <- names(cut_vector)
        cut_vector <- unname(cut_vector)
    } else {
        cut_names <- cut_vector
    }

    # construct the object case_when needs to work
    case_expr <- lapply(c(0, seq_along(cut_vector)), function(i){
        if (i == 0){
            lab <- sprintf('%s', cut_names[i+1]) # a label
            rlang::expr(!!s_column_name <= cut_vector[!!i+1] ~ !!lab) # the expression
        } else if (i == length(cut_vector)) {
            lab <- sprintf('>max', cut_names[i])
            rlang::expr(!!s_column_name > cut_vector[!!i] ~ !!lab)
        } else {
            lab <- sprintf('%s', cut_names[i+1])
            rlang::expr(!!s_column_name > cut_vector[!!i] & !!s_column_name <= cut_vector[!!i+1] ~ !!lab)
        }
    })

    # return the function
    return(function(data){
        dplyr::compute(dplyr::mutate(data, cut_ := dplyr::case_when(!!!case_expr)))
    })
}