Add Feature Contribution Plot (#330)

R-package/NAMESPACE

@@ -22,6 +22,7 @@ export(lgb.interprete)
 export(lgb.load)
 export(lgb.model.dt.tree)
 export(lgb.plot.importance)
+export(lgb.plot.interpretation)
 export(lgb.save)
 export(lgb.train)
 export(lightgbm)

R-package/R/lgb.plot.importance.R

@@ -44,7 +44,7 @@ lgb.plot.importance <- function(tree_imp, top_n = 10, measure = "Gain", left_mar
   on.exit(par(op))
   par(mar = op$mar %>% magrittr::inset(., 2, left_margin))
   tree_imp[.N:1,
-           barplot(height = get(measure), names.arg = Feature, horiz = TRUE,
+           barplot(height = get(measure), names.arg = Feature, horiz = TRUE, border = NA,
                    main = "Feature Importance", xlab = measure, cex.names = cex, las = 1)]
   invisible(tree_imp)
 }

R-package/R/lgb.plot.interpretation.R

@@ -0,0 +1,69 @@
+#' Plot feature contribution as a bar graph
+#'
+#' Plot previously calculated feature contribution as a bar graph.
+#'
+#' @param tree_interpretation_dt a \code{data.table} returned by \code{\link{lgb.interprete}}.
+#' @param top_n maximal number of top features to include into the plot.
+#' @param cols the column numbers of layout, will be used only for multiclass classification feature contribution.
+#' @param left_margin (base R barplot) allows to adjust the left margin size to fit feature names.
+#' @param cex (base R barplot) passed as \code{cex.names} parameter to \code{barplot}.
+#'
+#' @details
+#' The graph represents each feature as a horizontal bar of length proportional to the defined contribution of a feature.
+#' Features are shown ranked in a decreasing contribution order.
+#'
+#' @return
+#' The \code{lgb.plot.interpretation} function creates a \code{barplot}
+#'
+#' @examples
+#'
+#' Sigmoid <- function(x) 1 / (1 + exp(-x))
+#' Logit <- function(x) log(x / (1 - x))
+#' data(agaricus.train, package = 'lightgbm')
+#' train <- agaricus.train
+#' dtrain <- lgb.Dataset(train$data, label = train$label)
+#' setinfo(dtrain, "init_score", rep(Logit(mean(train$label)), length(train$label)))
+#' data(agaricus.test, package = 'lightgbm')
+#' test <- agaricus.test
+#'
+#' params = list(objective = "binary",
+#'               learning_rate = 0.01, num_leaves = 63, max_depth = -1,
+#'               min_data_in_leaf = 1, min_sum_hessian_in_leaf = 1)
+#'               model <- lgb.train(params, dtrain, 20)
+#' model <- lgb.train(params, dtrain, 20)
+#'
+#' tree_interpretation <- lgb.interprete(model, test$data, 1:5)
+#' lgb.plot.interpretation(tree_interpretation[[1]], top_n = 10)
+#'
+#' @export
+
+lgb.plot.interpretation <- function(tree_interpretation_dt, top_n = 10, cols = 1, left_margin = 10, cex = NULL) {
+  num_class <- ncol(tree_interpretation_dt) - 1
+  op <- par(no.readonly = TRUE)
+  on.exit(par(op))
+  par(mar = op$mar %>% magrittr::inset(., 1:3, c(3, left_margin, 2)))
+  if (num_class == 1) {
+    multiple.tree.plot.interpretation(tree_interpretation_dt, top_n = top_n, title = NULL, cex = cex)
+  } else {
+    layout_mat <- matrix(seq(1, cols * ceiling(num_class / cols)),
+                         ncol = cols, nrow = ceiling(num_class / cols))
+    par(mfcol = c(nrow(layout_mat), ncol(layout_mat)))
+    for (i in seq_len(num_class)) {
+      tree_interpretation_dt[, c(1, i + 1), with = FALSE] %T>%
+        data.table::setnames(., old = names(.), new = c("Feature", "Contribution")) %>%
+        multiple.tree.plot.interpretation(., top_n = top_n, title = paste("Class", i - 1), cex = cex)
+    }
+  }
+}
+
+multiple.tree.plot.interpretation <- function(tree_interpretation, top_n, title, cex) {
+  tree_interpretation <- tree_interpretation[order(abs(Contribution), decreasing = TRUE),][1:min(top_n, .N),]
+  if (is.null(cex)) {
+    cex <- 2.5 / log2(1 + top_n)
+  }
+  tree_interpretation[.N:1,
+                      barplot(height = Contribution, names.arg = Feature, horiz = TRUE,
+                              col = ifelse(Contribution > 0, "firebrick", "steelblue"),
+                              border = NA, main = title, cex.names = cex, las = 1)]
+  invisible(NULL)
+}