Как избежать апкастинга в системе класса S4 R

Question

Я пытаюсь создать неявно центрированные / масштабированные матрицы в R с использованием S4 (с целью сделать это для больших разреженных матриц).

Я могу создать неявно масштабируемую матрицу, которая правильно выполняет левое и правое умножение с вектором:

      N = 500
P = 100
X = matrix(runif(N * P), N)

setClass("scaled_matrix", contains="matrix", slots=c(scale="numeric"))
setMethod("%*%", signature(x="scaled_matrix", y="numeric"),
          function(x, y) x@.Data %*% (y / x@scale))
setMethod("%*%", signature(x="numeric", y="scaled_matrix"),
          function(x, y) (x %*% y@.Data) / y@scale)

get_scaled = function(A) {
  rmsd = sqrt(apply(A*A, 2, sum)/(nrow(A)-1))
  new("scaled_matrix", A, scale = rmsd)
}

X_scaled = get_scaled(X)
left_test = runif(N)
max(abs(left_test %*% X_scaled - left_test %*% scale(X, center = F))) # small, yay!
right_test = runif(P)
max(abs(X_scaled %*% right_test - scale(X, center = F) %*% right_test )) # small, yay!

И неявно центрированная матрица:

      setClass("centered_matrix", 
         contains="matrix", 
         slots=c(center="numeric"))
setMethod("%*%", signature(x="centered_matrix", y="numeric"),
          function(x, y) (x@.Data %*% y - as.numeric(x@center %*% y)))
setMethod("%*%", signature(x="numeric", y="centered_matrix"),
          function(x, y) (x %*% y@.Data - sum(x) * y@center ))
get_centered = function(A) {
  new("centered_matrix", A, center = apply(A, 2, mean))
}

X_centered = get_centered(X)
max(abs(left_test %*% X_centered - left_test %*% scale(X, scale = F))) # small, yay!
max(abs(X_centered %*% right_test - scale(X, scale = F) %*% right_test )) # small, yay!

Но что, если я захочу их объединить? Я думал, что следующее сработает

      X_centered_scaled = get_scaled(X_centered)

max(abs(left_test %*% X_centered_scaled - left_test %*% scale(X))) # not small, oh no! 
max(abs(X_centered_scaled %*% right_test - scale(X) %*% right_test )) # not small, oh no! 

Насколько я могу судить, проблема в том, что

      class(X_centered_scaled@.Data) # should be centered_matrix but is matrix

т.е. когда X_centered_scaled создается X_centered поднимается до matrix вместо того, чтобы оставаться centered_matrix. Есть ли способ избежать этого? Конечно, я мог бы сделать сингл matrix_centered_scaled class, но мне нравится элегантность соединения этих двух вместе, и это дает возможность просто использовать один или другой.

Answer 1

Хорошо, я понял это. Уловка заключается в использовании явного data слот и пусть он будет особого класса ANY.

      

N = 500
P = 100
X = matrix(runif(N * P), N)

setClass("scaled_matrix", 
         slots=c(data = "ANY", scale="numeric"))
setMethod("%*%", signature(x="scaled_matrix", y="numeric"),
          function(x, y) (x@data %*% (y / x@scale)))
setMethod("%*%", signature(x="numeric", y="scaled_matrix"),
          function(x, y) ((x %*% y@data) / y@scale))

get_scaled = function(A, scale = sqrt(apply(A*A, 2, sum)/(nrow(A)-1))) {
  new("scaled_matrix", data = A, scale = scale)
}

X_scaled = get_scaled(X)
left_test = runif(N)
max(abs(left_test %*% X_scaled - left_test %*% scale(X, center = F))) # small, yay!
right_test = runif(P)
max(abs(X_scaled %*% right_test - scale(X, center = F) %*% right_test )) # small, yay!

setClass("centered_matrix",  
         slots=c(data = "ANY", center="numeric"))
setMethod("%*%", signature(x="centered_matrix", y="numeric"),
          function(x, y) ( x@data %*% y - as.numeric(x@center %*% y)))
setMethod("%*%", signature(x="numeric", y="centered_matrix"),
          function(x, y) (x %*% y@data - sum(x) * y@center ))
get_centered = function(A) {
  new("centered_matrix", data = A, center = apply(A, 2, mean))
}

X_centered = get_centered(X)
max(abs(left_test %*% X_centered - left_test %*% scale(X, scale = F))) # small, yay!
max(abs(X_centered %*% right_test - scale(X, scale = F) %*% right_test )) # small, yay!

X_centered_scaled = get_scaled(X_centered, scale = apply(X, 2, sd)) # doesnt' work either

max(abs(left_test %*% X_centered_scaled - left_test %*% scale(X))) # small, yay! 
max(abs(X_centered_scaled %*% right_test - scale(X) %*% right_test )) # small, yay!