Merge pull request #561 from terrytangyuan/test

Added test for code quality check
This commit is contained in:
Tong He 2015-10-24 22:27:19 -07:00
commit 224f574420
13 changed files with 120 additions and 124 deletions

View File

@ -54,4 +54,3 @@ setMethod("getinfo", signature = "xgb.DMatrix",
} }
return(ret) return(ret)
}) })

View File

@ -68,4 +68,3 @@ setMethod("predict", signature = "xgb.Booster",
} }
return(ret) return(ret)
}) })

View File

@ -13,7 +13,6 @@ setMethod("predict", signature = "xgb.Booster.handle",
bst <- xgb.handleToBooster(object) bst <- xgb.handleToBooster(object)
ret = predict(bst, ...) ret <- predict(bst, ...)
return(ret) return(ret)
}) })

View File

@ -142,8 +142,7 @@ xgb.iter.boost <- function(booster, dtrain, gpair) {
if (class(dtrain) != "xgb.DMatrix") { if (class(dtrain) != "xgb.DMatrix") {
stop("xgb.iter.update: second argument must be type xgb.DMatrix") stop("xgb.iter.update: second argument must be type xgb.DMatrix")
} }
.Call("XGBoosterBoostOneIter_R", booster, dtrain, gpair$grad, gpair$hess, .Call("XGBoosterBoostOneIter_R", booster, dtrain, gpair$grad, gpair$hess, PACKAGE = "xgboost")
PACKAGE = "xgboost")
return(TRUE) return(TRUE)
} }
@ -159,7 +158,7 @@ xgb.iter.update <- function(booster, dtrain, iter, obj = NULL) {
if (is.null(obj)) { if (is.null(obj)) {
.Call("XGBoosterUpdateOneIter_R", booster, as.integer(iter), dtrain, .Call("XGBoosterUpdateOneIter_R", booster, as.integer(iter), dtrain,
PACKAGE = "xgboost") PACKAGE = "xgboost")
} else { } else {
pred <- predict(booster, dtrain) pred <- predict(booster, dtrain)
gpair <- obj(pred, dtrain) gpair <- obj(pred, dtrain)
succ <- xgb.iter.boost(booster, dtrain, gpair) succ <- xgb.iter.boost(booster, dtrain, gpair)
@ -192,7 +191,7 @@ xgb.iter.eval <- function(booster, watchlist, iter, feval = NULL, prediction = F
} }
msg <- .Call("XGBoosterEvalOneIter_R", booster, as.integer(iter), watchlist, msg <- .Call("XGBoosterEvalOneIter_R", booster, as.integer(iter), watchlist,
evnames, PACKAGE = "xgboost") evnames, PACKAGE = "xgboost")
} else { } else {
msg <- paste("[", iter, "]", sep="") msg <- paste("[", iter, "]", sep="")
for (j in 1:length(watchlist)) { for (j in 1:length(watchlist)) {
w <- watchlist[j] w <- watchlist[j]
@ -253,10 +252,10 @@ xgb.cv.mknfold <- function(dall, nfold, param, stratified, folds) {
kstep <- length(randidx) %/% nfold kstep <- length(randidx) %/% nfold
folds <- list() folds <- list()
for (i in 1:(nfold-1)) { for (i in 1:(nfold-1)) {
folds[[i]] = randidx[1:kstep] folds[[i]] <- randidx[1:kstep]
randidx = setdiff(randidx, folds[[i]]) randidx <- setdiff(randidx, folds[[i]])
} }
folds[[nfold]] = randidx folds[[nfold]] <- randidx
} }
} }
ret <- list() ret <- list()
@ -270,7 +269,7 @@ xgb.cv.mknfold <- function(dall, nfold, param, stratified, folds) {
} }
dtrain <- slice(dall, didx) dtrain <- slice(dall, didx)
bst <- xgb.Booster(param, list(dtrain, dtest)) bst <- xgb.Booster(param, list(dtrain, dtest))
watchlist = list(train=dtrain, test=dtest) watchlist <- list(train=dtrain, test=dtest)
ret[[k]] <- list(dtrain=dtrain, booster=bst, watchlist=watchlist, index=folds[[k]]) ret[[k]] <- list(dtrain=dtrain, booster=bst, watchlist=watchlist, index=folds[[k]])
} }
return (ret) return (ret)

View File

