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

modify xgb.getinfo to getinfo

Browse Source
This commit is contained in:
unknown 2014-08-27 15:03:24 -07:00
parent a060a2e9a6
commit 0f0c12707c
14 changed files with 268 additions and 256 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
R-package/DESCRIPTION
View File

@ -3,8 +3,8 @@ Type: Package
Title: R wrapper of xgboost
Version: 0.3-0
Date: 2014-08-23
Author: Tianqi Chen
Maintainer: Tianqi Chen <tianqi.tchen@gmail.com>
Author: Tianqi Chen, Tong He
Maintainer: Tianqi Chen <tianqi.tchen@gmail.com>, Tong He <hetong007@gmail.com>
Description: xgboost
License: See LICENSE file
URL: https://github.com/tqchen/xgboost

2
R-package/NAMESPACE
View File

@ -2,8 +2,8 @@ importClassesFrom("Matrix", dgCMatrix, dgeMatrix)
export(xgboost)
export(xgb.DMatrix)
export(xgb.getinfo)
exportMethods(predict)
exportMethods(getinfo)
export(xgb.train)
export(xgb.save)
export(xgb.load)

21
R-package/R/getinfo.xgb.DMatrix.R Normal file
View File

@ -0,0 +1,21 @@
setClass('xgb.DMatrix')
getinfo <- function(object, ...){
UseMethod("getinfo")
}
setMethod("getinfo", signature = "xgb.DMatrix",
definition = function(object, name) {
if (typeof(name) != "character") {
stop("xgb.getinfo: name must be character")
}
if (class(object) != "xgb.DMatrix") {
stop("xgb.setinfo: first argument dtrain must be xgb.DMatrix")
}
if (name != "label" && name != "weight" && name != "base_margin") {
stop(paste("xgb.getinfo: unknown info name", name))
}
ret <- .Call("XGDMatrixGetInfo_R", object, name, PACKAGE = "xgboost")
return(ret)
})

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

@ -2,15 +2,12 @@
setClass("xgb.Booster")
#' @export
setMethod("predict",
signature = "xgb.Booster",
definition = function(object, newdata, outputmargin = FALSE)
{
setMethod("predict", signature = "xgb.Booster",
definition = function(object, newdata, outputmargin = FALSE) {
if (class(newdata) != "xgb.DMatrix") {
newdata = xgb.DMatrix(newdata)
newdata <- xgb.DMatrix(newdata)
}
ret <- .Call("XGBoosterPredict_R", object, newdata,
as.integer(outputmargin), PACKAGE="xgboost")
ret <- .Call("XGBoosterPredict_R", object, newdata, as.integer(outputmargin), PACKAGE = "xgboost")
return(ret)
})
})

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

