variable by buckets

buckets.R

function(model, data, factor_variable, top = 4, stat =  function(y) median(y, na.rm = T)) {
  library(productivus)
  if (is(model, 'tundraContainer')) {
    data <- model$munge(data)
    model <- model$output$model
  }
  stopifnot(is(model, 'gbm'))
  tbl <- names(table(data[[factor_variable]]))
  tops <- tbl[seq_len(min(top, length(tbl)))]
  ~{as.character(data[[factor_variable]])}
  data[[factor_variable]][!data[[factor_variable]] %in% tops] <- 'other'
  ~{as.factor(data[[factor_variable]])}

  library(gbm)
  vars <- head(summary(model)[, 1], 20, plotit = FALSE)
  vars <- intersect(vars, Filter(function(x) is.numeric(data[[x]]), colnames(data)))
  df <- data.frame(do.call(cbind, lapply(levels(data[[factor_variable]]), function(x) {
    sapply(vars, function(v) stat(data[data[[factor_variable]] == x, v]))
  })))
  colnames(df) <- levels(data[[factor_variable]])
  df$rownames <- row.names(df)
  df
}