@ -99,7 +99,7 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
stop("xgb.cv: first argument params must be list") stop("xgb.cv: first argument params must be list")
} }
if(!is.null(folds)) { if(!is.null(folds)) {
if(class(folds)!="list" | length(folds) < 2) { if(class(folds) != "list" | length(folds) < 2) {
stop("folds must be a list with 2 or more elements that are vectors of indices for each CV-fold") stop("folds must be a list with 2 or more elements that are vectors of indices for each CV-fold")
} }
nfold <- length(folds) nfold <- length(folds)
@ -108,10 +108,10 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
stop("nfold must be bigger than 1") stop("nfold must be bigger than 1")
} }
dtrain <- xgb.get.DMatrix(data, label, missing) dtrain <- xgb.get.DMatrix(data, label, missing)
dot.params = list(...) dot.params <- list(...)
nms.params = names(params) nms.params <- names(params)
nms.dot.params = names(dot.params) nms.dot.params <- names(dot.params)
if (length(intersect(nms.params,nms.dot.params))>0) if (length(intersect(nms.params,nms.dot.params)) > 0)
stop("Duplicated defined term in parameters. Please check your list of params.") stop("Duplicated defined term in parameters. Please check your list of params.")
params <- append(params, dot.params) params <- append(params, dot.params)
params <- append(params, list(silent=1)) params <- append(params, list(silent=1))
@ -123,7 +123,7 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
if (!is.null(params$objective) && !is.null(obj)) if (!is.null(params$objective) && !is.null(obj))
stop("xgb.cv: cannot assign two different objectives") stop("xgb.cv: cannot assign two different objectives")
if (!is.null(params$objective)) if (!is.null(params$objective))
if (class(params$objective)=='function') { if (class(params$objective) == 'function') {
obj = params$objective obj = params$objective
params[['objective']] = NULL params[['objective']] = NULL
} }
@ -151,21 +151,21 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
} }
if (maximize) { if (maximize) {
bestScore = 0 bestScore <- 0
} else { } else {
bestScore = Inf bestScore <- Inf
} }
bestInd = 0 bestInd <- 0
earlyStopflag = FALSE earlyStopflag <- FALSE
if (length(metrics)>1) if (length(metrics)>1)
warning('Only the first metric is used for early stopping process.') warning('Only the first metric is used for early stopping process.')
} }
xgb_folds <- xgb.cv.mknfold(dtrain, nfold, params, stratified, folds) xgb_folds <- xgb.cv.mknfold(dtrain, nfold, params, stratified, folds)
obj_type = params[['objective']] obj_type <- params[['objective']]
mat_pred = FALSE mat_pred <- FALSE
if (!is.null(obj_type) && obj_type=='multi:softprob') if (!is.null(obj_type) && obj_type == 'multi:softprob')
{ {
num_class = params[['num_class']] num_class = params[['num_class']]
if (is.null(num_class)) if (is.null(num_class))
@ -187,20 +187,20 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
ret <- xgb.cv.aggcv(msg, showsd) ret <- xgb.cv.aggcv(msg, showsd)
history <- c(history, ret) history <- c(history, ret)
if(verbose) if(verbose)
if (0==(i-1L)%%print.every.n) if (0 == (i-1L)%%print.every.n)
cat(ret, "\n", sep="") cat(ret, "\n", sep="")
# early_Stopping # early_Stopping
if (!is.null(early.stop.round)){ if (!is.null(early.stop.round)){
score = strsplit(ret,'\\s+')[[1]][1+length(metrics)+2] score <- strsplit(ret,'\\s+')[[1]][1+length(metrics)+2]
score = strsplit(score,'\\+|:')[[1]][[2]] score <- strsplit(score,'\\+|:')[[1]][[2]]
score = as.numeric(score) score <- as.numeric(score)
if ((maximize && score>bestScore) || (!maximize && score<bestScore)) { if ((maximize && score > bestScore) || (!maximize && score < bestScore)) {
bestScore = score bestScore <- score
bestInd = i bestInd <- i
} else { } else {
if (i-bestInd>=early.stop.round) { if (i-bestInd >= early.stop.round) {
earlyStopflag = TRUE earlyStopflag <- TRUE
cat('Stopping. Best iteration:',bestInd) cat('Stopping. Best iteration:',bestInd)
break break
} }
@ -211,17 +211,17 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
if (prediction) { if (prediction) {
for (k in 1:nfold) { for (k in 1:nfold) {
fd = xgb_folds[[k]] fd <- xgb_folds[[k]]
if (!is.null(early.stop.round) && earlyStopflag) { if (!is.null(early.stop.round) && earlyStopflag) {
res = xgb.iter.eval(fd$booster, fd$watchlist, bestInd - 1, feval, prediction) res <- xgb.iter.eval(fd$booster, fd$watchlist, bestInd - 1, feval, prediction)
} else { } else {
res = xgb.iter.eval(fd$booster, fd$watchlist, nrounds - 1, feval, prediction) res <- xgb.iter.eval(fd$booster, fd$watchlist, nrounds - 1, feval, prediction)
} }
if (mat_pred) { if (mat_pred) {
pred_mat = matrix(res[[2]],num_class,length(fd$index)) pred_mat <- matrix(res[[2]],num_class,length(fd$index))
predictValues[fd$index,] = t(pred_mat) predictValues[fd$index,] <- t(pred_mat)
} else { } else {
predictValues[fd$index] = res[[2]] predictValues[fd$index] <- res[[2]]
} }
} }
} }