tests/testthat/test-aggregates.R

test_that("agg_table_to_agg_map() works as expected", {
  bands <- tibble::tribble(~few_col, ~many_col, 
                           "The Beatles", "John", 
                           "The Beatles", "Paul", 
                           "The Beatles", "George", 
                           "The Beatles", "Ringo", 
                           # Test duplicates and NA
                           "The Beatles", "Ringo",
                           "The Beatles", NA, 
                           "Rolling Stones", "Mick", 
                           "Rolling Stones", "Keith",
                           "Rolling Stones", "Ronnie",
                           "Rolling Stones", "Bill",
                           "Rolling Stones", "Charlie")
  res <- agg_table_to_agg_map(bands, 
                              few_colname = "few_col",
                              many_colname = "many_col")
  expect_equal(res, list(`Rolling Stones` = c("Mick", "Keith", "Ronnie", "Bill", "Charlie"),
                         `The Beatles` = c("John", "Paul", "George", "Ringo")))
})


test_that("agg_map_to_agg_table() works as expected", {
  agg_map <- list(`The Beatles` = c("John", "Paul", "George", "Ringo"), 
                  `Rolling Stones` = c("Mick", "Keith", "Ronnie", "Bill", "Charlie"))
  res <- agg_map_to_agg_table(agg_map, few_colname = "band", many_colname = "member")
  expect_equal(res, 
               tibble::tribble(~band, ~member, 
                               "The Beatles", "John", 
                               "The Beatles", "Paul", 
                               "The Beatles", "George", 
                               "The Beatles", "Ringo", 
                               "Rolling Stones", "Mick", 
                               "Rolling Stones", "Keith", 
                               "Rolling Stones", "Ronnie", 
                               "Rolling Stones", "Bill", 
                               "Rolling Stones", "Charlie"))
})


