modify xgb.getinfo to getinfo

R-package/DESCRIPTION

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

R-package/NAMESPACE

@@ -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)

R-package/R/getinfo.xgb.DMatrix.R

@@ -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)
+          })
+

R-package/R/predict.xgb.Booster.R

@@ -2,15 +2,12 @@
 setClass("xgb.Booster")
 
 #' @export
-setMethod("predict",
+setMethod("predict", signature = "xgb.Booster", 
-          signature = "xgb.Booster",
+          definition = function(object, newdata, outputmargin = FALSE) {
-          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, 
+  ret <- .Call("XGBoosterPredict_R", object, newdata, as.integer(outputmargin), PACKAGE = "xgboost")
-                           as.integer(outputmargin), PACKAGE="xgboost")
   return(ret)
 })
  

R-package/R/utils.R

@@ -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))
@@ -46,12 +50,13 @@ xgb.Booster <- function(params = list(), cachelist = list(), modelfile = NULL) {
   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");
+      stop("xgb.Booster: modelfile must be character")
     }
     .Call("XGBoosterLoadModel_R", handle, modelfile, PACKAGE = "xgboost")
   }
@@ -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
-# the following are low level iteratively function, not needed
+## you do not want to use them ---------------------------------------
-# 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)
 } 

R-package/R/xgb.DMatrix.R

@@ -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")
+    handle <- .Call("XGDMatrixCreateFromFile_R", data, as.integer(FALSE), 
+                    PACKAGE = "xgboost")
   } else if (is.matrix(data)) {
-        handle <- .Call("XGDMatrixCreateFromMat_R", data, missing, PACKAGE="xgboost")
+    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("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")
   
-    info = append(info,list(...))
+  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)

R-package/R/xgb.DMatrix.save.R

@@ -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")

R-package/R/xgb.getinfo.R

@@ -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)
-}

R-package/R/xgb.load.R

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

R-package/R/xgb.train.R

@@ -1,11 +1,13 @@
 # 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")
   }
+  params = append(params, list(...))
   bst <- xgb.Booster(params, append(watchlist, dtrain))
   for (i in 1:nrounds) {
     if (is.null(obj)) {
@@ -18,17 +20,24 @@ 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")
+        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("\t")
-                    cat(":"); cat(ret$value)
+          cat(names(w))
+          cat("-")
+          cat(ret$metric)
+          cat(":")
+          cat(ret$value)
         }
         cat("\n")
       }

R-package/R/xgboost.R

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

R-package/inst/examples/demo.R

@@ -85,8 +85,8 @@ test.y <- csc$label
 test.x <- csc$data
 pred <- predict(bst, test.x)
 
-# Extrac label with xgb.getinfo
+# Extrac label with getinfo
-labels <- xgb.getinfo(dtest, "label")
+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))
 }