Improve R package's docs and tests

CONTRIBUTORS.md

@@ -47,3 +47,4 @@ List of Contributors
 * [Piji Li](https://github.com/lipiji)
 * [Hu Shiwen](https://github.com/yajiedesign)
 * [Boyuan Deng](https://github.com/bryandeng)
+* [Tong He](https://github.com/hetong007)

R-package/R/context.R

@@ -8,7 +8,10 @@ init.context.default <- function() {
 #'
 #' Set/Get default context for array creation.
 #'
+#' @rdname mx.ctx
+#' 
 #' @param new, optional takes \code{mx.cpu()} or \code{mx.gpu(id)}, new default ctx.
+#'
 #' @export
 mx.ctx.default <- function(new = NULL) {
   if (!is.null(new)) {
@@ -17,6 +20,13 @@ mx.ctx.default <- function(new = NULL) {
   return (mx.ctx.internal.default.value)
 }
 
+# TODO need examples
+
+#' @rdname mx.ctx
+#' 
+#' @return Logical indicator 
+#' 
+#' @export
 is.mx.context <- function(x) {
   class(x) == "MXContext"
 }

R-package/R/initializer.R

@@ -1,10 +1,11 @@
-# TODO(tong, KK) better R alternatives?
 mx.util.str.endswith <- function(name, suffix) {
-  slen <- nchar(suffix)
-  nlen <- nchar(name)
-  if (slen > nlen) return (FALSE)
-  nsuf <- substr(name, nlen - slen + 1, nlen)
-  return (nsuf == suffix)
+#  slen <- nchar(suffix)
+#  nlen <- nchar(name)
+#  if (slen > nlen) return (FALSE)
+#  nsuf <- substr(name, nlen - slen + 1, nlen)
+#  return (nsuf == suffix)
+  ptrn = paste0(suffix, "\\b")
+  return(grepl(ptrn, name))
 }
 
 #' Internal default value initialization scheme.
@@ -20,7 +21,9 @@ mx.init.internal.default <- function(name, shape, ctx) {
 }
 
 #' Create a initializer that initialize the weight with uniform [-scale, scale]
+#'
 #' @param scale The scale of uniform distribution
+#'
 #' @export
 mx.init.uniform <- function(scale) {
   function(name, shape, ctx) {
@@ -32,7 +35,9 @@ mx.init.uniform <- function(scale) {
 }
 
 #' Create a initializer that initialize the weight with normal(0, sd)
+#'
 #' @param scale The scale of uniform distribution
+#' 
 #' @export
 mx.init.normal <- function(sd) {
   function(name, shape, ctx) {

R-package/R/ndarray.R

@@ -1,24 +1,77 @@
-
+#' Load an mx.nd.array object on disk
+#' 
+#' @param filename the filename (including the path)
+#' 
+#' @examples 
+#' mat = mx.nd.array(1:3)
+#' mx.nd.save(mat, 'temp.mat') 
+#' mat2 = mx.nd.load('temp.mat')
+#' as.array(mat)
+#' as.array(mat2)
+#' 
+#' @export
 mx.nd.load <- function(filename) {
   filename <- path.expand(filename)
   mx.nd.internal.load(filename)
 }
 
+#' Save an mx.nd.array object
+#' 
+#' @param ndarray the \code{mx.nd.array} object
+#' @param filename the filename (including the path)
+#' 
+#' @examples 
+#' mat = mx.nd.array(1:3)
+#' mx.nd.save(mat, 'temp.mat') 
+#' mat2 = mx.nd.load('temp.mat')
+#' as.array(mat)
+#' as.array(mat2)
+#' 
+#' @export
 mx.nd.save <- function(ndarray, filename) {
   filename <- path.expand(filename)
   mx.nd.internal.save(ndarray, filename)
 }
 
 mx.nd.internal.empty <- function(shape, ctx=NULL) {
   if (is.null(ctx)) ctx <- mx.ctx.default()
+  if (!is.mx.context(ctx)) stop("wrong mx.context object, please specify with mx.cpu() or mx.gpu()")
   return (mx.nd.internal.empty.array(shape, ctx))
 }
 
+#' Generate an mx.nd.array object with zeros
+#' 
+#' @param shape the dimension of the \code{mx.nd.array}
+#' @param ctx optional The context device of the array. mx.ctx.default() will be used in default.
+#' 
+#' @examples 
+#' mat = mx.nd.zeros(10)
+#' as.array(mat)
+#' mat2 = mx.nd.zeros(c(5,5))
+#' as.array(mat)
+#' mat3 = mx.nd.zeroes(c(3,3,3))
+#' as.array(mat3)
+#' 
+#' @export
 mx.nd.zeros <- function(shape, ctx=NULL) {
   ret <- mx.nd.internal.empty(shape, ctx)
   return (mx.nd.internal.set.value(0.0, out=ret))
 }
 
+#' Generate an mx.nd.array object with ones
+#' 
+#' @param shape the dimension of the \code{mx.nd.array}
+#' @param ctx optional The context device of the array. mx.ctx.default() will be used in default.
+#'
+#' @examples 
+#' mat = mx.nd.ones(10)
+#' as.array(mat)
+#' mat2 = mx.nd.ones(c(5,5))
+#' as.array(mat)
+#' mat3 = mx.nd.ones(c(3,3,3))
+#' as.array(mat3)
+#'  
+#' @export
 mx.nd.ones <- function(shape, ctx=NULL) {
   ret <- mx.nd.internal.empty(shape, ctx)
   return (mx.nd.internal.set.value(1.0, out=ret))
@@ -29,20 +82,52 @@ mx.nd.ones <- function(shape, ctx=NULL) {
 #'
 #' Create a new \code{mx.ndarray} that copies the content from src on ctx.
 #'
-#' @param src.array, Source array data.
-#' @param ctx, optional The context device of the array. mx.ctx.default() will be used in default.
+#' @param src.array Source array data of class \code{array}, \code{vector} or \code{matrix}.
+#' @param ctx optional The context device of the array. mx.ctx.default() will be used in default.
+#'
 #'
+#' @rdname mx.nd.array
+#' 
+#' @return An Rcpp object
+#' 
+#' @examples
+#' mat = mx.nd.array(x)
+#' mat = 1 - mat + (2 * mat)/(mat + 0.5)
+#' as.array(mat)
+#' 
 #' @export
 mx.nd.array <- function(src.array, ctx=NULL) {
   if (is.null(ctx)) ctx <- mx.ctx.default()
+  if (!is.array(src.array)) {
+    if (!is.vector(src.array) && !is.matrix(src.array)) {
+      stop("mx.nd.array takes an object of class array, vector or matrix only.")
+    } else {
+#       if (is.integer(src.array) && !is.matrix(src.array)) 
+#         src.array = as.numeric(src.array)
+      src.array <- as.array(src.array)
+    }
+  }
   return (mx.nd.internal.array(src.array, ctx))
 }
 
 is.MXNDArray <- function(x) {
   inherits(x, "Rcpp_MXNDArray")
 }
 
-is.mx.ndarray <- is.MXNDArray
+#' @rdname mx.nd.array
+#' 
+#' @return Logical indicator
+#' 
+#' @examples 
+#' mat = mx.nd.array(1:10)
+#' is.mx.nd.array(mat) 
+#' mat2 = 1:10
+#' is.mx.nd.array(mat2)
+#' 
+#' @export
+is.mx.nd.array <- function(src.array) {
+  is.MXNDArray(src.array)
+}
 
 init.ndarray.methods <- function() {
   setMethod("+", signature(e1 = "Rcpp_MXNDArray", e2 = "numeric"), function(e1, e2) {

R-package/R/random.R

@@ -2,6 +2,7 @@
 
 #' Set the seed used by mxnet device-specific random number generators.
 #'
+#' @details
 #' We have a specific reason why \code{mx.set.seed} is introduced,
 #' instead of simply use \code{set.seed}.
 #'
@@ -12,7 +13,16 @@
 #' So we introduced \code{mx.set.seed} for mxnet specific device random numbers.
 #'
 #' @param seed the seed value to the device random number generators.
-#'
+#' 
+#' @examples
+#' 
+#' mx.set.seed(0)
+#' as.array(mx.runif(2))
+#' # 0.5488135 0.5928446
+#' mx.set.seed(0)
+#' as.array(mx.rnorm(2))
+#' # 2.212206 1.163079
+#' 
 #' @export
 mx.set.seed <- function(seed) {
   mx.internal.set.seed(seed)
@@ -25,6 +35,15 @@ mx.set.seed <- function(seed) {
 #' @param max numeric, The upper bound of distribution.
 #' @param ctx, optional The context device of the array. mx.ctx.default() will be used in default.
 #'
+#' @examples
+#' 
+#' mx.set.seed(0)
+#' as.array(mx.runif(2))
+#' # 0.5488135 0.5928446
+#' mx.set.seed(0)
+#' as.array(mx.rnorm(2))
+#' # 2.212206 1.163079
+#' 
 #' @export
 mx.runif <- function(shape, min=0, max=1, ctx=NULL) {
   if (!is.numeric(min)) stop("mx.rnorm only accept numeric min")
@@ -40,6 +59,15 @@ mx.runif <- function(shape, min=0, max=1, ctx=NULL) {
 #' @param sd numeric, The standard deviations.
 #' @param ctx, optional The context device of the array. mx.ctx.default() will be used in default.
 #'
+#' @examples
+#' 
+#' mx.set.seed(0)
+#' as.array(mx.runif(2))
+#' # 0.5488135 0.5928446
+#' mx.set.seed(0)
+#' as.array(mx.rnorm(2))
+#' # 2.212206 1.163079
+#' 
 #' @export
 mx.rnorm <- function(shape, mean=0, sd=1, ctx=NULL) {
   if (!is.numeric(mean)) stop("mx.rnorm only accept numeric mean")

R-package/R/symbol.R

@@ -1,9 +1,29 @@
-
+#' Save an mx.symbol object
+#' 
+#' @param symbol the \code{mx.symbol} object
+#' @param filename the filename (including the path)
+#' 
+#' @examples 
+#' data = mx.symbol.Variable('data')
+#' mx.symbol.save(data, 'temp.symbol')
+#' data2 = mx.symbol.load('temp.symbol')
+#' 
+#' @export
 mx.symbol.save <-function(symbol, filename) {
   filename <- path.expand(filename)
   symbol$save(filename)
 }
 
+#' Load an mx.symbol object
+#' 
+#' @param filename the filename (including the path)
+#' 
+#' @examples 
+#' data = mx.symbol.Variable('data')
+#' mx.symbol.save(data, 'temp.symbol')
+#' data2 = mx.symbol.load('temp.symbol')
+#' 
+#' @export
 mx.symbol.load <-function(filename) {
   filename <- path.expand(filename)
   mx.symbol.load(filename)
@@ -73,6 +93,22 @@ is.MXSymbol <- function(x) {
   inherits(x, "Rcpp_MXSymbol")
 }
 
+#' Judge if an object is mx.symbol
+#' 
+#' @return Logical indicator
+#' 
+#' @examples 
+#' mat = mx.nd.array(1:10)
+#' is.mx.nd.array(mat) 
+#' mat2 = 1:10
+#' is.mx.nd.array(mat2)
+#' 
+#' @export
+
+is.mx.symbol <- function(x) {
+  is.MXSymbol(x)
+}
+
 arguments <- function(x) {
   if (!is.MXSymbol(x))
     stop("only for MXSymbol type")

R-package/demo/basic_ndarray.R

@@ -1,7 +1,7 @@
 require(mxnet)
 
 
-x = as.array(c(1,2,3))
+x = 1:3
 mat = mx.nd.array(x)
 mat = mat + 1.0
 mat = mat + mat

R-package/man/mxnet-package.Rd

@@ -13,7 +13,7 @@
   package, including the most important functions.
 }
 \author{
-Tianqi Chen, Qiang Kou
+Tianqi Chen, Qiang Kou, Tong He
 
 Maintainer: Qiang Kou <qkou@umail.iu.edu>
 }

R-package/tests/testthat/test_ndarray.R

@@ -35,3 +35,15 @@ test_that("element-wise calculation for matrix", {
   expect_equal(x-x, as.array(mat-mat))
   expect_equal(as.array(1-mat), as.array(1-mat))
 })
+
+test_that("ndarray ones, zeros, save and load", {
+  expect_equal(rep(0, 10), as.array(mx.nd.zeros(10)))
+  expect_equal(matrix(0, 10, 5), as.array(mx.nd.zeros(c(10, 5))))
+  expect_equal(rep(1, 10), as.array(mx.nd.ones(10)))
+  expect_equal(matrix(1, 10, 5), as.array(mx.nd.ones(c(10, 5))))
+  mat = mx.nd.array(1:20)
+  mx.nd.save(mat, 'temp.mat')
+  mat2 = mx.nd.load('temp.mat')
+  expect_true(is.mx.nd.array(mat2[[1]]))
+  expect_equal(as.array(mat), as.array(mat2[[1]]))
+})

R-package/tests/testthat/test_symbol.R

@@ -0,0 +1,21 @@
+require(mxnet)
+
+context("symbol")
+
+test_that("basic symbol operation", {
+  data = mx.symbol.Variable('data')
+  net1 = mx.symbol.FullyConnected(data=data, name='fc1', num_hidden=10)
+  net1 = mx.symbol.FullyConnected(data=net1, name='fc2', num_hidden=100)
+
+  expect_equal(arguments(net1), c('data', 'fc1_weight', 'fc1_bias', 'fc2_weight', 'fc2_bias'))
+
+  net2 = mx.symbol.FullyConnected(name='fc3', num_hidden=10)
+  net2 = mx.symbol.Activation(data=net2, act_type='relu')
+  net2 = mx.symbol.FullyConnected(data=net2, name='fc4', num_hidden=20)
+
+  composed = mx.apply(net2, fc3_data=net1, name='composed')
+
+  expect_equal(arguments(composed), c('data', 'fc1_weight', 'fc1_bias', 'fc2_weight', 'fc2_bias', 'fc3_weight', 'fc3_bias', 'fc4_weight', 'fc4_bias'))
+})
+
+