lgb.interprete.R 5.8 KB
Newer Older
1
#' Compute feature contribution of prediction
2
#' 
3
#' Computes feature contribution components of rawscore prediction.
4
#' 
5
6
7
8
#' @param model object of class \code{lgb.Booster}.
#' @param data a matrix object or a dgCMatrix object.
#' @param idxset a integer vector of indices of rows needed.
#' @param num_iteration number of iteration want to predict with, NULL or <= 0 means use best iteration.
9
#' 
10
#' @return
11
#' 
12
13
14
15
16
17
#' For regression, binary classification and lambdarank model, a \code{list} of \code{data.table} with the following columns:
#' \itemize{
#'   \item \code{Feature} Feature names in the model.
#'   \item \code{Contribution} The total contribution of this feature's splits.
#' }
#' For multiclass classification, a \code{list} of \code{data.table} with the Feature column and Contribution columns to each class.
18
#' 
19
20
21
#' @examples
#' Sigmoid <- function(x) 1 / (1 + exp(-x))
#' Logit <- function(x) log(x / (1 - x))
22
#' data(agaricus.train, package = "lightgbm")
23
24
25
#' train <- agaricus.train
#' dtrain <- lgb.Dataset(train$data, label = train$label)
#' setinfo(dtrain, "init_score", rep(Logit(mean(train$label)), length(train$label)))
26
#' data(agaricus.test, package = "lightgbm")
27
#' test <- agaricus.test
28
29
30
31
32
33
34
35
36
#' 
#' 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
#' )
37
#' model <- lgb.train(params, dtrain, 20)
38
#' 
39
#' tree_interpretation <- lgb.interprete(model, test$data, 1:5)
40
#' 
41
42
#' @importFrom magrittr %>% %T>%
#' @export
43
44
45
46
47
48
lgb.interprete <- function(model,
                           data,
                           idxset,
                           num_iteration = NULL) {
  
  # Get tree model
49
  tree_dt <- lgb.model.dt.tree(model, num_iteration)
50
51
  
  # Check number of classes
52
  num_class <- model$.__enclos_env__$private$num_class
53
54
  
  # Get vector list
55
  tree_interpretation_dt_list <- vector(mode = "list", length = length(idxset))
56
57
  
  # Get parsed predictions of data
58
59
60
61
62
63
  leaf_index_mat_list <- model$predict(data[idxset, , drop = FALSE],
                                       num_iteration = num_iteration,
                                       predleaf = TRUE) %>%
    t(.) %>%
    data.table::as.data.table(.) %>%
    lapply(., FUN = function(x) matrix(x, ncol = num_class, byrow = TRUE))
64
65
  
  # Get list of trees
66
67
  tree_index_mat_list <- lapply(leaf_index_mat_list,
                                FUN = function(x) matrix(seq_len(length(x)) - 1, ncol = num_class, byrow = TRUE))
68
69
  
  # Sequence over idxset
70
71
72
  for (i in seq_along(idxset)) {
    tree_interpretation_dt_list[[i]] <- single.row.interprete(tree_dt, num_class, tree_index_mat_list[[i]], leaf_index_mat_list[[i]])
  }
73
74
  
  # Return interpretation list
75
  return(tree_interpretation_dt_list)
76
  
77
78
}

79
80
81
82
83
single.tree.interprete <- function(tree_dt,
                                   tree_id,
                                   leaf_id) {
  
  # Match tree id
84
  single_tree_dt <- tree_dt[tree_index == tree_id, ]
85
86
  
  # Get leaves
87
  leaf_dt <- single_tree_dt[leaf_index == leaf_id, .(leaf_index, leaf_parent, leaf_value)]
88
89
  
  # Get nodes
90
  node_dt <- single_tree_dt[!is.na(split_index), .(split_index, split_feature, node_parent, internal_value)]
91
92
  
  # Prepare sequences
93
94
  feature_seq <- character(0)
  value_seq <- numeric(0)
95
96
  
  # Get to root from leaf
97
  leaf_to_root <- function(parent_id, current_value) {
98
99
    
    # Store value
100
    value_seq <<- c(current_value, value_seq)
101
102
    
    # Check for null parent id
103
    if (!is.na(parent_id)) {
104
105
      
      # Not null means existing node
106
107
108
      this_node <- node_dt[split_index == parent_id, ]
      feature_seq <<- c(this_node[["split_feature"]], feature_seq)
      leaf_to_root(this_node[["node_parent"]], this_node[["internal_value"]])
109
      
110
    }
111
    
112
  }
113
114
  
  # Perform leaf to root conversion
115
  leaf_to_root(leaf_dt[["leaf_parent"]], leaf_dt[["leaf_value"]])
116
117
  
  # Return formatted data.table
118
  data.table::data.table(Feature = feature_seq, Contribution = diff.default(value_seq))
119
  
120
121
}

122
123
124
125
126
multiple.tree.interprete <- function(tree_dt,
                                     tree_index,
                                     leaf_index) {
  
  # Apply each trees
127
128
129
130
131
132
133
  mapply(single.tree.interprete,
         tree_id = tree_index, leaf_id = leaf_index,
         MoreArgs = list(tree_dt = tree_dt),
         SIMPLIFY = FALSE, USE.NAMES = TRUE) %>%
    data.table::rbindlist(., use.names = TRUE) %>%
    magrittr::extract(., j = .(Contribution = sum(Contribution)), by = "Feature") %>%
    magrittr::extract(., i = order(abs(Contribution), decreasing = TRUE))
134
  
135
136
137
}

single.row.interprete <- function(tree_dt, num_class, tree_index_mat, leaf_index_mat) {
138
139
  
  # Prepare vector list
140
  tree_interpretation <- vector(mode = "list", length = num_class)
141
142
  
  # Loop throughout each class
143
  for (i in seq_len(num_class)) {
144
145
146
147
    
    tree_interpretation[[i]] <- multiple.tree.interprete(tree_dt, tree_index_mat[,i], leaf_index_mat[,i]) %T>% {
      
      # Number of classes larger than 1 requires adjustment
148
149
150
151
      if (num_class > 1) {
        data.table::setnames(., old = "Contribution", new = paste("Class", i - 1))
      }
    }
152
    
153
  }
154
155
  
  # Check for numbe rof classes larger than 1
156
  if (num_class == 1) {
157
158
    
    # First interpretation element
159
    tree_interpretation_dt <- tree_interpretation[[1]]
160
    
161
  } else {
162
163
    
    # Full interpretation elements
164
165
    tree_interpretation_dt <- Reduce(f = function(x, y) merge(x, y, by = "Feature", all = TRUE),
                                     x = tree_interpretation)
166
167
    
    # Loop throughout each tree
168
    for (j in 2:ncol(tree_interpretation_dt)) {
169
      
170
171
172
173
      data.table::set(tree_interpretation_dt,
                      i = which(is.na(tree_interpretation_dt[[j]])),
                      j = j,
                      value = 0)
174
      
175
    }
176
    
177
  }
178
179
  
  # Return interpretation tree
180
181
  return(tree_interpretation_dt)
}