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

Merge pull request #580 from terrytangyuan/test

Browse Source 
Fixed most of the lint issues
This commit is contained in:
Yuan (Terry) Tang 2015-10-29 00:54:16 -04:00
commit b9a9cd9db8
15 changed files with 191 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
R-package/R/predict.xgb.Booster.R
View File

@ -48,7 +48,7 @@ setMethod("predict", signature = "xgb.Booster",
stop("predict: ntreelimit must be equal to or greater than 1")
}
}
option = 0
option <- 0
if (outputmargin) {
option <- option + 1
}

2
R-package/R/utils.R
View File

@ -261,7 +261,7 @@ xgb.cv.mknfold <- function(dall, nfold, param, stratified, folds) {
ret <- list()
for (k in 1:nfold) {
dtest <- slice(dall, folds[[k]])
didx = c()
didx <- c()
for (i in 1:nfold) {
if (i != k) {
didx <- append(didx, folds[[i]])

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

@ -124,15 +124,15 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
stop("xgb.cv: cannot assign two different objectives")
if (!is.null(params$objective))
if (class(params$objective) == 'function') {
obj = params$objective
params[['objective']] = NULL
obj <- params$objective
params[['objective']] <- NULL
}
# if (!is.null(params$eval_metric) && !is.null(feval))
# stop("xgb.cv: cannot assign two different evaluation metrics")
if (!is.null(params$eval_metric))
if (class(params$eval_metric) == 'function') {
feval = params$eval_metric
params[['eval_metric']] = NULL
feval <- params$eval_metric
params[['eval_metric']] <- NULL
}
# Early Stopping
@ -144,9 +144,9 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
if (is.null(maximize))
{
if (params$eval_metric %in% c('rmse','logloss','error','merror','mlogloss')) {
maximize = FALSE
maximize <- FALSE
} else {
maximize = TRUE
maximize <- TRUE
}
}
@ -167,16 +167,16 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
mat_pred <- FALSE
if (!is.null(obj_type) && obj_type == 'multi:softprob')
{
num_class = params[['num_class']]
num_class <- params[['num_class']]
if (is.null(num_class))
stop('must set num_class to use softmax')
predictValues <- matrix(0,xgb.numrow(dtrain),num_class)
mat_pred = TRUE
mat_pred <- TRUE
}
else
predictValues <- rep(0,xgb.numrow(dtrain))
history <- c()
print.every.n = max(as.integer(print.every.n), 1L)
print.every.n <- max(as.integer(print.every.n), 1L)
for (i in 1:nrounds) {
msg <- list()
for (k in 1:nfold) {
@ -206,7 +206,6 @@ xgb.cv <- function(params=list(), data, nrounds, nfold, label = NULL, missing =
}
}
}
}
if (prediction) {
@ -226,7 +225,6 @@ 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")

2
R-package/R/xgb.model.dt.tree.R
View File

@ -81,7 +81,7 @@ xgb.model.dt.tree <- function(feature_names = NULL, filename_dump = NULL, model
}
if(!is.null(model)){
text = xgb.dump(model = model, with.stats = T)
text <- xgb.dump(model = model, with.stats = T)
} else if(!is.null(filename_dump)){
text <- readLines(filename_dump) %>% str_trim(side = "both")
}

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

@ -78,7 +78,6 @@ xgb.plot.tree <- function(feature_names = NULL, filename_dump = NULL, model = NU
allTrees[Feature != "Leaf" ,noPath := paste(ID,"(", Feature, ")-->|>= ", Split, "|", No, ">", No.Feature, "]", sep = "")]
if(is.null(CSSstyle)){
CSSstyle <- "classDef greenNode fill:#A2EB86, stroke:#04C4AB, stroke-width:2px;classDef redNode fill:#FFA070, stroke:#FF5E5E, stroke-width:2px"
}

43
R-package/R/xgb.train.R
View File

@ -140,27 +140,27 @@ xgb.train <- function(params=list(), data, nrounds, watchlist = list(),
warning('watchlist is provided but verbose=0, no evaluation information will be printed')
}
dot.params = list(...)
nms.params = names(params)
nms.dot.params = names(dot.params)
dot.params <- list(...)
nms.params <- names(params)
nms.dot.params <- names(dot.params)
if (length(intersect(nms.params,nms.dot.params)) > 0)
stop("Duplicated term in parameters. Please check your list of params.")
params = append(params, dot.params)
params <- append(params, dot.params)
# customized objective and evaluation metric interface
if (!is.null(params$objective) && !is.null(obj))
stop("xgb.train: cannot assign two different objectives")
if (!is.null(params$objective))
if (class(params$objective) == 'function') {
obj = params$objective
params$objective = NULL
obj <- params$objective
params$objective <- NULL
}
if (!is.null(params$eval_metric) && !is.null(feval))
stop("xgb.train: cannot assign two different evaluation metrics")
if (!is.null(params$eval_metric))
if (class(params$eval_metric) == 'function') {
feval = params$eval_metric
params$eval_metric = NULL
feval <- params$eval_metric
params$eval_metric <- NULL
}
# Early stopping
@ -174,28 +174,27 @@ xgb.train <- function(params=list(), data, nrounds, watchlist = list(),
if (is.null(maximize))
{
if (params$eval_metric %in% c('rmse','logloss','error','merror','mlogloss')) {
maximize = FALSE
maximize <- FALSE
} else {
maximize = TRUE
maximize <- TRUE
}
}
if (maximize) {
bestScore = 0
bestScore <- 0
} else {
bestScore = Inf
bestScore <- Inf
}
bestInd = 0
bestInd <- 0
earlyStopflag = FALSE
if (length(watchlist) > 1)
warning('Only the first data set in watchlist is used for early stopping process.')
}
handle <- xgb.Booster(params, append(watchlist, dtrain))
bst <- xgb.handleToBooster(handle)
print.every.n=max( as.integer(print.every.n), 1L)
print.every.n <- max( as.integer(print.every.n), 1L)
for (i in 1:nrounds) {
succ <- xgb.iter.update(bst$handle, dtrain, i - 1, obj)
if (length(watchlist) != 0) {
@ -204,14 +203,14 @@ xgb.train <- function(params=list(), data, nrounds, watchlist = list(),
cat(paste(msg, "\n", sep = ""))
if (!is.null(early.stop.round))
{
score = strsplit(msg,':|\\s+')[[1]][3]
score = as.numeric(score)
score <- strsplit(msg,':|\\s+')[[1]][3]
score <- as.numeric(score)
if ( (maximize && score > bestScore) || (!maximize && score < bestScore)) {
bestScore = score
bestInd = i
bestScore <- score
bestInd <- i
} else {
if (i-bestInd>=early.stop.round) {
earlyStopflag = TRUE
if (i - bestInd >= early.stop.round) {
cat('Stopping. Best iteration:',bestInd)
break
}
@ -226,8 +225,8 @@ xgb.train <- function(params=list(), data, nrounds, watchlist = list(),
}
bst <- xgb.Booster.check(bst)
if (!is.null(early.stop.round)) {
bst$bestScore = bestScore
bst$bestInd = bestInd
bst$bestScore <- bestScore
bst$bestInd <- bestInd
}
return(bst)
}

2
R-package/R/xgboost.R
View File

@ -79,8 +79,6 @@ xgboost <- function(data = NULL, label = NULL, missing = NA, weight = NULL,
return(bst)
}
#' Training part from Mushroom Data Set
#'
#' This data set is originally from the Mushroom data set,

18
R-package/tests/testthat/test_basic.R
View File

@ -4,30 +4,30 @@ context("basic functions")
data(agaricus.train, package='xgboost')
data(agaricus.test, package='xgboost')
train = agaricus.train
test = agaricus.test
train <- agaricus.train
test <- agaricus.test
test_that("train and predict", {
bst = xgboost(data = train$data, label = train$label, max.depth = 2,
bst <- xgboost(data = train$data, label = train$label, max.depth = 2,
eta = 1, nthread = 2, nround = 2, objective = "binary:logistic")
pred = predict(bst, test$data)
pred <- predict(bst, test$data)
})
test_that("early stopping", {
res = xgb.cv(data = train$data, label = train$label, max.depth = 2, nfold = 5,
res <- xgb.cv(data = train$data, label = train$label, max.depth = 2, nfold = 5,
eta = 0.3, nthread = 2, nround = 20, objective = "binary:logistic",
early.stop.round = 3, maximize = FALSE)
expect_true(nrow(res) < 20)
bst = xgboost(data = train$data, label = train$label, max.depth = 2,
bst <- xgboost(data = train$data, label = train$label, max.depth = 2,
eta = 0.3, nthread = 2, nround = 20, objective = "binary:logistic",
early.stop.round = 3, maximize = FALSE)
pred = predict(bst, test$data)
pred <- predict(bst, test$data)
})
test_that("save_period", {
bst = xgboost(data = train$data, label = train$label, max.depth = 2,
bst <- xgboost(data = train$data, label = train$label, max.depth = 2,
eta = 0.3, nthread = 2, nround = 20, objective = "binary:logistic",
save_period = 10, save_name = "xgb.model")
pred = predict(bst, test$data)
pred <- predict(bst, test$data)
})

4
R-package/tests/testthat/test_helpers.R
View File

@ -11,8 +11,8 @@ df <- data.table(Arthritis, keep.rownames = F)
df[,AgeDiscret := as.factor(round(Age / 10,0))]
df[,AgeCat := as.factor(ifelse(Age > 30, "Old", "Young"))]
df[,ID := NULL]
sparse_matrix = sparse.model.matrix(Improved~.-1, data = df)
output_vector = df[,Y:=0][Improved == "Marked",Y:=1][,Y]
sparse_matrix <- sparse.model.matrix(Improved~.-1, data = df)
output_vector <- df[,Y := 0][Improved == "Marked",Y := 1][,Y]
bst <- xgboost(data = sparse_matrix, label = output_vector, max.depth = 9,
eta = 1, nthread = 2, nround = 10,objective = "binary:logistic")

4
R-package/tests/testthat/test_poisson_regression.R
View File

@ -4,10 +4,10 @@ require(xgboost)
test_that("poisson regression works", {
data(mtcars)
bst = xgboost(data=as.matrix(mtcars[,-11]),label=mtcars[,11],
bst <- xgboost(data = as.matrix(mtcars[,-11]),label = mtcars[,11],
objective = 'count:poisson', nrounds=5)
expect_equal(class(bst), "xgb.Booster")
pred = predict(bst,as.matrix(mtcars[,-11]))
pred <- predict(bst,as.matrix(mtcars[, -11]))
expect_equal(length(pred), 32)
sqrt(mean( (pred - mtcars[,11]) ^ 2))
})