implement matrix multiplication, closes #226

Author: Enchufa2

NEWS.md

@@ -9,6 +9,8 @@
 * Add `scale_{type}_units()` scales for additional continuous aesthetics
   (colour, fill, alpha, size, linewidth); #369
 
+* Implement `matrixOps.units`, with support for `%*%` (R >= 4.3.0); #226
+
 # version 0.8-7
 
 * Deep copy of `ud_convert()` input to avoid side effects; #403

R/arith.R

@@ -200,34 +200,30 @@ Ops.units <- function(e1, e2) {
   .as.units(NextMethod(), u)
 }
 
-#' #' matrix multiplication
-#' #' @name matmult
-#' #' @param x numeric matrix or vector
-#' #' @param y numeric matrix or vector
-#' #' @export
-#' #' @details see \code{"\link[base]{\%*\%}"} for the base function, reimplemented
-#' #'   as default method
-#' `%*%` = function(x, y) UseMethod("%*%")
+#' S3 matrixOps Group Generic Functions for units objects
 #'
-#' #' @name matmult
-#' #' @export
-#' `%*%.default` = function(x, y) {
-#' 	if (inherits(y, "units"))
-#' 		`%*%.units`(x, y)
-#' 	else
-#' 		base::`%*%`(x, y)
-#' }
+#' matrixOps functions for units objects.
 #'
-#' #' @name matmult
-#' #' @export
-#' #' @examples
-#' #' a = set_units(1:5, m)
-#' #' a %*% a
-#' #' a %*% t(a)
-#' #' a %*% set_units(1:5, 1)
-#' #' set_units(1:5, 1) %*% a
-#' `%*%.units` = function(x, y) {
-#' 	ret = `%*%.default`(unclass(x), unclass(y))
-#' 	units(ret) = .multiply_symbolic_units(1, units(x), units(y))
-#' 	ret
-#' }
+#' @param x object of class \code{units},
+#'        or something that can be coerced to it by \code{as_units(x)}
+#' @param y object of class \code{units},
+#'        or something that can be coerced to it by \code{as_units(y)}
+#'
+#' @return object of class \code{units}
+#'
+#' @examples
+#' a = set_units(1:5, m)
+#' a %*% a
+#' a %*% t(a)
+#' a %*% 1:5
+#' 1:5 %*% a
+matrixOps.units <- function(x, y) {
+  mul <- .Generic %in% c("%*%") # multiplication-only
+
+  if (! any(mul))
+    stop(paste("operation", .Generic, "not allowed"))
+
+  u <- units(x[0] * y[0])
+  .as.units(NextMethod(), u)
+}
+# registered .onLoad

R/init.R

@@ -18,6 +18,8 @@ NULL
   ud_set_encoding(native)
 
   register_all_s3_methods()
+  if (exists("matrixOps"))
+    registerS3method("matrixOps", "units", matrixOps.units)
 }
 
 .onAttach <- function(libname, pkgname) {

man/matrixOps.units.Rd

@@ -208,11 +208,12 @@ test_that("%/% and %% work", {
   expect_true(all(x %% y >= set_units(0, m^2)))
 })
 
-#test_that("%*% work", {
-  # mat = set_units(matrix(1:5, 1), m)
-  # expect_equal(mat %*% t(mat), set_units(matrix(55), m^2))
-  # expect_equal(t(mat) %*% mat, set_units(t(unclass(mat)) %*% unclass(mat), m^2))
-#})
+test_that("%*% work", {
+  skip_if_not_installed("base", "4.3.0")
+  mat = set_units(matrix(1:5, 1), m)
+  expect_equal(mat %*% t(mat), set_units(matrix(55), m^2))
+  expect_equal(t(mat) %*% mat, set_units(t(unclass(mat)) %*% unclass(mat), m^2))
+})
 
 test_that("The order of multiplication for basic units is commutative", {
   a <- set_units(1:4, m^-3)