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

Fixed most of the lint issues

Browse Source
This commit is contained in:
terrytangyuan
2015-10-28 23:24:17 -04:00
parent 8bae715994
commit 6024480400
13 changed files with 107 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
R-package/R/xgb.cv.R
View File

@@ -118,7 +118,7 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
for (mc in metrics) {
params <- append(params, list("eval_metric"=mc))
}
# customized objective and evaluation metric interface
if (!is.null(params$objective) && !is.null(obj))
stop("xgb.cv: cannot assign two different objectives")
@@ -134,7 +134,7 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
feval <- params$eval_metric
params[['eval_metric']] <- NULL
}
# Early Stopping
if (!is.null(early.stop.round)){
if (!is.null(feval) && is.null(maximize))
@@ -149,7 +149,7 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
maximize <- TRUE
}
}
if (maximize) {
bestScore <- 0
} else {
@@ -157,11 +157,11 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
}
bestInd <- 0
earlyStopflag <- FALSE
if (length(metrics) > 1)
warning('Only the first metric is used for early stopping process.')
}
xgb_folds <- xgb.cv.mknfold(dtrain, nfold, params, stratified, folds)
obj_type <- params[['objective']]
mat_pred <- FALSE
@@ -181,7 +181,6 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
msg <- list()
for (k in 1:nfold) {
fd <- xgb_folds[[k]]
succ <- xgb.iter.update(fd$booster, fd$dtrain, i - 1, obj)
msg[[k]] <- xgb.iter.eval(fd$booster, fd$watchlist, i - 1, feval) %>% str_split("\t") %>% .[[1]]
}
ret <- xgb.cv.aggcv(msg, showsd)
@@ -189,13 +188,13 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
if(verbose)
if (0 == (i - 1L) %% print.every.n)
cat(ret, "\n", sep="")
# early_Stopping
if (!is.null(early.stop.round)){
score <- strsplit(ret,'\\s+')[[1]][1 + length(metrics) + 2]
score <- strsplit(score,'\\+|:')[[1]][[2]]
score <- as.numeric(score)
if ((maximize && score > bestScore) || (!maximize && score < bestScore)) {
if ( (maximize && score > bestScore) || (!maximize && score < bestScore)) {
bestScore <- score
bestInd <- i
} else {
@@ -206,9 +205,8 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
}
}
}
}
if (prediction) {
for (k in 1:nfold) {
fd <- xgb_folds[[k]]
@@ -225,24 +223,23 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
}
}
}
colnames <- str_split(string = history[1], pattern = "\t")[[1]] %>% .[2:length(.)] %>% str_extract(".*:") %>% str_replace(":","") %>% str_replace("-", ".")
colnamesMean <- paste(colnames, "mean")
if(showsd) colnamesStd <- paste(colnames, "std")
colnames <- c()
if(showsd) for(i in 1:length(colnamesMean)) colnames <- c(colnames, colnamesMean[i], colnamesStd[i])
else colnames <- colnamesMean
type <- rep(x = "numeric", times = length(colnames))
dt <- utils::read.table(text = "", colClasses = type, col.names = colnames) %>% as.data.table
split <- str_split(string = history, pattern = "\t")
for(line in split) dt <- line[2:length(line)] %>% str_extract_all(pattern = "\\d*\\.+\\d*") %>% unlist %>% as.numeric %>% as.list %>% {rbindlist(list(dt, .), use.names = F, fill = F)}
for(line in split) dt <- line[2:length(line)] %>% str_extract_all(pattern = "\\d*\\.+\\d*") %>% unlist %>% as.numeric %>% as.list %>% {rbindlist( list( dt, .), use.names = F, fill = F)}
if (prediction) {
return(list(dt = dt,pred = predictValues))
return( list( dt = dt,pred = predictValues))
}
return(dt)
}