From 3ca0aefbf056092754594444f33a569b364e354c Mon Sep 17 00:00:00 2001 From: Determan Date: Tue, 19 Dec 2017 12:06:39 -0600 Subject: [PATCH] implemented 'array' for Tensor objects, added 'sweep' method for applying operations across dimensions and associated unit tests, this also led to requiring additional paste0 call when dealing with multiple arguments --- R/Tensor.R | 60 ++++++++++++++++++++++++++++++++++-- tests/testthat/test_apply.R | 61 +++++++++++++++++++++++++++++++++++++ 2 files changed, 118 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test_apply.R diff --git a/R/Tensor.R b/R/Tensor.R index 543c502..7a21646 100644 --- a/R/Tensor.R +++ b/R/Tensor.R @@ -195,6 +195,13 @@ Tensor <- R6Class("Tensor", } private$.initializer = FALSE }, + "array" = { + self$tensor = initializer + if(missing(shape)){ + private$.shape = private$.get_shape(initializer) + } + private$.initializer = FALSE + }, "numeric" = { self$tensor = initializer if(missing(shape)){ @@ -202,6 +209,13 @@ Tensor <- R6Class("Tensor", } private$.initializer = FALSE }, + "integer" = { + self$tensor = initializer + if(missing(shape)){ + private$.shape = private$.get_shape(initializer) + } + private$.initializer = FALSE + }, { if(inherits(initializer, "gpuMatrix") | inherits(initializer, "vclMatrix")){ @@ -1250,6 +1264,31 @@ Tensor <- R6Class("Tensor", invisible(self) }, + sweep = function(MARGIN, STATS, FUN, name = NA){ + name = private$.createName(name) + + args = c(paste0("MARGIN = ", MARGIN), + paste0("FUN = '", FUN, "'")) + + x_tensor = if(!is(STATS, "Tensor")) Tensor$new(STATS) else STATS + + # function is single input operation, so take last node + input_shapes = if(length(self$graph) > 0) tail(self$graph, 1)[[1]]$output_shapes else list() + # function doesn't change shape + output_shapes = input_shapes + + Node$new(self, + ops = list(Operation$new("sweep", args = args)), + name = name, + input_nodes = if(length(self$graph) > 0) tail(self$graph, 1) else list(), + output_nodes = list(), + input_tensors = list("STATS" = x_tensor), + input_shapes = input_shapes, + output_shapes = output_shapes) + + invisible(self) + }, + compute = function(feed_list = NA){ if(private$.initializer){ @@ -1344,11 +1383,16 @@ Tensor <- R6Class("Tensor", }else{ if(!is.null(args)){ - f = parse(text = paste(func, '(output,', args, ')')) + f = parse(text = paste(func, '(output,', paste0(args, collapse = ", "), ')')) }else{ f = parse(text = paste(func, '(output)')) } + # print('args') + # print(args) + # print('expression') + # print(f) + output = eval(f) } @@ -1381,9 +1425,16 @@ Tensor <- R6Class("Tensor", if(!is.null(args)){ # print('args not null') if(is.na(op$order)){ - f = parse(text = paste(prefix, '(output,', inputs, ", ", args, ')')) + f = parse(text = paste(prefix, '(output,', + inputs, ", ", + paste0(args, collapse = ", "), + ')')) }else{ - f = parse(text = paste(prefix, '(', inputs, ", output,", args, ')')) + f = parse(text = paste(prefix, '(', + inputs, + ", output,", + paste0(args, collapse = ", "), + ')')) } }else{ @@ -1398,6 +1449,8 @@ Tensor <- R6Class("Tensor", } } + # print('args') + # print(args) # print('expression') # print(f) @@ -1540,6 +1593,7 @@ Tensor <- R6Class("Tensor", "integer" = length(value), "numeric" = length(value), "matrix" = dim(value), + "array" = dim(value), { if(is(value, "gpuMatrix") | is(value, "vclMatrix")){ dim(value) diff --git a/tests/testthat/test_apply.R b/tests/testthat/test_apply.R new file mode 100644 index 0000000..42d953a --- /dev/null +++ b/tests/testthat/test_apply.R @@ -0,0 +1,61 @@ +library(lazytensor) +context("Apply Operations") + +# basic matrix - 2D +mat <- matrix(1:12, nrow = 4) + +## array - 3D +A <- array(1:24, dim = 4:2) + + +test_that("Sweep Matrix", { + + # columns + baseC <- sweep(mat, 1, seq(4), FUN = '-') + # rows + baseR <- sweep(mat, 2, seq(3), FUN = '-') + + # Tensor computations + A_tensor <- Tensor$new(mat) + tensorC <- A_tensor$sweep(1, seq(4), FUN = '-')$compute() + A_tensor$drop() + tensorR <- A_tensor$sweep(2, seq(3), FUN = '-')$compute() + + expect_equal(tensorC, baseC, tolerance=.Machine$double.eps ^ 0.5, + info="columnwise sweep elements not equivalent", + check.attributes=FALSE) + expect_equal(tensorR, baseR, tolerance=.Machine$double.eps ^ 0.5, + info="rowwise sweep elements not equivalent", + check.attributes=FALSE) +}) + +test_that("Sweep Array (3D)", { + + # columns + baseC <- sweep(A, 1, seq(4), FUN = '-') + # rows + baseR <- sweep(A, 2, seq(3), FUN = '-') + # N dimension + baseN <- sweep(A, 3, seq(2), FUN = '-') + + # Tensor computations + A_tensor <- Tensor$new(A) + tensorC <- A_tensor$sweep(1, seq(4), FUN = '-')$compute() + A_tensor$drop() + tensorR <- A_tensor$sweep(2, seq(3), FUN = '-')$compute() + A_tensor$drop() + tensorN <- A_tensor$sweep(3, seq(2), FUN = '-')$compute() + + expect_equal(tensorC, baseC, tolerance=.Machine$double.eps ^ 0.5, + info="columnwise sweep elements not equivalent", + check.attributes=FALSE) + expect_equal(tensorR, baseR, tolerance=.Machine$double.eps ^ 0.5, + info="rowwise sweep elements not equivalent", + check.attributes=FALSE) + expect_equal(tensorN, baseN, tolerance=.Machine$double.eps ^ 0.5, + info="N-wise sweep elements not equivalent", + check.attributes=FALSE) +}) + + +