@ -1,30 +1,34 @@
# depends on matrix
.onLoad <- function(libname, pkgname) {
library.dynam("xgboost", pkgname, libname);
library.dynam("xgboost", pkgname, libname)
}
.onUnload <- function(libpath) {
library.dynam.unload("xgboost", libpath);
library.dynam.unload("xgboost", libpath)
}
# set information into dmatrix, this mutate dmatrix
xgb.setinfo <- function(dmat, name, info) {
if (class(dmat) != "xgb.DMatrix") {
stop("xgb.setinfo: first argument dtrain must be xgb.DMatrix");
stop("xgb.setinfo: first argument dtrain must be xgb.DMatrix")
}
if (name == "label") {
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), PACKAGE="xgboost")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost")
return(TRUE)
}
if (name == "weight") {
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), PACKAGE="xgboost")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost")
return(TRUE)
}
if (name == "base_margin") {
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info), PACKAGE="xgboost")
.Call("XGDMatrixSetInfo_R", dmat, name, as.numeric(info),
PACKAGE = "xgboost")
return(TRUE)
}
if (name == "group") {
.Call("XGDMatrixSetInfo_R", dmat, name, as.integer(info), PACKAGE="xgboost")
.Call("XGDMatrixSetInfo_R", dmat, name, as.integer(info),
PACKAGE = "xgboost")
return(TRUE)
}
stop(paste("xgb.setinfo: unknown info name", name))
@ -41,21 +45,22 @@ xgb.Booster <- function(params = list(), cachelist = list(), modelfile = NULL) {
stop("xgb.Booster: only accepts list of DMatrix as cachelist")
}
}
handle <- .Call("XGBoosterCreate_R", cachelist, PACKAGE="xgboost")
.Call("XGBoosterSetParam_R", handle, "seed", "0", PACKAGE="xgboost")
handle <- .Call("XGBoosterCreate_R", cachelist, PACKAGE = "xgboost")
.Call("XGBoosterSetParam_R", handle, "seed", "0", PACKAGE = "xgboost")
if (length(params) != 0) {
for (i in 1:length(params)) {
p <- params[i]
.Call("XGBoosterSetParam_R", handle, names(p), as.character(p), PACKAGE="xgboost")
.Call("XGBoosterSetParam_R", handle, names(p), as.character(p),
PACKAGE = "xgboost")
}
}
if (!is.null(modelfile)) {
if (typeof(modelfile) != "character"){
stop("xgb.Booster: modelfile must be character");
if (typeof(modelfile) != "character") {
stop("xgb.Booster: modelfile must be character")
}
.Call("XGBoosterLoadModel_R", handle, modelfile, PACKAGE="xgboost")
.Call("XGBoosterLoadModel_R", handle, modelfile, PACKAGE = "xgboost")
}
return(structure(handle, class="xgb.Booster"))
return(structure(handle, class = "xgb.Booster"))
}
@ -67,14 +72,13 @@ xgb.predict <- function(booster, dmat, outputmargin = FALSE) {
if (class(dmat) != "xgb.DMatrix") {
stop("xgb.predict: second argument must be type xgb.DMatrix")
}
ret <- .Call("XGBoosterPredict_R", booster, dmat, as.integer(outputmargin), PACKAGE="xgboost")
ret <- .Call("XGBoosterPredict_R", booster, dmat, as.integer(outputmargin),
PACKAGE = "xgboost")
return(ret)
}
##--------------------------------------
# the following are low level iteratively function, not needed
# if you do not want to use them
#---------------------------------------
## ----the following are low level iteratively function, not needed if
## you do not want to use them ---------------------------------------
# iteratively update booster with dtrain
xgb.iter.update <- function(booster, dtrain, iter) {
@ -84,7 +88,8 @@ xgb.iter.update <- function(booster, dtrain, iter) {
if (class(dtrain) != "xgb.DMatrix") {
stop("xgb.iter.update: second argument must be type xgb.DMatrix")
}
.Call("XGBoosterUpdateOneIter_R", booster, as.integer(iter), dtrain, PACKAGE="xgboost")
.Call("XGBoosterUpdateOneIter_R", booster, as.integer(iter), dtrain,
PACKAGE = "xgboost")
return(TRUE)
}
@ -96,7 +101,8 @@ xgb.iter.boost <- function(booster, dtrain, gpair) {
if (class(dtrain) != "xgb.DMatrix") {
stop("xgb.iter.update: second argument must be type xgb.DMatrix")
}
.Call("XGBoosterBoostOneIter_R", booster, dtrain, gpair$grad, gpair$hess, PACKAGE="xgboost")
.Call("XGBoosterBoostOneIter_R", booster, dtrain, gpair$grad, gpair$hess,
PACKAGE = "xgboost")
return(TRUE)
}
@ -123,6 +129,7 @@ xgb.iter.eval <- function(booster, watchlist, iter) {
evnames <- append(evnames, names(w))
}
}
msg <- .Call("XGBoosterEvalOneIter_R", booster, as.integer(iter), watchlist, evnames, PACKAGE="xgboost")
msg <- .Call("XGBoosterEvalOneIter_R", booster, as.integer(iter), watchlist,
evnames, PACKAGE = "xgboost")
return(msg)
}

26
R-package/R/xgb.DMatrix.R
View File

