R/dtensor-math.r

In tensorr: Sparse Tensors in R

#' @rdname norm
#' @aliases norm,dtensor-method
#' @export
setMethod("norm", "dtensor", function(x) sqrt(sum(x@x^2)))

#' @rdname innerprod
#' @aliases innerprod,dtensor,dtensor-method
#' @export
#' @importFrom assertive.properties assert_have_same_dims
setMethod("innerprod", signature(x = "dtensor", y = "dtensor"), function(x,y) {
  # dimensions must match
  assert_have_same_dims(x,y)

  sum(x@x * y@x)
})

#' @rdname outerprod
#' @aliases outerprod,dtensor,dtensor-method
#' @export
#' @importFrom assertive.properties assert_have_same_dims
setMethod("outerprod", signature(x = "dtensor", y = "dtensor"), function(x,y) {
  # dimensions must match
  assert_have_same_dims(x,y)
  dtensor(outer(x@x, y@x))
})

#' @rdname outerprod
#' @aliases outerprod,dtensor,tensor-method
#' @export
setMethod("outerprod", signature(x = "dtensor", y = "tensor"), function(x,y) {
  outerprod(x, as_dtensor(y))
})

#' @rdname outerprod
#' @aliases outerprod,tensor,dtensor-method
#' @export
setMethod("outerprod", signature(x = "tensor", y = "dtensor"), function(x,y) {
  outerprod(as_dtensor(x), y)
})

#' @rdname outerprod
#' @aliases ttt,tensor,tensor-method
#' @export
setMethod("ttt", c("tensor", "tensor"), function(x,y) {
  outerprod(x,y)
})

#' @rdname ttm
#' @aliases ttm,dtensor,Matrix,numeric,numeric-method
#' @export
#' @importClassesFrom Matrix Matrix
#' @importFrom assertive.base assert_are_identical
setMethod("ttm", c("dtensor", "Matrix", "numeric"), function(x, u, mode) {
  # check dimensions are compatible
  Xdims <- dim(x)
  assert_are_identical(Xdims[mode], ncol(u))

  # create new dimensions
  Ydims <- Xdims
  Ydims[mode] <- nrow(u)

  # unfold X along mode
  Xunfold <- unfold(x, mode)
  Xmat <- Xunfold@mat

  # multiply by matrix
  Ymat <- u %*% Xmat

  # refold tensor
  Yunfold <- unfolded_dtensor(Ymat, mode, Ydims)

  refold(Yunfold)
})

#' @rdname ttm
#' @aliases ttm,dtensor,matrix,numeric,numeric-method
#' @export
#' @importFrom assertive.base assert_are_identical
setMethod("ttm", c("dtensor", "matrix", "numeric"), function(x, u, mode) {
  U <- Matrix::Matrix(u)
  ttm(x, U, mode)
})

#' @rdname ttv
#' @aliases ttv,dtensor,numeric,numeric,numeric-method
#' @export
#' @importFrom assertive.properties assert_is_vector
setMethod("ttv", c("dtensor", "numeric", "numeric"), function(x, v, mode) {
  assert_is_vector(v) # and not a matrix
  u <- Matrix::Matrix(v, nrow = 1L)
  Y <- ttm(x, u, mode)

  # remove the mode dimension since it is of size 1 now
  dtensor(drop(Y@x))
})