Code: Some Lint fixes

This commit is contained in:
terrytangyuan 2015-10-24 16:43:44 -04:00
parent 3abbd7b4c7
commit 537b34dc6f
6 changed files with 29 additions and 32 deletions

View File

@ -30,8 +30,8 @@ setClass("xgb.Booster",
#' pred <- predict(bst, test$data) #' pred <- predict(bst, test$data)
#' @export #' @export
#' #'
setMethod("predict", signature = "xgb.Booster", setMethod("predict", signature = "xgb.Booster",
definition = function(object, newdata, missing = NA, definition = function(object, newdata, missing = NA,
outputmargin = FALSE, ntreelimit = NULL, predleaf = FALSE) { outputmargin = FALSE, ntreelimit = NULL, predleaf = FALSE) {
if (class(object) != "xgb.Booster"){ if (class(object) != "xgb.Booster"){
stop("predict: model in prediction must be of class xgb.Booster") stop("predict: model in prediction must be of class xgb.Booster")
@ -55,7 +55,7 @@ setMethod("predict", signature = "xgb.Booster",
if (predleaf) { if (predleaf) {
option <- option + 2 option <- option + 2
} }
ret <- .Call("XGBoosterPredict_R", object$handle, newdata, as.integer(option), ret <- .Call("XGBoosterPredict_R", object$handle, newdata, as.integer(option),
as.integer(ntreelimit), PACKAGE = "xgboost") as.integer(ntreelimit), PACKAGE = "xgboost")
if (predleaf){ if (predleaf){
len <- getinfo(newdata, "nrow") len <- getinfo(newdata, "nrow")
@ -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

@ -32,7 +32,7 @@ setinfo <- function(object, ...){
#' @param ... other parameters #' @param ... other parameters
#' @rdname setinfo #' @rdname setinfo
#' @method setinfo xgb.DMatrix #' @method setinfo xgb.DMatrix
setMethod("setinfo", signature = "xgb.DMatrix", setMethod("setinfo", signature = "xgb.DMatrix",
definition = function(object, name, info) { definition = function(object, name, info) {
xgb.setinfo(object, name, info) xgb.setinfo(object, name, info)
}) })

View File

@ -23,14 +23,14 @@ slice <- function(object, ...){
#' @param ... other parameters #' @param ... other parameters
#' @rdname slice #' @rdname slice
#' @method slice xgb.DMatrix #' @method slice xgb.DMatrix
setMethod("slice", signature = "xgb.DMatrix", setMethod("slice", signature = "xgb.DMatrix",
definition = function(object, idxset, ...) { definition = function(object, idxset, ...) {
if (class(object) != "xgb.DMatrix") { if (class(object) != "xgb.DMatrix") {
stop("slice: first argument dtrain must be xgb.DMatrix") stop("slice: first argument dtrain must be xgb.DMatrix")
} }
ret <- .Call("XGDMatrixSliceDMatrix_R", object, idxset, ret <- .Call("XGDMatrixSliceDMatrix_R", object, idxset,
PACKAGE = "xgboost") PACKAGE = "xgboost")
attr_list <- attributes(object) attr_list <- attributes(object)
nr <- xgb.numrow(object) nr <- xgb.numrow(object)
len <- sapply(attr_list,length) len <- sapply(attr_list,length)

View File

@ -17,28 +17,28 @@ xgb.setinfo <- function(dmat, name, info) {
if (name == "label") { if (name == "label") {
if (length(info)!=xgb.numrow(dmat)) if (length(info)!=xgb.numrow(dmat))
stop("The length of labels must equal to the number of rows in the input data") stop("The length of labels must equal to the number of rows in the input data")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), .Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost") PACKAGE = "xgboost")
return(TRUE) return(TRUE)
} }
if (name == "weight") { if (name == "weight") {
if (length(info)!=xgb.numrow(dmat)) if (length(info)!=xgb.numrow(dmat))
stop("The length of weights must equal to the number of rows in the input data") stop("The length of weights must equal to the number of rows in the input data")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), .Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost") PACKAGE = "xgboost")
return(TRUE) return(TRUE)
} }
if (name == "base_margin") { if (name == "base_margin") {
# if (length(info)!=xgb.numrow(dmat)) # if (length(info)!=xgb.numrow(dmat))
# stop("The length of base margin must equal to the number of rows in the input data") # stop("The length of base margin must equal to the number of rows in the input data")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), .Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost") PACKAGE = "xgboost")
return(TRUE) return(TRUE)
} }
if (name == "group") { if (name == "group") {
if (sum(info)!=xgb.numrow(dmat)) if (sum(info)!=xgb.numrow(dmat))
stop("The sum of groups must equal to the number of rows in the input data") stop("The sum of groups must equal to the number of rows in the input data")
.Call("XGDMatrixSetInfo_R", dmat, name, as.integer(info), .Call("XGDMatrixSetInfo_R", dmat, name, as.integer(info),
PACKAGE = "xgboost") PACKAGE = "xgboost")
return(TRUE) return(TRUE)
} }
@ -68,7 +68,7 @@ xgb.Booster <- function(params = list(), cachelist = list(), modelfile = NULL) {
if (typeof(modelfile) == "character") { if (typeof(modelfile) == "character") {
.Call("XGBoosterLoadModel_R", handle, modelfile, PACKAGE = "xgboost") .Call("XGBoosterLoadModel_R", handle, modelfile, PACKAGE = "xgboost")
} else if (typeof(modelfile) == "raw") { } else if (typeof(modelfile) == "raw") {
.Call("XGBoosterLoadModelFromRaw_R", handle, modelfile, PACKAGE = "xgboost") .Call("XGBoosterLoadModelFromRaw_R", handle, modelfile, PACKAGE = "xgboost")
} else { } else {
stop("xgb.Booster: modelfile must be character or raw vector") stop("xgb.Booster: modelfile must be character or raw vector")
} }
@ -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

@ -91,15 +91,15 @@
#' print(history) #' print(history)
#' @export #' @export
#' #'
xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing = NA, xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing = NA,
prediction = FALSE, showsd = TRUE, metrics=list(), prediction = FALSE, showsd = TRUE, metrics=list(),
obj = NULL, feval = NULL, stratified = TRUE, folds = NULL, verbose = T, print.every.n=1L, obj = NULL, feval = NULL, stratified = TRUE, folds = NULL, verbose = T, print.every.n=1L,
early.stop.round = NULL, maximize = NULL, ...) { early.stop.round = NULL, maximize = NULL, ...) {
if (typeof(params) != "list") { if (typeof(params) != "list") {
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,22 +108,22 @@ 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))
for (mc in metrics) { for (mc in metrics) {
params <- append(params, list("eval_metric"=mc)) params <- append(params, list("eval_metric"=mc))
} }
# customized objective and evaluation metric interface # customized objective and evaluation metric interface
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
} }