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

Add stat indicators in plot

Browse Source
This commit is contained in:
El Potaeto 2015-01-06 18:18:55 +01:00
parent 94d070da60
commit 3dd202a19e
2 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
R-package/NAMESPACE
View File

@ -20,6 +20,7 @@ importClassesFrom(Matrix,dgeMatrix)
importFrom(DiagrammeR,DiagrammeR) importFrom(DiagrammeR,DiagrammeR)
importFrom(data.table,":=") importFrom(data.table,":=")
importFrom(data.table,as.data.table) importFrom(data.table,as.data.table)
importFrom(data.table,copy)
importFrom(data.table,data.table) importFrom(data.table,data.table)
importFrom(data.table,rbindlist) importFrom(data.table,rbindlist)
importFrom(data.table,set) importFrom(data.table,set)

11
R-package/R/xgb.plot.tree.R
View File

@ -6,10 +6,11 @@
#' @importFrom data.table data.table #' @importFrom data.table data.table
#' @importFrom data.table set #' @importFrom data.table set
#' @importFrom data.table rbindlist #' @importFrom data.table rbindlist
#' @importFrom data.table :=
#' @importFrom data.table copy
#' @importFrom magrittr %>% #' @importFrom magrittr %>%
#' @importFrom magrittr not #' @importFrom magrittr not
#' @importFrom magrittr add #' @importFrom magrittr add
#' @importFrom data.table :=
#' @importFrom stringr str_extract #' @importFrom stringr str_extract
#' @importFrom stringr str_split #' @importFrom stringr str_split
#' @importFrom stringr str_extract #' @importFrom stringr str_extract
@ -93,10 +94,11 @@ xgb.plot.tree <- function(feature_names = NULL, filename_dump = NULL, n_first_tr
coverLeaf <- extract(leaf, "cover=\\d*\\.*\\d*") coverLeaf <- extract(leaf, "cover=\\d*\\.*\\d*")
dt <- data.table(ID = c(idBranch, idLeaf), Feature = c(featureBranch, featureLeaf), Split = c(splitBranch, splitLeaf), Yes = c(yesBranch, yesLeaf), No = c(noBranch, noLeaf), Missing = c(missingBranch, missingLeaf), Quality = c(qualityBranch, qualityLeaf), Cover = c(coverBranch, coverLeaf))[order(ID)][,Tree:=i] dt <- data.table(ID = c(idBranch, idLeaf), Feature = c(featureBranch, featureLeaf), Split = c(splitBranch, splitLeaf), Yes = c(yesBranch, yesLeaf), No = c(noBranch, noLeaf), Missing = c(missingBranch, missingLeaf), Quality = c(qualityBranch, qualityLeaf), Cover = c(coverBranch, coverLeaf))[order(ID)][,Tree:=i]
set(dt, i = which(dt[,Feature]!= "Leaf"), j = "YesFeature", value = dt[ID == dt[,Yes], Feature]) set(dt, i = which(dt[,Feature]!= "Leaf"), j = "YesFeature", value = merge(copy(dt)[,ID:=Yes][, .(ID)], dt[,.(ID, Feature, Quality, Cover)], by = "ID")[,paste(Feature, "<br/>Cover: ", Cover, sep = "")])
set(dt, i = which(dt[,Feature]!= "Leaf"), j = "NoFeature", value = dt[ID == dt[,No], Feature])
dt[Feature!="Leaf" ,yesPath:= paste(ID,"[", Feature, "]-->|< ", Split, "|", Yes, "[", YesFeature, "]", sep = "")] set(dt, i = which(dt[,Feature]!= "Leaf"), j = "NoFeature", value = merge(copy(dt)[,ID:=No][, .(ID)], dt[,.(ID, Feature, Quality, Cover)], by = "ID")[,paste(Feature, "<br/>Cover: ", Cover, sep = "")])
dt[Feature!="Leaf" ,yesPath:= paste(ID,"[", Feature, "<br/>Cover: ", Cover, "<br/>Gain: ", Quality, "]-->|< ", Split, "|", Yes, "[", YesFeature, "]", sep = "")]
dt[Feature!="Leaf" ,noPath:= paste(ID,"[", Feature, "]-->|>= ", Split, "|", No, "[", NoFeature, "]", sep = "")] dt[Feature!="Leaf" ,noPath:= paste(ID,"[", Feature, "]-->|>= ", Split, "|", No, "[", NoFeature, "]", sep = "")]
@ -112,6 +114,5 @@ xgb.plot.tree <- function(feature_names = NULL, filename_dump = NULL, n_first_tr
no <- allTrees[Feature!="Leaf", c(No)] %>% paste(collapse = ",") %>% paste("class ", ., " redNode", sep = "") no <- allTrees[Feature!="Leaf", c(No)] %>% paste(collapse = ",") %>% paste("class ", ., " redNode", sep = "")
path <- allTrees[Feature!="Leaf", c(yesPath, noPath)] %>% .[order(.)] %>% paste(sep = "", collapse = ";") %>% paste("graph LR", .,collapse = "", sep = ";") %>% paste(styles, yes, no, sep = ";") path <- allTrees[Feature!="Leaf", c(yesPath, noPath)] %>% .[order(.)] %>% paste(sep = "", collapse = ";") %>% paste("graph LR", .,collapse = "", sep = ";") %>% paste(styles, yes, no, sep = ";")
DiagrammeR(path) DiagrammeR(path)
} }