Hendrik/xgboost
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Take gain into account to discover most important variables

Browse Source
This commit is contained in:
El Potaeto 2014-12-29 23:57:41 +01:00
parent dba1ce7050
commit 263f7fa69d
1 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
R-package/R/xgb.importance.R
View File

@ -8,34 +8,35 @@
#' @importFrom data.table data.table #' @importFrom data.table data.table
#' @importFrom magrittr %>% #' @importFrom magrittr %>%
#' @importFrom data.table := #' @importFrom data.table :=
#' @param feature_names names of each feature as a character vector. Can be extracted from a sparse matrix. #' @importFrom stringr str_extract
#' @param filename_dump the name of the text file. #' @param feature_names names of each feature as a character vector. Can be extracted from a sparse matrix (see example). If model dump already contains feature names, this argument should be \code{NULL}.
#' @param filename_dump the path to the text file storing the model.
#' #'
#' @examples #' @examples
#' data(agaricus.train, package='xgboost') #' data(agaricus.train, package='xgboost')
#' data(agaricus.test, package='xgboost') #' data(agaricus.test, package='xgboost')
#' #'
#' #Both dataset are list with two items, a sparse matrix and labels (outcome column which will be learned). #' #Both dataset are list with two items, a sparse matrix and labels (labels = outcome column which will be learned).
#' #Each column of the sparse Matrix is a feature in one hot encoding format. #' #Each column of the sparse Matrix is a feature in one hot encoding format.
#' train <- agaricus.train #' train <- agaricus.train
#' test <- agaricus.test #' test <- agaricus.test
#' #'
#' bst <- xgboost(data = train$data, label = train$label, max.depth = 2, #' bst <- xgboost(data = train$data, label = train$label, max.depth = 2,
#' eta = 1, nround = 2,objective = "binary:logistic") #' eta = 1, nround = 2,objective = "binary:logistic")
#' xgb.dump(bst, 'xgb.model.dump') #' xgb.dump(bst, 'xgb.model.dump', with.stats = T)
#' #'
#' #agaricus.test$data@@Dimnames[[2]] represents the column name of the sparse matrix. #' #agaricus.test$data@@Dimnames[[2]] represents the column names of the sparse matrix.
#' xgb.importance(agaricus.test$data@@Dimnames[[2]], 'xgb.model.dump') #' xgb.importance(agaricus.test$data@@Dimnames[[2]], 'xgb.model.dump')
#' #'
#' @export #' @export
xgb.importance <- function(feature_names, filename_dump){ xgb.importance <- function(feature_names = NULL, filename_dump = NULL){
if (class(feature_names) != "character") { if (!class(feature_names) %in% c("character", "NULL")) {
stop("feature_names: Has to be a vector of character. See help to see where to get it.") stop("feature_names: Has to be a vector of character or NULL if model dump already contain feature name. See help to see where to get it.")
} }
if (class(filename_dump) != "character" & file.exists(filename_dump)) { if (class(filename_dump) != "character" & file.exists(filename_dump)) {
stop("filename_dump: Has to be a path to the model dump file.") stop("filename_dump: Has to be a path to the model dump file.")
} }
text <- readLines(filename_dump) text <- readLines(filename_dump)
if(text[2] == "bias:"){ if(text[2] == "bias:"){
result <- linearDump(feature_names, text) result <- linearDump(feature_names, text)
} else { } else {
@ -44,17 +45,21 @@ xgb.importance <- function(feature_names, filename_dump){
result result
} }
treeDump <- function(feature_names, text){ treeDump <- function(feature_names, text){
result <- c() featureVec <- c()
gainVec <- c()
for(line in text){ for(line in text){
p <- regexec("\\[f.*\\]", line) %>% regmatches(line, .) p <- str_extract(line, "\\[f.*<")
if (length(p[[1]]) > 0) { if (!is.na(p)) {
splits <- sub("\\[f", "", p[[1]]) %>% sub("\\]", "", .) %>% strsplit("<") %>% .[[1]] %>% as.numeric featureVec <- substr(p, 3, nchar(p)-1) %>% c(featureVec)
result <- c(result, feature_names[splits[1]+ 1]) gainVec <- str_extract(line, "gain.*,") %>% substr(x = ., 6, nchar(.)-1) %>% as.numeric %>% c(gainVec)
} }
} }
if(!is.null(feature_names)) {
featureVec %<>% as.numeric %>% {c =.+1; feature_names[c]} #+1 because in R indexing start with 1 instead of 0.
}
#1. Reduce, 2. %, 3. reorder - bigger top, 4. remove temp col #1. Reduce, 2. %, 3. reorder - bigger top, 4. remove temp col
data.table(Feature = result)[,.N, by = Feature][, Weight:= N /sum(N)][order(-rank(Weight))][,-2,with=F] data.table(Feature = featureVec, Weight = gainVec)[,sum(Weight), by = Feature][, Weight:= V1 /sum(V1)][order(-rank(Weight))][,-2,with=F]
} }
linearDump <- function(feature_names, text){ linearDump <- function(feature_names, text){