test_that("aggregate_byname() works as expected", {
  m <- matrix(1:9, nrow = 3, byrow = TRUE,
              dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3")))
  expected <- matrix(c(5, 7, 9,
                       7, 8, 9), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r3"), c("c1", "c2", "c3")))
  actual <- aggregate_byname(m, aggregation_map = list(a = c("r1", "r2")))
  expect_equal(actual, expected)
  
  # Try with wrong margin.
  # This will try to aggregate r1 and r2 in columns, but there are no r1 or r2 columns.
  expect_equal(aggregate_byname(m, aggregation_map = list(a = c("r1", "r2")), margin = 2), m)
  
  # Try to aggregate with only 1 row.
  # Should get same thing with a renamed column
  expected <- m
  dimnames(expected) <- list(c("r1", "a", "r3"), c("c1", "c2", "c3"))
  expect_equal(aggregate_byname(m, aggregation_map = list(a = c("r2")), margin = 1) %>% sort_rows_cols(margin = 1, roworder = dimnames(expected)[[1]]), expected)
  
  # Aggregate with a map that contains rows that don't exist.
  expect_equal(aggregate_byname(m, aggregation_map = list(a = c("r4", "r5", "42", "supercalifragilisticexpialidocious")), margin = 1), m)
})


test_that("aggregate_byname() works with Matrix objects", {
  M <- matsbyname::Matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE,
                          dimnames = list(c("r1", "r2", "r3"), c("c1", "c2", "c3")))
  expected <- matrix(c(5, 7, 9,
                       7, 8, 9), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r3"), c("c1", "c2", "c3")))
  actual <- aggregate_byname(M, aggregation_map = list(a = c("r1", "r2")))
  matsbyname:::expect_equal_matrix_or_Matrix(actual, expected)
  
  # Try with wrong margin.
  # This will try to aggregate r1 and r2 in columns, but there are no r1 or r2 columns.
  expect_equal(aggregate_byname(M, aggregation_map = list(a = c("r1", "r2")), margin = 2), M)
  
  # Try to aggregate with only 1 row.
  # Should get same thing with a renamed column
  expected <- M
  dimnames(expected) <- list(c("r1", "a", "r3"), c("c1", "c2", "c3"))
  matsbyname:::expect_equal_matrix_or_Matrix(aggregate_byname(M, aggregation_map = list(a = c("r2")), margin = 1) %>%
                                               sort_rows_cols(margin = 1, roworder = dimnames(expected)[[1]]), 
                                             expected)
  
  # Aggregate with a map that contains rows that don't exist.
  expect_equal(aggregate_byname(M, aggregation_map = list(a = c("r4", "r5", "42", "supercalifragilisticexpialidocious")), margin = 1), M)
})


test_that("aggregate_byname() works as expected for NULL aggregation_map", {
  m <- matrix(1:9, nrow = 3, byrow = TRUE,
              dimnames = list(c("r1", "a", "a"), c("c1", "c2", "c3")))
  expected <- matrix(c(11, 13, 15,
                       1, 2, 3), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r1"), c("c1", "c2", "c3")))
  # Nothing should change, because we're asking for aggregation by columns which have no repeated names.
  expect_equal(aggregate_byname(m, margin = 2), m)
  # Now we should get the expected result
  expect_equal(aggregate_byname(m, margin = 1), expected)
  # And, again should get the expected result, because we're asking for margin = c(1, 2), the default
  expect_equal(aggregate_byname(m), expected)
  
  m1 <- matrix(42, nrow = 1, dimnames = list(c("r1"), c("c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e1 <- m1
  expect_equal(aggregate_byname(m1), e1)
  expect_equal(aggregate_byname(list(m1)), list(e1))
  
  # Now aggregate on both rows and columns when some names are duplicated in both rows and cols.
  # First, try to aggregate on rows.
  m2 <- matrix(1:9, nrow = 3, byrow = TRUE,
               dimnames = list(c("r1", "a", "a"), c("b", "b", "c3")))
  expected2 <- matrix(c(11, 13, 15,
                        1, 2, 3), nrow = 2, byrow = TRUE, dimnames = list(c("a", "r1"), c("b", "b", "c3")))
  expect_equal(aggregate_byname(m2, margin = 1), expected2)
  
  # Now try to aggregate on columns
  expected3 <- matrix(c(3, 3,
                        9, 6,
                        15, 9), nrow = 3, byrow = TRUE, dimnames = list(c("r1", "a", "a"), c("b", "c3")))
  expect_equal(aggregate_byname(m2, margin = 2), expected3)
  
  # Now try to aggregate both rows and columns.
  expected4 <- matrix(c(24, 15,
                        3, 3), nrow = 2, byrow = TRUE,
                      dimnames = list(c("a", "r1"), c("b", "c3")))
  expect_equal(aggregate_byname(m2), expected4)
})


test_that("aggregate_byname() works with Matrix objects for NULL aggregation_map", {
  M <- matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE,
              dimnames = list(c("r1", "a", "a"), c("c1", "c2", "c3")))
  expected <- matrix(c(11, 13, 15,
                       1, 2, 3), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r1"), c("c1", "c2", "c3")))
  # Nothing should change, because we're asking for aggregation by columns which have no repeated names.
  expect_equal(aggregate_byname(M, margin = 2), M)
  # Now we should get the expected result
  expect_equal(aggregate_byname(M, margin = 1), expected)
  # And, again should get the expected result, because we're asking for margin = c(1, 2), the default
  expect_equal(aggregate_byname(M), expected)
  
  M1 <- matsbyname::Matrix(42, nrow = 1, dimnames = list(c("r1"), c("c1")), 
                           rowtype = "rows", coltype = "cols")
  E1 <- M1
  expect_equal(aggregate_byname(M1), E1)
  expect_equal(aggregate_byname(list(M1)), list(E1))
  
  # Now aggregate on both rows and columns when some names are duplicated in both rows and cols.
  # First, try to aggregate on rows.
  M2 <- matsbyname::Matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE,
                           dimnames = list(c("r1", "a", "a"), c("b", "b", "c3")))
  expected2 <- matsbyname::Matrix(c(11, 13, 15,
                                    1, 2, 3), nrow = 2, ncol = 3, byrow = TRUE, dimnames = list(c("a", "r1"), c("b", "b", "c3")))
  matsbyname:::expect_equal_matrix_or_Matrix(aggregate_byname(M2, margin = 1), expected2)
  
  # Now try to aggregate on columns
  expected3 <- matsbyname::Matrix(c(3, 3,
                                    9, 6,
                                    15, 9), nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "a", "a"), c("b", "c3")))
  matsbyname:::expect_equal_matrix_or_Matrix(aggregate_byname(M2, margin = 2), expected3)
  
  # Now try to aggregate both rows and columns.
  expected4 <- matsbyname::Matrix(c(24, 15,
                                    3, 3), nrow = 2, ncol = 2, byrow = TRUE,
                                  dimnames = list(c("a", "r1"), c("b", "c3")))
  matsbyname:::expect_equal_matrix_or_Matrix(aggregate_byname(M2), expected4)
})


test_that("aggregate_byname() works as expected for lists", {
  m <- matrix(1:9, nrow = 3, byrow = TRUE,
              dimnames = list(c("r1", "a", "a"), c("c1", "c2", "c3")))
  expected <- matrix(c(11, 13, 15,
                       1, 2, 3), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r1"), c("c1", "c2", "c3")))
  expect_equal(aggregate_byname(list(m, m, m)), list(expected, expected, expected))
  
  expect_equal(aggregate_byname(list(m, m), margin = list(c(1, 2))), list(expected, expected))
  
  # Also check that row and column type are preserved
  m2 <- matrix(1:9, nrow = 3, byrow = TRUE, 
               dimnames = list(c("b", "a", "a"), c("e", "d", "d"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  expected2 <- matrix(c(28, 11,
                        5, 1), nrow = 2, byrow = TRUE, 
                      dimnames = list(c("a", "b"), c("d", "e"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  expect_equal(aggregate_byname(m2), expected2)
  expect_equal(aggregate_byname(list(m2)), list(expected2))
  expect_equal(aggregate_byname(list(m2, m2), margin = list(c(1, 2))), list(expected2, expected2))
  expect_equal(aggregate_byname(list(m2, m2, m2, m2)), list(expected2, expected2, expected2, expected2))
})


test_that("aggregate_byname() works with Matrix objects for lists", {
  M <- matsbyname::Matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE,
                          dimnames = list(c("r1", "a", "a"), c("c1", "c2", "c3")))
  expected <- matrix(c(11, 13, 15,
                       1, 2, 3), nrow = 2, byrow = TRUE,
                     dimnames = list(c("a", "r1"), c("c1", "c2", "c3")))
  Map(f = matsbyname:::expect_equal_matrix_or_Matrix, aggregate_byname(list(M, M, M)), list(expected, expected, expected))
  Map(f = matsbyname:::expect_equal_matrix_or_Matrix, aggregate_byname(list(M, M), margin = list(c(1, 2))), list(expected, expected))
  
  # Also check that row and column type are preserved
  m2 <- matsbyname::Matrix(1:9, nrow = 3, ncol = 3, byrow = TRUE, 
                           dimnames = list(c("b", "a", "a"), c("e", "d", "d")), 
                           rowtype = "rows", coltype = "cols")
  expected2 <- matrix(c(28, 11,
                        5, 1), nrow = 2, byrow = TRUE, 
                      dimnames = list(c("a", "b"), c("d", "e"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  res <- aggregate_byname(m2)
  expect_true(is.Matrix(res))
  matsbyname:::expect_equal_matrix_or_Matrix(res, expected2)
  Map(f = matsbyname:::expect_equal_matrix_or_Matrix, aggregate_byname(list(m2)), list(expected2))
  Map(f = matsbyname:::expect_equal_matrix_or_Matrix, aggregate_byname(list(m2, m2), margin = list(c(1, 2))), list(expected2, expected2))
  Map(f = matsbyname:::expect_equal_matrix_or_Matrix, aggregate_byname(list(m2, m2, m2, m2), margin = list(c(1, 2))), list(expected2, expected2, expected2, expected2))
})


test_that("aggregate_byname() works when all rows collapse", {
  m <- matrix(1:6, byrow = TRUE, nrow = 2, ncol = 3, 
              dimnames = list(c("a", "a"), c("c1", "c2", "c3")))
  e <- matrix(c(5, 7, 9), byrow = TRUE, nrow = 1, ncol = 3,
              dimnames = list(c("a"), c("c1", "c2", "c3")))
  expect_equal(aggregate_byname(m), e)
})


test_that("aggregate_byname() works when all rows collapse in a Matrix", {
  m <- matsbyname::Matrix(1:6, byrow = TRUE, nrow = 2, ncol = 3,
                          dimnames = list(c("a", "a"), c("c1", "c2", "c3")))
  e <- matsbyname::Matrix(c(5, 7, 9), byrow = TRUE, nrow = 1, ncol = 3,
                          dimnames = list(c("a"), c("c1", "c2", "c3")))
  expect_equal(aggregate_byname(m), e)
})


test_that("aggregate_byname() works when aggregating all rows with an aggregation map", {
  m3 <- matrix(1:9, byrow = TRUE, nrow = 3, 
               dimnames = list(c("r2", "r1", "r1"), c("c2", "c1", "c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e3 <- matrix(c(12, 15, 18), byrow = TRUE, nrow = 1, 
               dimnames = list(c("new_row"), c("c2", "c1", "c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  # Aggregate all rows
  am <- list(new_row = c("r1", "r2"))
  a3 <- aggregate_byname(m3, aggregation_map = am, margin = 1)
  expect_equal(aggregate_byname(m3, aggregation_map = am, margin = 1), e3)
})


test_that("aggregate_byname() works when aggregating all rows with an aggregation map for a Matrix", {
  m3 <- matsbyname::Matrix(1:9, byrow = TRUE, nrow = 3, ncol = 3,
                           dimnames = list(c("r2", "r1", "r1"), c("c2", "c1", "c1")), 
                           rowtype = "rows", coltype = "cols")
  e3 <- matsbyname::Matrix(c(12, 15, 18), byrow = TRUE, nrow = 1, ncol = 3,
                           dimnames = list(c("new_row"), c("c2", "c1", "c1")), 
                           rowtype = "rows", coltype = "cols")
  # Aggregate all rows
  am <- list(new_row = c("r1", "r2"))
  a3 <- aggregate_byname(m3, aggregation_map = am, margin = 1)
  expect_equal(aggregate_byname(m3, aggregation_map = am, margin = 1), e3)
})


test_that("aggregate_byname() works as expected in data frames", {
  m1 <- matrix(42, nrow = 1, dimnames = list(c("r1"), c("c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e1 <- m1
  m2 <- matrix(1:4, byrow = TRUE, nrow = 2, 
               dimnames = list(c("a", "a"), c("a", "a")))
  e2row <- matrix(c(4, 6), byrow = TRUE, nrow = 1, 
                  dimnames = list(c("a"), c("a", "a")))
  e2col <- matrix(c(3, 7), nrow = 2, dimnames = list(c("a", "a"), c("a")))
  e2both <- matrix(10, nrow = 1,
                   dimnames = list(c("a"), c("a")))
  m3 <- matrix(1:9, byrow = TRUE, nrow = 3, 
               dimnames = list(c("r2", "r1", "r1"), c("c2", "c1", "c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e3row <- matrix(c(11, 13, 15, 
                    1, 2, 3), byrow = TRUE, nrow = 2,
                  dimnames = list(c("r1", "r2"), c("c2", "c1", "c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e3col <- matrix(c(5, 1, 
                    11, 4, 
                    17, 7), byrow = TRUE, nrow = 3, 
                  dimnames = list(c("r2", "r1", "r1"), c("c1", "c2"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e3both <- matrix(c(28, 11, 
                     5, 1), byrow = TRUE, nrow = 2, 
                   dimnames = list(c("r1", "r2"), c("c1", "c2"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  
  expect_equal(aggregate_byname(m2, margin = 1), e2row)
  expect_equal(aggregate_byname(m3, margin = 1), e3row)
  expect_equal(aggregate_byname(m3, margin = c(1, 2)), e3both)
  
  DF <- tibble::tibble(m = list(m1, m1, m1, m2, m2, m2, m3, m3, m3), 
                       margin = list(1, 2, c(1,2), 1, 2, c(1, 2), 1, 2, c(1, 2)), 
                       expected = list(e1, e1, e1, e2row, e2col, e2both, e3row, e3col, e3both))
  
  expect_equal(aggregate_byname(DF$m, margin = DF$margin), DF$expected)
  
  res <- DF %>% 
    dplyr::mutate(
      actual = aggregate_byname(m, margin = margin), 
      equal = all.equal(actual, expected)
    )
  expect_true(all(res$equal))
  
  # Now add an aggregation map
  am <- list(new_row = c("r1", "r2"))
  e4row <- matrix(c(12, 15, 18), byrow = TRUE, nrow = 1, 
                  dimnames = list(c("new_row"), c("c2", "c1", "c1"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  e4col <- m3
  e4both <- matrix(c(28, 11, 
                     5, 1), byrow = TRUE, nrow = 2, dimnames = list(c("r1", "r2"), c("c1", "c2"))) %>% 
    setrowtype("rows") %>% setcoltype("cols")
  
  expect_equal(aggregate_byname(m3, aggregation_map = am, margin = 1), e4row)
  # The next call should fail, because we're 
  # trying to aggregate on columns, but
  # we're using an aggregation_map designed for rows.
  # The aggregation fails to produce any changes in the data frame.
  # When the aggregate_byname function tries to sort the columns, 
  # it encounters duplicated row names and fails.
  expect_error(aggregate_byname(m3, aggregation_map = am, margin = 2), "Row names not unique. Duplicated row names are: c1")
  # The next call should fail, because we're trying to aggregate on both rows and columns (margin = c(1, 2)), but
  # the aggregation_map only aggregates by rows.
  # When we try to sum across both margins, 
  # there is a duplicate name ("c1"), which causes a problem.
  expect_error(aggregate_byname(m3, aggregation_map = am, margin = c(1, 2)), "Row names not unique. Duplicated row names are: c1")
  
  # The next call should work.
  expect_equal(aggregate_byname(m3), e4both)
  
  DF2 <- tibble::tibble(
    m = list(m3, m3, m3), 
    margin = list(1, 2, c(1, 2)), 
    expected = list(e4row, e3col, e4both), 
    am = list(am, NULL, NULL)
  )
  res2 <- DF2 %>% 
    dplyr::mutate(
      actual = aggregate_byname(m, margin = margin, aggregation_map = am), 
      equal = all.equal(actual, expected)
    )
  expect_true(all(res2$equal))
})


test_that("aggregate_byname() works as expected in data frames for Matrix objects", {
  m1 <- matsbyname::Matrix(42, nrow = 1, ncol = 1, dimnames = list(c("r1"), c("c1")), 
                           rowtype = "rows", coltype = "cols")
  e1 <- m1
  m2 <- matsbyname::Matrix(1:4, byrow = TRUE, nrow = 2, ncol = 2,
                           dimnames = list(c("a", "a"), c("a", "a")))
  e2row <- matsbyname::Matrix(c(4, 6), byrow = TRUE, nrow = 1, ncol = 2,
                              dimnames = list(c("a"), c("a", "a")))
  e2col <- matsbyname::Matrix(c(3, 7), nrow = 2, ncol = 1, dimnames = list(c("a", "a"), c("a")))
  e2both <- matsbyname::Matrix(10, nrow = 1,
                               dimnames = list(c("a"), c("a")))
  m3 <- matsbyname::Matrix(1:9, byrow = TRUE, nrow = 3, ncol = 3,
                           dimnames = list(c("r2", "r1", "r1"), c("c2", "c1", "c1")), 
                           rowtype = "rows", coltype = "cols")
  e3row <- matsbyname::Matrix(c(11, 13, 15, 
                                1, 2, 3), byrow = TRUE, nrow = 2, ncol = 3,
                              dimnames = list(c("r1", "r2"), c("c2", "c1", "c1")), 
                              rowtype = "rows", coltype = "cols")
  e3col <- matsbyname::Matrix(c(5, 1, 
                                11, 4, 
                                17, 7), byrow = TRUE, nrow = 3, ncol = 2,
                              dimnames = list(c("r2", "r1", "r1"), c("c1", "c2")), 
                              rowtype = "rows", coltype = "cols")
  e3both <- matsbyname::Matrix(c(28, 11, 
                                 5, 1), byrow = TRUE, nrow = 2, ncol = 2,
                               dimnames = list(c("r1", "r2"), c("c1", "c2")), 
                               rowtype = "rows", coltype = "cols")
  
  expect_equal(aggregate_byname(m2, margin = 1), e2row)
  expect_equal(aggregate_byname(m3, margin = 1), e3row)
  expect_equal(aggregate_byname(m3, margin = c(1, 2)), e3both)
  
  DF <- tibble::tibble(m = list(m1, m1, m1, m2, m2, m2, m3, m3, m3), 
                       margin = list(1, 2, c(1,2), 1, 2, c(1, 2), 1, 2, c(1, 2)), 
                       expected = list(e1, e1, e1, e2row, e2col, e2both, e3row, e3col, e3both))
  
  expect_equal(aggregate_byname(DF$m, margin = DF$margin), DF$expected)
  
  res <- DF %>% 
    dplyr::mutate(
      actual = aggregate_byname(m, margin = margin), 
      equal = all.equal(actual, expected)
    )
  expect_true(all(res$equal))
  
  # Now add an aggregation map
  am <- list(new_row = c("r1", "r2"))
  e4row <- matsbyname::Matrix(c(12, 15, 18), byrow = TRUE, nrow = 1, ncol = 3,
                              dimnames = list(c("new_row"), c("c2", "c1", "c1")), 
                              rowtype = "rows", coltype = "cols")
  e4col <- m3
  e4both <- matsbyname::Matrix(c(28, 11, 
                                 5, 1), byrow = TRUE, nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("c1", "c2")), 
                               rowtype = "rows", coltype = "cols")
  
  expect_equal(aggregate_byname(m3, aggregation_map = am, margin = 1), e4row)
  # The next call should fail, because we're 
  # trying to aggregate on columns, but
  # we're using an aggregation_map designed for rows.
  # The aggregation fails to produce any changes in the data frame.
  # When the aggregate_byname function tries to sort the columns, 
  # it encounters duplicated row names and fails.
  expect_error(aggregate_byname(m3, aggregation_map = am, margin = 2), "Row names not unique. Duplicated row names are: c1")
  # The next call should fail, because we're trying to aggregate on both rows and columns (margin = c(1, 2)), but
  # the aggregation_map only aggregates by rows.
  # When we try to sum across both margins, 
  # there is a duplicate name ("c1"), which causes a problem.
  expect_error(aggregate_byname(m3, aggregation_map = am, margin = c(1, 2)), "Row names not unique. Duplicated row names are: c1")
  
  # The next call should work.
  expect_equal(aggregate_byname(m3), e4both)
  
  DF2 <- tibble::tibble(
    m = list(m3, m3, m3), 
    margin = list(1, 2, c(1, 2)), 
    expected = list(e4row, e3col, e4both), 
    am = list(am, NULL, NULL)
  )
  res2 <- DF2 %>% 
    dplyr::mutate(
      actual = aggregate_byname(m, margin = margin, aggregation_map = am), 
      equal = all.equal(actual, expected)
    )
  expect_true(all(res2$equal))
})


test_that("aggregate_byname() works when removing multiple rows", {
  a <- matrix(1:4, nrow = 4, dimnames = list(c("a", "a", "b", "b"), "c1"))
  e <- matrix(c(3, 7), nrow = 2, dimnames = list(c("a", "b"), "c1"))
  expect_equal(aggregate_byname(a), e)
})


test_that("aggregate_byname() works when removing multiple rows for Matrix objects", {
  a <- matsbyname::Matrix(1:4, nrow = 4, ncol = 1, dimnames = list(c("a", "a", "b", "b"), "c1"))
  e <- matsbyname::Matrix(c(3, 7), nrow = 2, ncol = 1, dimnames = list(c("a", "b"), "c1"))
  expect_equal(aggregate_byname(a), e)
})


test_that("aggregate_byname() works when margin is NA", {
  Y <- matrix(1, nrow = 4, dimnames = list(c("a", "a", "b", "b"), "c1")) %>% 
    setrowtype("Product") %>% setcoltype("Unit")
  res <- Y %>% 
    aggregate_byname(margin = "Industry")
  expect_equal(res, Y)
})


test_that("aggregate_byname() works when margin is NA for Matrix objects", {
  Y <- matsbyname::Matrix(1, nrow = 4, ncol = 1, dimnames = list(c("a", "a", "b", "b"), "c1"), 
                          rowtype = "Product", coltype = "Unit")
  res <- Y %>% 
    aggregate_byname(margin = "Industry")
  expect_equal(res, Y)
})


test_that("aggregate_to_pref_suff_byname() works as expected", {
  m <- matrix((1:9), byrow = TRUE, nrow = 3, 
              dimnames = list(c("r1 -> b", "r2 -> b", "r3 -> a"), c("c1 -> z", "c2 -> y", "c3 -> y")))
  res1 <- aggregate_to_pref_suff_byname(m, keep = "pref", 
                                        notation = RCLabels::arrow_notation)
  expected1 <- rename_to_pref_suff_byname(m, keep = "pref", notation = RCLabels::arrow_notation)
  expect_equal(res1, expected1)
  # Aggregate by suffixes should do a lot, because several prefixes are same.
  res2 <- aggregate_to_pref_suff_byname(m, keep = "suff", 
                                        notation = RCLabels::arrow_notation)
  expected2 <- m %>% 
    rename_to_pref_suff_byname(keep = "suff", notation = RCLabels::arrow_notation) %>% 
    aggregate_byname()
  expect_equal(res2, expected2)
})


test_that("aggregate_to_pref_suff_byname() works with Matrix objects", {
  m <- matsbyname::Matrix((1:9), byrow = TRUE, nrow = 3, ncol = 3,
                          dimnames = list(c("r1 -> b", "r2 -> b", "r3 -> a"), c("c1 -> z", "c2 -> y", "c3 -> y")))
  res1 <- aggregate_to_pref_suff_byname(m, keep = "pref", 
                                        notation = RCLabels::arrow_notation)
  expected1 <- rename_to_pref_suff_byname(m, keep = "pref", notation = RCLabels::arrow_notation)
  expect_equal(res1, expected1)
  # Aggregate by suffixes should do a lot, because several prefixes are same.
  res2 <- aggregate_to_pref_suff_byname(m, keep = "suff", 
                                        notation = RCLabels::arrow_notation)
  expected2 <- m %>% 
    rename_to_pref_suff_byname(keep = "suff", notation = RCLabels::arrow_notation) %>% 
    aggregate_byname()
  expect_equal(res2, expected2)
})


test_that("aggregate_to_pref_suff_byname() works with a column vector", {
  # Ran into a bug where aggregating a column vector fails.
  # A column vector should aggregate to itself.
  # But instead, I get a "subscript out of bounds" error.
  # This test triggers that bug.
  #     -- MKH, 23 Nov 2020.
  m <- matrix(1:4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
  # This aggregation should simply return m with renamed column
  res <- aggregate_to_pref_suff_byname(m, keep = "suff", margin = 2, notation = RCLabels::arrow_notation)
  expected <- m %>% 
    magrittr::set_colnames("Industry")
  expect_equal(res, expected)
})


test_that("aggregate_to_pref_suff_byname() works with a column vector that is a Matrix", {
  # Ran into a bug where aggregating a column vector fails.
  # A column vector should aggregate to itself.
  # But instead, I get a "subscript out of bounds" error.
  # This test triggers that bug.
  #     -- MKH, 23 Nov 2020.
  m <- matsbyname::Matrix(1:4, nrow = 4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
  # This aggregation should simply return m with renamed column
  res <- aggregate_to_pref_suff_byname(m, keep = "suff", margin = 2, notation = RCLabels::arrow_notation)
  expect_true(is.Matrix(res))
  expected <- m %>% 
    magrittr::set_colnames("Industry")
  expect_equal(res, expected)
})


test_that("aggregate_to_pref_suff_byname() handles types correctly", {
  m <- matrix((1:9), byrow = TRUE, nrow = 3, 
              dimnames = list(c("r1 -> b", "r2 -> b", "r3 -> a"), c("c1 -> z", "c2 -> y", "c3 -> y"))) %>% 
    setrowtype("row -> letter") %>% setcoltype("col -> letter")
  
  res <- aggregate_to_pref_suff_byname(m, keep = "suff", notation = RCLabels::arrow_notation)
  expect_equal(rowtype(res), "letter")
  expect_equal(coltype(res), "letter")
})


test_that("aggregate_to_pref_suff_byname() handles types correctly for Matrix objects", {
  m <- matsbyname::Matrix((1:9), byrow = TRUE, nrow = 3, ncol = 3,
                          dimnames = list(c("r1 -> b", "r2 -> b", "r3 -> a"), c("c1 -> z", "c2 -> y", "c3 -> y")), 
                          rowtype = "row -> letter", coltype = "col -> letter")
  
  res <- aggregate_to_pref_suff_byname(m, keep = "suff", notation = RCLabels::arrow_notation)
  expect_true(is.Matrix(res))
  expect_equal(rowtype(res), "letter")
  expect_equal(coltype(res), "letter")
})


test_that("aggregate_pieces_byname() works as expected", {
  m <- matrix(c(1, 2, 3, 
                4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
              dimnames = list(c("a [from b]", "c [from d]"), 
                              c("e [from f]", "g [from h]", "i [from j]")))
  
  res1 <- m %>%
    aggregate_pieces_byname(piece = "suff", 
                            notation = RCLabels::from_notation,
                            aggregation_map = list(rows = c("b", "d"), 
                                                   cols = c("h", "j")))
  
  expected1 <- matrix(c(16, 5), nrow = 1, ncol = 2, byrow = TRUE, 
                      dimnames = list("rows", c("cols", "f")))
  expect_equal(res1, expected1)
})


test_that("aggregate_pieces_byname() works as expected", {
  m <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("a [from b]", "c [from d]"), 
                                          c("e [from f]", "g [from h]", "i [from j]")))
  
  res1 <- m %>%
    aggregate_pieces_byname(piece = "suff", 
                            notation = RCLabels::from_notation,
                            aggregation_map = list(rows = c("b", "d"), 
                                                   cols = c("h", "j")))
  expect_true(is.Matrix(res1))
  expected1 <- matsbyname::Matrix(c(16, 5), nrow = 1, ncol = 2, byrow = TRUE, 
                                  dimnames = list("rows", c("cols", "f")))
  expect_equal(res1, expected1)
})


test_that("aggregate_pieces_byname() works with aggregation by type", {
  m <- matrix(c(1, 0, 0, 
                0, 1, 1, 
                0, 1, 1), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("Gasoline [from Oil refineries]", 
                                "Electricity [from Main activity producer electricity plants]", 
                                "Electricity [from Hydro]"),
                              c("Automobiles", "LED lamps", "CFL lamps"))) %>%
    setrowtype("Product") %>% setcoltype("Industry")
  actual1 <- aggregate_pieces_byname(m, piece = "noun", margin = "Product",
                                     notation = RCLabels::bracket_notation)
  expected1 <- matrix(c(0, 2, 2, 
                        1, 0, 0), nrow = 2, ncol = 3, byrow = TRUE, 
                      dimnames = list(c("Electricity", "Gasoline"),
                                      c("Automobiles", "LED lamps", "CFL lamps"))) %>%
    setrowtype("Product") %>% setcoltype("Industry")
  expect_equal(actual1, expected1)
  
  # Try transposed
  mT <- transpose_byname(m)
  actual2 <- aggregate_pieces_byname(mT, piece = "noun", margin = "Product", 
                                     notation = RCLabels::bracket_notation)
  expected2 <- transpose_byname(expected1)
  expect_equal(actual2, expected2)
  
  # Try in a list
  actual3 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     notation = RCLabels::bracket_notation)
  expected3 <- list(expected1, expected2)
  expect_equal(actual3, expected3)
  
  # Try with an aggregation map
  actual4 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     aggregation_map = list(list(final = c("Electricity", "Gasoline")),
                                                            list(final = c("Electricity", "Gasoline"))),
                                     notation = RCLabels::bracket_notation)
  expected4 <- matrix(c(1, 2, 2), nrow = 1, ncol = 3, 
                      dimnames = list("final", c("Automobiles", "LED lamps", "CFL lamps"))) %>%
    setrowtype("Product") %>% setcoltype("Industry")
  expect_equal(actual4, list(expected4, transpose_byname(expected4)))
  
  # Try with a single aggregation map that is spread to both items in the list.
  actual5 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     aggregation_map = list(list(final = c("Electricity", "Gasoline"))),
                                     notation = RCLabels::bracket_notation)
  expect_equal(actual5, list(expected4, transpose_byname(expected4)))
  
  # Try in a data frame.
  df <- tibble::tibble(m = list(m, mT)) %>%
    dplyr::mutate(
      agg = aggregate_pieces_byname(a = m, 
                                    piece = "noun",
                                    margin = "Product", 
                                    aggregation_map = list(list(final = c("Electricity", "Gasoline"))),
                                    notation = RCLabels::bracket_notation)
    )
  expect_equal(df$agg, list(expected4, transpose_byname(expected4)))
  
  
  # Try in a data frame using columns for arguments.
  df <- tibble::tibble(m = list(m, mT), 
                       pce = "noun",
                       mgn = "Product",
                       agg_map = list(list(final = c("Electricity", "Gasoline"))),
                       notn = list(RCLabels::bracket_notation)) %>%
    dplyr::mutate(
      agg = aggregate_pieces_byname(a = m, 
                                    piece = pce, 
                                    margin = mgn, 
                                    aggregation_map = agg_map, 
                                    notation = notn)
    )
  expect_equal(df$agg, list(expected4, transpose_byname(expected4)))
})


test_that("aggregate_pieces_byname() works with aggregation by type in Matrix objects", {
  m <- matsbyname::Matrix(c(1, 0, 0, 
                            0, 1, 1, 
                            0, 1, 1), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("Gasoline [from Oil refineries]", 
                                            "Electricity [from Main activity producer electricity plants]", 
                                            "Electricity [from Hydro]"),
                                          c("Automobiles", "LED lamps", "CFL lamps")), 
                          rowtype = "Product", coltype = "Industry")
  actual1 <- aggregate_pieces_byname(m, piece = "noun", margin = "Product",
                                     notation = RCLabels::bracket_notation)
  expect_true(is.Matrix(actual1))
  expected1 <- matsbyname::Matrix(c(0, 2, 2, 
                                    1, 0, 0), nrow = 2, ncol = 3, byrow = TRUE, 
                                  dimnames = list(c("Electricity", "Gasoline"),
                                                  c("Automobiles", "LED lamps", "CFL lamps")), 
                                  rowtype = "Product", coltype = "Industry")
  expect_equal(actual1, expected1)
  
  # Try transposed
  mT <- transpose_byname(m)
  actual2 <- aggregate_pieces_byname(mT, piece = "noun", margin = "Product", 
                                     notation = RCLabels::bracket_notation)
  expected2 <- transpose_byname(expected1)
  expect_equal(actual2, expected2)
  
  # Try in a list
  actual3 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     notation = RCLabels::bracket_notation)
  expected3 <- list(expected1, expected2)
  expect_equal(actual3, expected3)
  
  # Try with an aggregation map
  actual4 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     aggregation_map = list(list(final = c("Electricity", "Gasoline")),
                                                            list(final = c("Electricity", "Gasoline"))),
                                     notation = RCLabels::bracket_notation)
  expected4 <- matsbyname::Matrix(c(1, 2, 2), nrow = 1, ncol = 3, 
                                  dimnames = list("final", c("Automobiles", "LED lamps", "CFL lamps")), 
                                  rowtype = "Product", coltype = "Industry")
  expect_equal(actual4, list(expected4, transpose_byname(expected4)))
  
  # Try with a single aggregation map that is spread to both items in the list.
  actual5 <- aggregate_pieces_byname(a = list(m, mT), piece = "noun", 
                                     margin = "Product",
                                     aggregation_map = list(list(final = c("Electricity", "Gasoline"))),
                                     notation = RCLabels::bracket_notation)
  expect_equal(actual5, list(expected4, transpose_byname(expected4)))
  
  # Try in a data frame.
  df <- tibble::tibble(m = list(m, mT)) %>%
    dplyr::mutate(
      agg = aggregate_pieces_byname(a = m, 
                                    piece = "noun",
                                    margin = "Product", 
                                    aggregation_map = list(list(final = c("Electricity", "Gasoline"))),
                                    notation = RCLabels::bracket_notation)
    )
  expect_equal(df$agg, list(expected4, transpose_byname(expected4)))
  
  
  # Try in a data frame using columns for arguments.
  df <- tibble::tibble(m = list(m, mT), 
                       pce = "noun",
                       mgn = "Product",
                       agg_map = list(list(final = c("Electricity", "Gasoline"))),
                       notn = list(RCLabels::bracket_notation)) %>%
    dplyr::mutate(
      agg = aggregate_pieces_byname(a = m, 
                                    piece = pce, 
                                    margin = mgn, 
                                    aggregation_map = agg_map, 
                                    notation = notn)
    )
  expect_equal(df$agg, list(expected4, transpose_byname(expected4)))
})


test_that("aggregate_pieces_byname() works with funny names", {
  m_pieces <- matrix(c(1, 2, 3,
                       4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                     dimnames = list(c("Electricity [from Coal]", "Electricity [from Solar]"), 
                                     c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  
  actual1 <- rename_to_piece_byname(m_pieces, piece = "from", margin = 1, notation = RCLabels::bracket_notation)
  expected1 <- matrix(c(1, 2, 3,
                        4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                      dimnames = list(c("Coal", "Solar"), 
                                      c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  expect_equal(actual1, expected1)
  
  
  actual2 <- aggregate_pieces_byname(m_pieces, piece = "from", margin = 1, notation = RCLabels::bracket_notation, 
                                     aggregation_map = list(`All sources` = c("Coal", "Solar")))
  expected2 <- matrix(c(5, 7, 9), nrow = 1, ncol = 3, byrow = TRUE, 
                      dimnames = list(c("All sources"), 
                                      c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  expect_equal(actual2, expected2)  
})


test_that("aggregate_pieces_byname() works with funny names", {
  m_pieces <- matsbyname::Matrix(c(1, 2, 3,
                                   4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                                 dimnames = list(c("Electricity [from Coal]", "Electricity [from Solar]"), 
                                                 c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  
  actual1 <- rename_to_piece_byname(m_pieces, piece = "from", margin = 1, notation = RCLabels::bracket_notation)
  expect_true(is.Matrix(actual1))
  expected1 <- matsbyname::Matrix(c(1, 2, 3,
                                    4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE, 
                                  dimnames = list(c("Coal", "Solar"), 
                                                  c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  expect_equal(actual1, expected1)
  
  actual2 <- aggregate_pieces_byname(m_pieces, piece = "from", margin = 1, notation = RCLabels::bracket_notation, 
                                     aggregation_map = list(`All sources` = c("Coal", "Solar")))
  expected2 <- matsbyname::Matrix(c(5, 7, 9), nrow = 1, ncol = 3, byrow = TRUE, 
                                  dimnames = list(c("All sources"), 
                                                  c("Motors -> MD", "Cars -> MD", "LED lamps -> Light")))
  expect_equal(actual2, expected2)  
})


test_that("aggregate_pieces_byname() works when inferring notation", {
  m <- matrix(c(1, 2, 3, 
                4, 5, 6, 
                7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
              dimnames = list(c("a [from b]", "c [from d]", "e [from d]"), 
                              c("e [from f]", "g [from h]", "i [from j]")))
  
  res1 <- m %>%
    aggregate_pieces_byname(piece = "suff",
                            choose_most_specific = TRUE,
                            aggregation_map = list(rows = "d", 
                                                   cols = c("h", "j")))
  
  expected1 <- matrix(c(5, 1,
                        28, 11), nrow = 2, ncol = 2, byrow = TRUE, 
                      dimnames = list(c("b", "rows"), c("cols", "f")))
  expect_equal(res1, expected1)
})


test_that("aggregate_pieces_byname() works when inferring notation on Matric objects", {
  m <- matsbyname::Matrix(c(1, 2, 3, 
                            4, 5, 6, 
                            7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE, 
                          dimnames = list(c("a [from b]", "c [from d]", "e [from d]"), 
                                          c("e [from f]", "g [from h]", "i [from j]")))
  
  res1 <- m %>%
    aggregate_pieces_byname(piece = "suff",
                            choose_most_specific = TRUE,
                            aggregation_map = list(rows = "d", 
                                                   cols = c("h", "j")))
  expect_true(is.Matrix(res1))
  expected1 <- matsbyname::Matrix(c(5, 1,
                                    28, 11), nrow = 2, ncol = 2, byrow = TRUE, 
                                  dimnames = list(c("b", "rows"), c("cols", "f")))
  expect_equal(res1, expected1)
})


test_that("aggregate_pieces_byname() works with repeated row labels not in aggregation_map", {
  # Ran into a bug where failure occurs if there are
  # repeated row (or column) names that are not included 
  # in the aggregation_map.
  a <- matrix(1:6, nrow = 3, ncol = 2, dimnames = list(c("a [from b]", "c [from d]", "c [from e]"), c("c1", "c2")))
  # This one already works, because we're aggregating the repeated row.
  res1 <- a %>% 
    aggregate_pieces_byname(piece = "noun",
                            margin = 1,
                            inf_notation = FALSE, 
                            notation = RCLabels::bracket_notation, 
                            aggregation_map = list(f = c("a", "c")))
  expected1 <- matrix(c(6, 15), nrow = 1, ncol = 2, dimnames = list("f", c("c1", "c2")))
  expect_equal(res1, expected1)
  # This one is failing, because we're not aggregating the repeated row.
  res2 <- a %>% 
    aggregate_pieces_byname(piece = "noun",
                            margin = 1,
                            inf_notation = FALSE, 
                            notation = RCLabels::bracket_notation, 
                            aggregation_map = list(f = c("a", "b")))
  expected2 <- matrix(c(5, 11,
                        1,  4), byrow = TRUE, nrow = 2, ncol = 2, dimnames = list(c("c", "f"), c("c1", "c2")))
  expect_equal(res2, expected2)
})


test_that("aggregate_pieces_byname() works with 2 notations", {
  # This works, when we are inferring notation
  a <- matrix(1:3, nrow = 3, ncol = 1, dimnames = list(c("a [from b]", "c -> d", "c -> e"), "c1"))
  res1 <- a %>% 
    aggregate_pieces_byname(piece = "noun")
  expected1 <- matrix(c(1, 5), nrow = 2, ncol = 1, dimnames = list(c("a", "c"), "c1"))
  expect_equal(res1, expected1)
  
  # However, this fails when we are specifying notation and not inferring.
  # The second notation (arrow notation) is not being renamed to the noun.
  res2 <- a %>% 
    aggregate_pieces_byname(piece = "noun", 
                            margin = 1,
                            notation = RCLabels::make_list(list(RCLabels::bracket_notation, RCLabels::arrow_notation), n = 1, lenx = 1), 
                            inf_notation = TRUE)
  expected2 <- expected1
  expect_equal(res2, expected2)
  
  # Try in a list
  res3 <- list(a, a) %>% 
    aggregate_pieces_byname(piece = "noun", 
                            margin = 1,
                            notation = RCLabels::make_list(list(RCLabels::bracket_notation, RCLabels::arrow_notation), n = 2, lenx = 1), 
                            inf_notation = TRUE)
  expected3 <- list(expected1, expected1)
  expect_equal(res3, expected3)
})

Try the matsbyname package in your browser

Any scripts or data that you put into this service are public.

matsbyname documentation built on May 29, 2024, 8:10 a.m.