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

Add Github Action for R. (#5911)

Browse Source 
* Fix lintr errors.
This commit is contained in:
Jiaming Yuan
2020-07-20 19:23:36 +08:00
committed by GitHub
parent b3d2e7644a
commit 8b1afce316
33 changed files with 589 additions and 544 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
R-package/R/callbacks.R
View File

@@ -62,11 +62,11 @@ cb.print.evaluation <- function(period = 1, showsd = TRUE) {
callback <- function(env = parent.frame()) {
if (length(env$bst_evaluation) == 0 ||
period == 0 ||
NVL(env$rank, 0) != 0 )
NVL(env$rank, 0) != 0)
return()
i <- env$iteration
if ((i-1) %% period == 0 ||
if ((i - 1) %% period == 0 ||
i == env$begin_iteration ||
i == env$end_iteration) {
stdev <- if (showsd) env$bst_evaluation_err else NULL
@@ -115,7 +115,7 @@ cb.evaluation.log <- function() {
stop("bst_evaluation must have non-empty names")
mnames <<- gsub('-', '_', names(env$bst_evaluation))
if(!is.null(env$bst_evaluation_err))
if (!is.null(env$bst_evaluation_err))
mnames <<- c(paste0(mnames, '_mean'), paste0(mnames, '_std'))
}
@@ -123,12 +123,12 @@ cb.evaluation.log <- function() {
env$evaluation_log <- as.data.table(t(simplify2array(env$evaluation_log)))
setnames(env$evaluation_log, c('iter', mnames))
if(!is.null(env$bst_evaluation_err)) {
if (!is.null(env$bst_evaluation_err)) {
# rearrange col order from _mean,_mean,...,_std,_std,...
# to be _mean,_std,_mean,_std,...
len <- length(mnames)
means <- mnames[seq_len(len/2)]
stds <- mnames[(len/2 + 1):len]
means <- mnames[seq_len(len / 2)]
stds <- mnames[(len / 2 + 1):len]
cnames <- numeric(len)
cnames[c(TRUE, FALSE)] <- means
cnames[c(FALSE, TRUE)] <- stds
@@ -144,7 +144,7 @@ cb.evaluation.log <- function() {
return(finalizer(env))
ev <- env$bst_evaluation
if(!is.null(env$bst_evaluation_err))
if (!is.null(env$bst_evaluation_err))
ev <- c(ev, env$bst_evaluation_err)
env$evaluation_log <- c(env$evaluation_log,
list(c(iter = env$iteration, ev)))
@@ -351,13 +351,13 @@ cb.early.stop <- function(stopping_rounds, maximize = FALSE,
finalizer <- function(env) {
if (!is.null(env$bst)) {
attr_best_score = as.numeric(xgb.attr(env$bst$handle, 'best_score'))
attr_best_score <- as.numeric(xgb.attr(env$bst$handle, 'best_score'))
if (best_score != attr_best_score)
stop("Inconsistent 'best_score' values between the closure state: ", best_score,
" and the xgb.attr: ", attr_best_score)
env$bst$best_iteration = best_iteration
env$bst$best_ntreelimit = best_ntreelimit
env$bst$best_score = best_score
env$bst$best_iteration <- best_iteration
env$bst$best_ntreelimit <- best_ntreelimit
env$bst$best_score <- best_score
} else {
env$basket$best_iteration <- best_iteration
env$basket$best_ntreelimit <- best_ntreelimit
@@ -372,9 +372,9 @@ cb.early.stop <- function(stopping_rounds, maximize = FALSE,
return(finalizer(env))
i <- env$iteration
score = env$bst_evaluation[metric_idx]
score <- env$bst_evaluation[metric_idx]
if (( maximize && score > best_score) ||
if ((maximize && score > best_score) ||
(!maximize && score < best_score)) {
best_msg <<- format.eval.string(i, env$bst_evaluation, env$bst_evaluation_err)
@@ -500,7 +500,7 @@ cb.cv.predict <- function(save_models = FALSE) {
for (fd in env$bst_folds) {
pr <- predict(fd$bst, fd$watchlist[[2]], ntreelimit = ntreelimit, reshape = TRUE)
if (is.matrix(pred)) {
pred[fd$index,] <- pr
pred[fd$index, ] <- pr
} else {
pred[fd$index] <- pr
}
@@ -613,9 +613,7 @@ cb.gblinear.history <- function(sparse=FALSE) {
init <- function(env) {
if (!is.null(env$bst)) { # xgb.train:
coef_path <- list()
} else if (!is.null(env$bst_folds)) { # xgb.cv:
coef_path <- rep(list(), length(env$bst_folds))
} else stop("Parent frame has neither 'bst' nor 'bst_folds'")
}
@@ -705,11 +703,11 @@ xgb.gblinear.history <- function(model, class_index = NULL) {
if (!is_cv) {
# extract num_class & num_feat from the internal model
dmp <- xgb.dump(model)
if(length(dmp) < 2 || dmp[2] != "bias:")
if (length(dmp) < 2 || dmp[2] != "bias:")
stop("It does not appear to be a gblinear model")
dmp <- dmp[-c(1,2)]
dmp <- dmp[-c(1, 2)]
n <- which(dmp == 'weight:')
if(length(n) != 1)
if (length(n) != 1)
stop("It does not appear to be a gblinear model")
num_class <- n - 1
num_feat <- (length(dmp) - 4) / num_class
@@ -732,9 +730,9 @@ xgb.gblinear.history <- function(model, class_index = NULL) {
if (!is.null(class_index) && num_class > 1) {
coef_path <- if (is.list(coef_path)) {
lapply(coef_path,
function(x) x[, seq(1 + class_index, by=num_class, length.out=num_feat)])
function(x) x[, seq(1 + class_index, by = num_class, length.out = num_feat)])
} else {
coef_path <- coef_path[, seq(1 + class_index, by=num_class, length.out=num_feat)]
coef_path <- coef_path[, seq(1 + class_index, by = num_class, length.out = num_feat)]
}
}
coef_path