tests/testthat/test-trim.R

In matsbyname: An Implementation of Matrix Mathematics that Respects Row and Column Names

test_that("trim_rows_cols() works in degenerate cases", {
  # When a is NULL, we expect NULL as a result
  a <- matrix(c(1, 2, 3, 
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3")))
  mat <- matrix(c(1, 2,
                  3, 4), nrow = 2, ncol = 2, byrow = TRUE, 
                dimnames = list(c("r1", "r3"), c("c1", "c3")))

  expect_null(trim_rows_cols(NULL, mat))
  
  # When mat is NULL, we expect a returned unmodified
  expect_equal(trim_rows_cols(a, NULL), a)
  
  # When mat has NULL dimnames, a is returned unmodified
  mat2 <- mat
  dimnames(mat2) <- NULL
  expect_warning(res <- trim_rows_cols(a, mat2), "NULL names in trim_rows_cols, despite 'mat_mat' being specified. Returning 'a_mat' unmodified.")
  expect_equal(res, a)
  
  # `mat` has `NULL` for dimnames on `margin`, an error is returned.
  mat3 <- mat
  dimnames(mat3) <- list(c("r1", "r3"), NULL)
  expect_error(trim_rows_cols(a, mat3), "NULL dimnames for margin = 2 on 'mat")

  mat4 <- mat
  dimnames(mat4) <- list(NULL, c("c1", "c3"))
  expect_error(trim_rows_cols(a, mat4), "NULL dimnames for margin = 1 on 'mat")
})


test_that("trim_rows_cols() works in degenerate cases with Matrix objects", {
  # When a is NULL, we expect NULL as a result
  a <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3")))
  mat <- matsbyname::Matrix(c(1, 2,
                              3, 4), nrow = 2, ncol = 2, byrow = TRUE, 
                            dimnames = list(c("r1", "r3"), c("c1", "c3")))
  
  expect_null(trim_rows_cols(NULL, mat))
  
  # When mat is NULL, we expect a returned unmodified
  expect_equal(trim_rows_cols(a, NULL), a)
  
  # When mat has NULL dimnames, a is returned unmodified
  mat2 <- mat
  dimnames(mat2) <- list(NULL, NULL)
  expect_warning(res <- trim_rows_cols(a, mat2), "NULL names in trim_rows_cols, despite 'mat_mat' being specified. Returning 'a_mat' unmodified.")
  expect_equal(res, a)
  
  # `mat` has `NULL` for dimnames on `margin`, an error is returned.
  mat3 <- mat
  dimnames(mat3) <- list(c("r1", "r3"), NULL)
  expect_error(trim_rows_cols(a, mat3), "NULL dimnames for margin = 2 on 'mat")
  
  mat4 <- mat
  dimnames(mat4) <- list(NULL, c("c1", "c3"))
  expect_error(trim_rows_cols(a, mat4), "NULL dimnames for margin = 1 on 'mat")
})


test_that("errors are triggered with erroneous input", {
  expect_error(trim_rows_cols(a = NULL, mat = NULL), 
               "Both a and mat are NULL in complete_rows_cols")
  # Try with a matrix object
  expect_error(trim_rows_cols(a = data.frame(a = 1), mat = matrix(1)), 
               "a cannot be a data frame in complete_rows_cols")
  # Try with a Mattrix object
  expect_error(trim_rows_cols(a = data.frame(a = 1), mat = matsbyname::Matrix(1)), 
               "a cannot be a data frame in complete_rows_cols")
})


test_that("trim_rows_cols() works with a single number", {
  a <- 1
  mat <- matrix(42, dimnames = list("r1", "c1"))
  expect_error(trim_rows_cols(a, mat), regexp = "a_mat must be a matrix or a Matrix in matsbyname::trim_rows_cols")
  Mat <- matsbyname::Matrix(42, dimnames = list("r1", "c1"))
  expect_error(trim_rows_cols(a, Mat), regexp = "a_mat must be a matrix or a Matrix in matsbyname::trim_rows_cols")
})


test_that("trim_rows_cols() works as expected with single matrices", {
  a <- matrix(c(1, 2, 3, 
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  mat <- matrix(c(1, 2, 3,
                  4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                dimnames = list(c("r1", "bogus"), c("c1", "bogus", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  # Test trimming rows
  res1 <- trim_rows_cols(a, mat, margin = 1, warn_if_a_incomplete = FALSE)
  expect_equal(res1, matrix(c(1, 2, 3), nrow = 1, ncol = 3, byrow = TRUE, 
                            dimnames = list(c("r1"), c("c1", "c2", "c3"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
  
  # Test trimming cols
  res2 <- trim_rows_cols(a, mat, margin = 2, warn_if_a_incomplete = FALSE)
  expect_equal(res2, matrix(c(1, 2, 
                              4, 5, 
                              7, 8), nrow = 3, ncol = 2, byrow = TRUE, 
                            dimnames = list(c("r1", "r2", "r3"), c("c1", "c2"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
  
  # Test trimming both rows and cols
  res3 <- trim_rows_cols(a, mat, warn_if_a_incomplete = FALSE)
  expect_equal(res3, matrix(c(1, 2), nrow = 1, ncol = 2, byrow = TRUE, 
                            dimnames = list(c("r1"), c("c1", "c2"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
})


test_that("trim_rows_cols() works as expected with single Matrix objects", {
  a <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  mat <- matsbyname::Matrix(c(1, 2, 3,
                              4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                            dimnames = list(c("r1", "bogus"), c("c1", "bogus", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  # Test trimming rows
  res1 <- trim_rows_cols(a, mat, margin = 1, warn_if_a_incomplete = FALSE)
  expect_equal(res1, matsbyname::Matrix(c(1, 2, 3), nrow = 1, ncol = 3, byrow = TRUE, 
                                        dimnames = list(c("r1"), c("c1", "c2", "c3"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
  
  # Test trimming cols
  res2 <- trim_rows_cols(a, mat, margin = 2, warn_if_a_incomplete = FALSE)
  expect_equal(res2, matsbyname::Matrix(c(1, 2, 
                                          4, 5, 
                                          7, 8), nrow = 3, ncol = 2, byrow = TRUE, 
                                        dimnames = list(c("r1", "r2", "r3"), c("c1", "c2"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
  
  # Test trimming both rows and cols
  res3 <- trim_rows_cols(a, mat, warn_if_a_incomplete = FALSE)
  expect_equal(res3, matsbyname::Matrix(c(1, 2), nrow = 1, ncol = 2, byrow = TRUE, 
                                        dimnames = list(c("r1"), c("c1", "c2"))) %>% 
                 setrowtype("rowtype") %>% setcoltype("coltype"))
})


test_that("trim_rows_cols() works when a list is given", {
  a <- matrix(c(1, 2, 3, 
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  mat <- matrix(c(1, 2, 3,
                  4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                dimnames = list(c("r1", "bogus"), c("c1", "bogus", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  a_list <- list(a, a)
  mat_list <- list(mat, mat)
  
  res <- matrix(c(1, 2), nrow = 1, ncol = 2, byrow = TRUE, 
                dimnames = list(c("r1"), c("c1", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  expect_equal(trim_rows_cols(a_list, mat, margin = list(c(1,2), c(1,2)), warn_if_a_incomplete = FALSE), 
               list(res, res))
  
  expect_equal(trim_rows_cols(a_list, mat_list, margin = list(c(1,2), c(1,2)), warn_if_a_incomplete = FALSE), 
               list(res, res))
  
  # Try with an unbalanced list
  expect_warning(trim_rows_cols(a_list, # 2 here
                                list(mat, mat, mat), # 3 here
                                margin = list(c(1,2), c(1,2))), # 2 here
                 "In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("longer argument not a multiple of length of shorter") %>% 
    expect_warning("longer argument not a multiple of length of shorter")

  # Try with a being a list and mat being NULL.
  # Should get 2 a matrices.
  expect_equal(trim_rows_cols(a_list, NULL, margin = list(c(1,2), c(1,2))), 
               a_list)
})


test_that("trim_rows_cols() works with a list of Matrix objects", {
  a <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  mat <- matsbyname::Matrix(c(1, 2, 3,
                              4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                            dimnames = list(c("r1", "bogus"), c("c1", "bogus", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  a_list <- list(a, a)
  mat_list <- list(mat, mat)
  
  res <- matsbyname::Matrix(c(1, 2), nrow = 1, ncol = 2, byrow = TRUE, 
                            dimnames = list(c("r1"), c("c1", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  expect_equal(trim_rows_cols(a_list, mat, margin = list(c(1,2), c(1,2)), warn_if_a_incomplete = FALSE), 
               list(res, res))
  
  expect_equal(trim_rows_cols(a_list, mat_list, margin = list(c(1,2), c(1,2)), warn_if_a_incomplete = FALSE), 
               list(res, res))
  
  # Try with an unbalanced list
  expect_warning(trim_rows_cols(a_list, # 2 here
                                list(mat, mat, mat), # 3 here
                                margin = list(c(1,2), c(1,2))), # 2 here
                 "In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("In trim_rows_cols") %>% 
    expect_warning("longer argument not a multiple of length of shorter") %>% 
    expect_warning("longer argument not a multiple of length of shorter")
  
  # Try with a being a list and mat being NULL.
  # Should get 2 a matrices.
  expect_equal(trim_rows_cols(a_list, NULL, margin = list(c(1,2), c(1,2))), 
               a_list)
})


test_that("trim_rows_cols() warns when a does not contain all items in mat", {
  R <- matrix(c(1, 2, 3, 
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  phi <- matrix(c(1, 1.05, 0.931), nrow = 1, ncol = 3, 
                dimnames = list("r1", c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  # Test trimming columns. Everything is present, so nothing should be trimmed, and
  # there should be no warning.
  res1 <- trim_rows_cols(phi, R, margin = 2)
  expect_equal(res1, phi)  
  
  # Now try with a smaller R. 
  # This time, columns of phi should be trimmed.
  R2 <- R[, c(1,2), drop = FALSE] %>% setrowtype("rowtype") %>% setcoltype("coltype")
  res2 <- trim_rows_cols(phi, R2, margin = 2)
  expected2 <- matrix(c(1, 1.05), nrow = 1, dimnames = list("r1", c("c1", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res2, expected2)
  
  # Now try with a smaller phi.  This is the case where we want a warning.
  # We want to be sure that phi has columns that match all columns in R,
  # else the calculation will not be correct.
  phi3 <- phi[ , c(2,3), drop = FALSE] %>% setrowtype("rowtype") %>% setcoltype("coltype")
  expect_warning(res3 <- trim_rows_cols(phi3, R, margin = 2), "In trim_rows_cols, 'a' is missing the following rows or columns relative to 'mat': c1")
  
  # Try it with the warning turned off
  res4 <- trim_rows_cols(phi3, R, margin = 2, warn_if_a_incomplete = FALSE)
  expected4 <- matrix(c(1.05, 0.931), nrow = 1, dimnames = list("r1", c("c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res4, expected4)
})


test_that("trim_rows_cols() warns when a does not contain all items in mat with Matrix objects", {
  R <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  phi <- matsbyname::Matrix(c(1, 1.05, 0.931), nrow = 1, ncol = 3, 
                            dimnames = list("r1", c("c1", "c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  # Test trimming columns. Everything is present, so nothing should be trimmed, and
  # there should be no warning.
  res1 <- trim_rows_cols(phi, R, margin = 2)
  expect_equal(res1, phi)  
  
  # Now try with a smaller R. 
  # This time, columns of phi should be trimmed.
  R2 <- R[, c(1,2), drop = FALSE] %>% setrowtype("rowtype") %>% setcoltype("coltype")
  res2 <- trim_rows_cols(phi, R2, margin = 2)
  expected2 <- matsbyname::Matrix(c(1, 1.05), nrow = 1, ncol = 2, dimnames = list("r1", c("c1", "c2"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res2, expected2)
  
  # Now try with a smaller phi.  This is the case where we want a warning.
  # We want to be sure that phi has columns that match all columns in R,
  # else the calculation will not be correct.
  phi3 <- phi[ , c(2,3), drop = FALSE] %>% setrowtype("rowtype") %>% setcoltype("coltype")
  expect_warning(res3 <- trim_rows_cols(phi3, R, margin = 2), "In trim_rows_cols, 'a' is missing the following rows or columns relative to 'mat': c1")
  
  # Try it with the warning turned off
  res4 <- trim_rows_cols(phi3, R, margin = 2, warn_if_a_incomplete = FALSE)
  expected4 <- matsbyname::Matrix(c(1.05, 0.931), nrow = 1, ncol = 2, dimnames = list("r1", c("c2", "c3"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res4, expected4)
})


test_that("trim_rows_cols() respects pieces", {
  R <- matrix(c(1, 2, 3,  
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("r1", "r2", "r3"), 
                              c("c1 [from Resources]", "c2 [from USA]", "c3 [from GHA]"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  phi <- matrix(c(1, 1.05, 0.931, 42), nrow = 1, ncol = 4, 
                dimnames = list("r1", c("x [of c1]", "y [of c2]", "z [of c3]", "bogus"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  res1 <- trim_rows_cols(a = phi, mat = R, margin = 2, a_piece = "of", mat_piece = "pref")
  expected1 <- matrix(c(1, 1.05, 0.931), nrow = 1, 
                      dimnames = list("r1", c("x [of c1]", "y [of c2]", "z [of c3]"))) %>%
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res1, expected1)
  
  # Try with the noun instead of the prefix
  res2 <- trim_rows_cols(a = phi, mat = R, margin = 2, a_piece = "of", mat_piece = "noun")
  # Should obtain the same result.
  expect_equal(res2, expected1)
})


test_that("trim_rows_cols() respects pieces with Matrix objects", {
  R <- matsbyname::Matrix(c(1, 2, 3,  
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("r1", "r2", "r3"), 
                                          c("c1 [from Resources]", "c2 [from USA]", "c3 [from GHA]"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  phi <- matsbyname::Matrix(c(1, 1.05, 0.931, 42), nrow = 1, ncol = 4, 
                            dimnames = list("r1", c("x [of c1]", "y [of c2]", "z [of c3]", "bogus"))) %>% 
    setrowtype("rowtype") %>% setcoltype("coltype")
  
  res1 <- trim_rows_cols(a = phi, mat = R, margin = 2, a_piece = "of", mat_piece = "pref")
  expected1 <- matsbyname::Matrix(c(1, 1.05, 0.931), nrow = 1, ncol = 3,
                                  dimnames = list("r1", c("x [of c1]", "y [of c2]", "z [of c3]"))) %>%
    setrowtype("rowtype") %>% setcoltype("coltype")
  expect_equal(res1, expected1)
  
  # Try with the noun instead of the prefix
  res2 <- trim_rows_cols(a = phi, mat = R, margin = 2, a_piece = "of", mat_piece = "noun")
  # Should obtain the same result.
  expect_equal(res2, expected1)
})


test_that("trim_rows_cols() works with partial matching", {
  to_trim <- matrix(1:6, nrow = 3, ncol = 2, dimnames = list(c("r1p -> r1s", "r2p -> r2s", "r3p -> r3s"), 
                                                             c("c1p -> c1s", "c2p -> c2s")))
  mat <- matrix(42, nrow = 2, ncol = 1, dimnames = list(c("r1p", "r3p"), c("c2s")))
  
  res <- trim_rows_cols(a = to_trim, mat = mat, margin = 1, a_piece = "pref", notation = RCLabels::arrow_notation)
  expect_equal(res, to_trim[c(1,3), c(1,2)])
})