Merge pull request #79 from mayer79/replacement_dimnames

Add dimnames replacement method

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("[",hstats_matrix)
+S3method("dimnames<-",hstats_matrix)
 S3method(average_loss,Learner)
 S3method(average_loss,default)
 S3method(average_loss,explainer)

NEWS.md

@@ -5,7 +5,7 @@
 - `hstats()`: `n_max` has been increased from 300 to 500 rows. This will make estimates of H statistics more stable at the price of longer run time. Reduce to 300 for the old behaviour.
 - `hstats()`: By default, three-way interactions are not calculated anymore. Set `threeway_m` to 5 for the old behaviour.
 - Revised plots: The colors and color palettes have changed and can (also) be controlled via global options. For instance, to change the fill color of all bars, set `options(hstats.fill = new value)`. Value labels are more clear, and there are more options. Varying color/fill scales now use viridis (inferno). This can be modified on the fly or via `options(hstats.viridis_args = list(...))`.
-- "hstats_matrix" object: All statistics functions, e.g., `h2_pairwise()` or `perm_importance()`, now return a "hstats_matrix". The values are stored in `$M` and can be plotted via `plot()`. Other methods are: `dimnames()`, `rownames()`, `colnames()`, `dim()`, `nrow()`, `ncol()`, `head()`, `tail()`, and subsetting like a normal matrix. This allows, e.g, to select and plot only one column of the results.
+- "hstats_matrix" object: All statistics functions, e.g., `h2_pairwise()` or `perm_importance()`, now return a "hstats_matrix". The values are stored in `$M` and can be plotted via `plot()`. Other methods include: `dimnames()`, `rownames()`, `colnames()`, `dim()`, `nrow()`, `ncol()`, `head()`, `tail()`, and subsetting like a normal matrix. This allows, e.g, to select and plot only one column of the results.
 - `perm_importance()`: The `perms` argument has been changed to `m_rep`.
 - `print()` and `summary()` methods have been revised.
 - The arguments `w` (case weights) and `y` (response) can now also be passed as column *names*.

R/H2_pairwise.R

@@ -69,7 +69,6 @@
 #' s <- hstats(fit, X = iris[3:5], verbose = FALSE)
 #' x <- h2_pairwise(s)
 #' plot(x)
-#' plot(x[, "Sepal.Length"])
 h2_pairwise <- function(object, ...) {
   UseMethod("h2_pairwise")
 }

R/perm_importance.R

@@ -49,7 +49,6 @@
 #' s
 #' plot(s)
 #' plot(s, swap_dim = TRUE, top_m = 2)
-#' plot(s[, "Sepal.Length"])
 perm_importance <- function(object, ...) {
   UseMethod("perm_importance")
 }

R/utils_statistics.R

@@ -296,6 +296,31 @@ dimnames.hstats_matrix <- function(x) {
   dimnames(x[["M"]])
 }
 
+#' Dimnames (Replacement Method) of "hstats_matrix"
+#'
+#' This implies `colnames(x) <- ...`.
+#'
+#' @param x An object of class "hstats_matrix".
+#' @param value A list with rownames and column names compliant with `$M` (and `$SE`).
+#' @returns Like `x`, but with replaced dimnames.
+#' @examples
+#' fit <- lm(as.matrix(iris[1:2]) ~ Petal.Length + Petal.Width * Species, data = iris)
+#' s <- hstats(fit, X = iris[3:5], verbose = FALSE)
+#' x <- h2_overall(s)
+#' colnames(x) <- c("Sepal Length", "Sepal Width")
+#' plot(x)
+#' 
+#' rownames(x)[2:3] <- c("Petal Width", "Petal Length")
+#' plot(x)
+#' @export
+`dimnames<-.hstats_matrix` <- function(x, value) {
+  dimnames(x[["M"]]) <- value
+  if (!is.null(x[["SE"]])) {
+    dimnames(x[["SE"]]) <- value
+  }
+  x
+}
+
 #' Subsets "hstats_matrix" Object
 #'
 #' Use standard square bracket subsetting to select rows and/or columns of

tests/testthat/test_statistics.R

@@ -47,17 +47,34 @@ test_that(".zap_small() works for matrix input", {
 fit <- lm(cbind(up = uptake, up2 = 2 * uptake) ~ Type * Treatment * conc, data = CO2)
 H <- hstats(fit, X = CO2[2:4], verbose = FALSE)
 s <- h2_pairwise(H)
+imp <- perm_importance(fit, CO2, v = c("Type", "Treatment", "conc"), y = "uptake")
 
 test_that("print() method does not give error", {
   capture_output(expect_no_error(print(s)))
+  capture_output(expect_no_error(print(s)))
 })
 
 test_that("dim() is correct", {
   expect_equal(dim(s), c(3L, 2L))
+  expect_equal(dim(imp), c(3L, 2L))
 })
 
 test_that("dimnames() is correct", {
   expect_equal(dimnames(s), list(rownames(s$M), colnames(s$M)))
+  expect_equal(dimnames(imp), list(rownames(imp$SE), colnames(imp$SE)))
+})
+
+test_that("dimnames() (replacement) works", {
+  s2 <- s
+  colnames(s2) <- c("y", "x")
+  rownames(s2) <- c("A", "B", "C")
+  expect_equal(colnames(s2), c("y", "x"))
+  expect_equal(rownames(s2), c("A", "B", "C"))
+
+  imp2 <- imp
+  dimnames(imp2) <- list(c("A", "B", "C"), c("y", "x"))
+  expect_equal(colnames(imp2), c("y", "x"))
+  expect_equal(rownames(imp2), c("A", "B", "C"))
 })
 
 test_that("subsetting works", {