@ -1,21 +1,25 @@
# constructing DMatrix
xgb.DMatrix <- function(data, info=list(), missing=0.0, ...) {
xgb.DMatrix <- function(data, info = list(), missing = 0, ...) {
if (typeof(data) == "character") {
handle <- .Call("XGDMatrixCreateFromFile_R", data, as.integer(FALSE), PACKAGE="xgboost")
} else if(is.matrix(data)) {
handle <- .Call("XGDMatrixCreateFromMat_R", data, missing, PACKAGE="xgboost")
} else if(class(data) == "dgCMatrix") {
handle <- .Call("XGDMatrixCreateFromCSC_R", data@p, data@i, data@x, PACKAGE="xgboost")
handle <- .Call("XGDMatrixCreateFromFile_R", data, as.integer(FALSE),
PACKAGE = "xgboost")
} else if (is.matrix(data)) {
handle <- .Call("XGDMatrixCreateFromMat_R", data, missing,
PACKAGE = "xgboost")
} else if (class(data) == "dgCMatrix") {
handle <- .Call("XGDMatrixCreateFromCSC_R", data@p, data@i, data@x,
PACKAGE = "xgboost")
} else {
stop(paste("xgb.DMatrix: does not support to construct from ", typeof(data)))
stop(paste("xgb.DMatrix: does not support to construct from ",
typeof(data)))
}
dmat <- structure(handle, class="xgb.DMatrix")
dmat <- structure(handle, class = "xgb.DMatrix")
info = append(info,list(...))
if (length(info)==0)
info <- append(info, list(...))
if (length(info) == 0)
return(dmat)
for (i in 1:length(info)) {
p = info[i]
p <- info[i]
xgb.setinfo(dmat, names(p), p[[1]])
}
return(dmat)

3
R-package/R/xgb.DMatrix.save.R
View File

@ -4,7 +4,8 @@ xgb.DMatrix.save <- function(handle, fname) {
stop("xgb.save: fname must be character")
}
if (class(handle) == "xgb.DMatrix") {
.Call("XGDMatrixSaveBinary_R", handle, fname, as.integer(FALSE), PACKAGE="xgboost")
.Call("XGDMatrixSaveBinary_R", handle, fname, as.integer(FALSE),
PACKAGE = "xgboost")
return(TRUE)
}
stop("xgb.save: the input must be either xgb.DMatrix or xgb.Booster")

4
R-package/R/xgb.dump.R
View File

@ -3,9 +3,9 @@ xgb.dump <- function(booster, fname, fmap = "") {
if (class(booster) != "xgb.Booster") {
stop("xgb.dump: first argument must be type xgb.Booster")
}
if (typeof(fname) != "character"){
if (typeof(fname) != "character") {
stop("xgb.dump: second argument must be type character")
}
.Call("XGBoosterDumpModel_R", booster, fname, fmap, PACKAGE="xgboost")
.Call("XGBoosterDumpModel_R", booster, fname, fmap, PACKAGE = "xgboost")
return(TRUE)
}

16
R-package/R/xgb.getinfo.R
View File

@ -1,16 +0,0 @@
# get information from dmatrix
xgb.getinfo <- function(dmat, name) {
if (typeof(name) != "character") {
stop("xgb.getinfo: name must be character")
}
if (class(dmat) != "xgb.DMatrix") {
stop("xgb.setinfo: first argument dtrain must be xgb.DMatrix");
}
if (name != "label" &&
name != "weight" &&
name != "base_margin" ) {
stop(paste("xgb.getinfo: unknown info name", name))
}
ret <- .Call("XGDMatrixGetInfo_R", dmat, name, PACKAGE="xgboost")
return(ret)
}

4
R-package/R/xgb.load.R
View File

@ -1,5 +1,5 @@
xgb.load <- function(modelfile) {
if (is.null(modelfile))
stop('xgb.load: modelfile cannot be NULL')
xgb.Booster(modelfile=modelfile)
stop("xgb.load: modelfile cannot be NULL")
xgb.Booster(modelfile = modelfile)
}

2
R-package/R/xgb.save.R
View File

@ -4,7 +4,7 @@ xgb.save <- function(handle, fname) {
stop("xgb.save: fname must be character")
}
if (class(handle) == "xgb.Booster") {
.Call("XGBoosterSaveModel_R", handle, fname, PACKAGE="xgboost")
.Call("XGBoosterSaveModel_R", handle, fname, PACKAGE = "xgboost")
return(TRUE)
}
stop("xgb.save: the input must be either xgb.DMatrix or xgb.Booster")

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

@ -1,15 +1,17 @@
# train a model using given parameters
xgb.train <- function(params, dtrain, nrounds=10, watchlist=list(), obj=NULL, feval=NULL) {
xgb.train <- function(params=list(), dtrain, nrounds = 10, watchlist = list(),
obj = NULL, feval = NULL, ...) {
if (typeof(params) != "list") {
stop("xgb.train: first argument params must be list");
stop("xgb.train: first argument params must be list")
}
if (class(dtrain) != "xgb.DMatrix") {
stop("xgb.train: second argument dtrain must be xgb.DMatrix");
stop("xgb.train: second argument dtrain must be xgb.DMatrix")
}
bst <- xgb.Booster(params, append(watchlist,dtrain))
params = append(params, list(...))
bst <- xgb.Booster(params, append(watchlist, dtrain))
for (i in 1:nrounds) {
if (is.null(obj)) {
succ <- xgb.iter.update(bst, dtrain, i-1)
succ <- xgb.iter.update(bst, dtrain, i - 1)
} else {
pred <- xgb.predict(bst, dtrain)
gpair <- obj(pred, dtrain)
@ -17,18 +19,25 @@ xgb.train <- function(params, dtrain, nrounds=10, watchlist=list(), obj=NULL, fe
}
if (length(watchlist) != 0) {
if (is.null(feval)) {
msg <- xgb.iter.eval(bst, watchlist, i-1)
cat(msg); cat("\n")
msg <- xgb.iter.eval(bst, watchlist, i - 1)
cat(msg)
cat("\n")
} else {
cat("["); cat(i); cat("]");
cat("[")
cat(i)
cat("]")
for (j in 1:length(watchlist)) {
w <- watchlist[j]
if (length(names(w)) == 0) {
stop("xgb.eval: name tag must be presented for every elements in watchlist")
}
ret <- feval(xgb.predict(bst, w[[1]]), w[[1]])
cat("\t"); cat(names(w)); cat("-"); cat(ret$metric);
cat(":"); cat(ret$value)
cat("\t")
cat(names(w))
cat("-")
cat(ret$metric)
cat(":")
cat(ret$value)
}
cat("\n")
}

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

@ -1,39 +1,28 @@
# Main function for xgboost-package
xgboost = function(data=NULL, label = NULL, params=list(), nrounds=10,
verbose = 1, ...)
{
inClass = class(data)
if (inClass=='dgCMatrix' || inClass=='matrix')
{
xgboost <- function(data = NULL, label = NULL, params = list(), nrounds = 10,
verbose = 1, ...) {
inClass <- class(data)
if (inClass == "dgCMatrix" || inClass == "matrix") {
if (is.null(label))
stop('xgboost: need label when data is a matrix')
dtrain = xgb.DMatrix(data, label=y)
}
else
{
stop("xgboost: need label when data is a matrix")
dtrain <- xgb.DMatrix(data, label = y)
} else {
if (!is.null(label))
warning('xgboost: label will be ignored.')
if (inClass=='character')
dtrain = xgb.DMatrix(data)
else if (inClass=='xgb.DMatrix')
dtrain = data
else
stop('xgboost: Invalid input of data')
warning("xgboost: label will be ignored.")
if (inClass == "character")
dtrain <- xgb.DMatrix(data) else if (inClass == "xgb.DMatrix")
dtrain <- data else stop("xgboost: Invalid input of data")
}
if (verbose>1)
silent = 0
else
silent = 1
if (verbose > 1)
silent <- 0 else silent <- 1
params = append(params, list(silent=silent))
params = append(params, list(...))
params <- append(params, list(silent = silent))
params <- append(params, list(...))
if (verbose>0)
watchlist = list(train=dtrain)
else
watchlist = list()
if (verbose > 0)
watchlist <- list(train = dtrain) else watchlist <- list()
bst <- xgb.train(params, dtrain, nrounds, watchlist)

8
R-package/inst/examples/demo.R
View File

@ -85,8 +85,8 @@ test.y <- csc$label
test.x <- csc$data
pred <- predict(bst, test.x)
# Extrac label with xgb.getinfo
labels <- xgb.getinfo(dtest, "label")
# Extrac label with getinfo
labels <- getinfo(dtest, "label")
err <- as.numeric(sum(as.integer(pred > 0.5) != labels))/length(labels)
print(paste("error=", err))
@ -126,7 +126,7 @@ param <- list(max_depth = 2, eta = 1, silent = 1)
# user define objective function, given prediction, return gradient and second order gradient this is
# loglikelihood loss
logregobj <- function(preds, dtrain) {
labels <- xgb.getinfo(dtrain, "label")
labels <- getinfo(dtrain, "label")
preds <- 1/(1 + exp(-preds))
grad <- preds - labels
hess <- preds * (1 - preds)
@ -139,7 +139,7 @@ logregobj <- function(preds, dtrain) {
# transformation Take this in mind when you use the customization, and maybe you need write customized
# evaluation function
evalerror <- function(preds, dtrain) {
labels <- xgb.getinfo(dtrain, "label")
labels <- getinfo(dtrain, "label")
err <- as.numeric(sum(labels != (preds > 0)))/length(labels)
return(list(metric = "error", value = err))
}