Correct colnames and remove rownames for Ops.xts

The result of Ops.xts() on an xts and a matrix will have rownames if
the matrix has rownames (e.g. if the matrix was created via as.xts()).

Always remove rownames from the Ops.xts() result, and remove dimnames
entirely if the result does not have colnames.

Add tests that exercise subtraction. Need to add tests that exercise
the relational operators.

See #295.

R/Ops.xts.R

@@ -52,11 +52,17 @@ function(e1, e2)
   else 
   if(is.null(attr(e,'index'))) {
     if(is.xts(e1)) {
-      .xts(e, .index(e1))
+      e <- .xts(e, .index(e1))
     } else {
-      .xts(e, .index(e2))
+      e <- .xts(e, .index(e2))
     }
-  } else {
-  e
   }
+  if(!is.null(dimnames(e)[[1L]])) {
+    if(is.null(dimnames(e)[[2L]])) {
+      attr(e, "dimnames") <- NULL
+    } else {
+      dimnames(e)[[1]] <- list(NULL)
+    }
+  }
+  e
 }

inst/unitTests/runit.Ops.R

@@ -0,0 +1,100 @@
+### 2-column objects
+test.xts_minus_matrix2d_dimnames <- function() {
+  m <- matrix(1:6, 3, 2, dimnames = list(format(.POSIXct(1:3)), c("x", "y")))
+  x <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+  y <- .xts(cbind(1:3, 4:6)*0L, 1:3, dimnames = list(NULL, c("x", "y")))
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix2d_only_colnames <- function() {
+  m <- matrix(1:6, 3, 2, dimnames = list(NULL, c("x", "y")))
+  x <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y")))
+  y <- .xts(cbind(1:3, 4:6)*0L, 1:3, dimnames = list(NULL, c("x", "y")))
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix2d_only_rownames <- function() {
+  m <- matrix(1:6, 3, 2, dimnames = list(format(.POSIXct(1:3)), NULL))
+  x <- .xts(cbind(1:3, 4:6), 1:3)
+  y <- .xts(cbind(1:3, 4:6)*0L, 1:3)
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix2d_no_dimnames <- function() {
+  m <- matrix(1:6, 3, 2)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  checkIdentical(x-m, y)
+}
+
+### 1-column objects
+test.xts_minus_matrix1d_dimnames <- function() {
+  m <- matrix(1:3, 3, 1, dimnames = list(format(.POSIXct(1:3)), "x"))
+  x <- .xts(1:3, 1:3, dimnames = list(NULL, "x"))
+  y <- .xts(1:3*0L, 1:3, dimnames = list(NULL, "x"))
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix1d_only_colnames <- function() {
+  m <- matrix(1:3, 3, 1, dimnames = list(NULL, "x"))
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix1d_only_rownames <- function() {
+  m <- matrix(1:3, 3, 1, dimnames = list(format(.POSIXct(1:3)), NULL))
+  x <- .xts(1:3, 1:3)
+  y <- .xts(1:3*0L, 1:3)
+  checkIdentical(x-m, y)
+}
+
+test.xts_minus_matrix1d_no_dimnames <- function() {
+  m <- matrix(1:3, 3, 1)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  checkIdentical(x-m, y)
+}
+
+### xts with dim, vector
+test.xts2d_minus_vector_no_names <- function() {
+  m <- cbind(1:3, 1:3)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  checkIdentical(x-m[,1L], y)
+  # add column names to xts objects
+  colnames(x) <- colnames(y) <- c("x", "y")
+  checkIdentical(x-m[,1L], y)
+}
+
+test.xts2d_minus_vector_names <- function() {
+  m <- cbind(1:3, 1:3)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  M <- setNames(m[,1], format(index(x)))
+  checkIdentical(x-M, y)
+  # add column names to xts objects
+  colnames(x) <- colnames(y) <- c("x", "y")
+  checkIdentical(x-M, y)
+}
+
+test.xts1d_minus_vector_no_names <- function() {
+  m <- matrix(1:3, 3, 1)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  checkIdentical(x-m[,1L], y)
+  # add column names to xts objects
+  colnames(x) <- colnames(y) <- "x"
+  checkIdentical(x-m[,1L], y)
+}
+
+test.xts1d_minus_vector_names <- function() {
+  m <- matrix(1:3, 3, 1)
+  x <- .xts(m, 1:3)
+  y <- .xts(m*0L, 1:3)
+  M <- setNames(m[,1], format(index(x)))
+  checkIdentical(x-M, y)
+  # add column names to xts objects
+  colnames(x) <- colnames(y) <- "x"
+  checkIdentical(x-M, y)
+}