Nothing
tests/testthat/test-Unary.R
In matsbyname: An Implementation of Matrix Mathematics that Respects Row and Column Names
test_that("abs_byname() works as expected", {
expect_equal(abs_byname(1), 1)
expect_equal(abs_byname(-1), 1)
m <- matrix(c(-10,1,1,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Commodity")
expect_equal(abs_byname(m), abs(m))
# Test with a Matrix object
M <- matsbyname::Matrix(c(-10,1,1,100), nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Commodity")
absM <- abs(M) |>
setrowtype("Industry") |> setcoltype("Commodity")
expect_equal(abs_byname(M), absM)
})
test_that("abs_byname() works with a matrix without dimnames or types", {
m <- matrix(c(-10,1,1,100), nrow = 2)
expect_equal(abs_byname(m), abs(m))
# Check speed: base is 1461x faster than byname
bench::mark(base = abs(m),
byname = abs_byname(m), relative = TRUE)
})
test_that("log_byname() works as expected", {
expect_equal(log_byname(exp(1)), 1)
m <- matrix(c(10,1,1,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(log_byname(m),
matrix(c(2.302585, 0,
0, 4.60517), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product"),
tolerance = 1e-7)
expected_log10 <- matrix(c(1, 0,
0, 2), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(log_byname(m, base = 10), expected_log10)
# Also works with lists
expect_equal(log_byname(list(m, m), base = 10), list(expected_log10, expected_log10))
})
test_that("log_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(10,1,1,100), nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
matsbyname:::expect_equal_matrix_or_Matrix(log_byname(M),
matsbyname::Matrix(c(2.302585, 0,
0, 4.60517), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product"),
tolerance = 1e-6)
expected_log10 <- matsbyname::Matrix(c(1, 0,
0, 2), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
matsbyname:::expect_equal_matrix_or_Matrix(log_byname(M, base = 10), expected_log10)
})
test_that("exp_byname() works as expected", {
expect_equal(exp_byname(1), exp(1))
m <- matrix(c(log(10), log(1),
log(1), log(100)),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expected <- matrix(c(10, 1,
1, 100), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(exp_byname(m), expected)
# Also works for lists.
expect_equal(exp_byname(list(m, m)), list(expected, expected))
})
test_that("exp_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(log(10), log(1),
log(1), log(100),
log(2), log(42)),
byrow = TRUE, nrow = 3, ncol = 2,
dimnames = list(paste0("i", 1:3), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
expectedM <- matrix(c(10, 1,
1, 100,
2, 42),
byrow = TRUE, nrow = 3, ncol = 2,
dimnames = list(c("i1", "i2", "i3"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
matsbyname:::expect_equal_matrix_or_Matrix(exp_byname(M), expectedM, tolerance = 1e-12)
# rownames(M) are same as colnames(M). Why? Because it is a symmetric matrix!
# This looks to be a bug in the Matrix package.
M2 <- matsbyname::Matrix(c(log(10), log(1),
log(1), log(100)),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
expectedM2 <- matrix(c(10, 1,
1, 100),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
res2 <- exp_byname(M2)
matsbyname:::expect_equal_matrix_or_Matrix(res2, expectedM2, tolerance = 1e-12)
})
test_that("invert_byname() works as expected", {
# Singular matrix
sing <- matrix(c(1, 0,
42, 0), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
expect_error(invert_byname(sing), regexp = "Attempt to invert a singular matrix. Zero rows and columns: c2.")
# Not a matrix
expect_error(invert_byname("not a matrix"), "'a' must be a numeric matrix")
m <- matrix(c(10,0,0,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# For matrix inversion, rows become columns and columns become rows.
# Furthermore, the types on rows and columns are flipped.
minv <- matrix(c(0.1, 0, 0, 0.01), nrow = 2, dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
expect_equal(invert_byname(m), minv)
expect_equal(matrixproduct_byname(m, invert_byname(m)),
matrix(c(1,0,0,1), nrow = 2, dimnames = list(rownames(m), rownames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(rowtype(m)))
expect_equal(matrixproduct_byname(invert_byname(m), m),
matrix(c(1,0,0,1), nrow = 2, dimnames = list(colnames(m), colnames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(invert_byname(list(m,m)), list(minv, minv))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1, "m"]] <- m
DF[[2, "m"]] <- m
expect_equal(invert_byname(DF$m), list(minv, minv))
DF_expected <- data.frame(m = I(list()), minv = I(list()))
DF_expected[[1, "m"]] <- m
DF_expected[[2, "m"]] <- m
DF_expected[[1, "minv"]] <- minv
DF_expected[[2, "minv"]] <- minv
# Because DF_expected$minv is created with I(list()), its class is "AsIs".
# Because DF$minv is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$minv to NULL to get a match.
attr(DF_expected$minv, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(minv = invert_byname(m)), DF_expected)
})
test_that("invert_byname() works correctly with a tol argument", {
m <- matrix(c(-3, 4,
2, 5), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
minv <- matrix(c(-5/23, 4/23,
2/23, 3/23), byrow = TRUE, nrow = 2, ncol = 2, dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
# Make sure the tol argument is, ahem, tolerated.
expect_equal(invert_byname(m), minv) # Default value of tol
expect_equal(invert_byname(m, tol = 1e-7), minv)
expect_equal(invert_byname(m, tol = 1e-10), minv)
expect_equal(invert_byname(m, tol = 1e-16), minv)
})
test_that("invert_byname() works correctly with the method argument", {
m <- matrix(c(4, -2, 1,
5, 0, 3,
-1, 2, 6), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(paste0("i", 1:3), paste0("p", 1:3))) %>%
setrowtype("Industries") %>% setcoltype("Products")
minv <- matrix(c( -3/26, 7/26, -3/26,
-33/52, 25/52, -7/52,
5/26, -3/26, 5/26), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
expect_error(invert_byname(m, method = "bogus"), regexp = "'arg' should be one of ")
expect_equal(invert_byname(m), minv)
expect_equal(invert_byname(m, method = "QR"), minv)
expect_equal(invert_byname(m, method = "SVD"), minv)
})
test_that("invert_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, -2, 1,
5, 0, 3,
-1, 2, 6), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(paste0("i", 1:3), paste0("p", 1:3)),
rowtype = "Industries", coltype = "Products")
Minv <- matrix(c( -3/26, 7/26, -3/26,
-33/52, 25/52, -7/52,
5/26, -3/26, 5/26), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(colnames(M), rownames(M))) %>%
setrowtype(coltype(M)) %>% setcoltype(rowtype(M))
expect_error(invert_byname(M, method = "bogus"), regexp = "'arg' should be one of ")
matsbyname:::expect_equal_matrix_or_Matrix(invert_byname(M), Minv, tolerance = 1e-15)
expect_true(is.Matrix(invert_byname(M, method = "solve")))
expect_false(is.matrix(invert_byname(M, method = "solve")))
resQR <- invert_byname(M, method = "QR")
matsbyname:::expect_equal_matrix_or_Matrix(resQR, Minv, tolerance = 1e-15)
expect_true(is.Matrix(resQR))
res_SVD <- invert_byname(M, method = "SVD")
matsbyname:::expect_equal_matrix_or_Matrix(res_SVD, Minv, tolerance = 1e-15)
expect_true(is.Matrix(res_SVD))
})
test_that("transpose_byname() works as expected", {
m <- matrix(c(11,21,31,12,22,32), ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mT <- matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, dimnames = list(paste0("p", 1:2), paste0("i", 1:3))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(transpose_byname(m), mT)
# Works for lists
expect_equal(transpose_byname(list(m,m)), list(mT, mT))
# Works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(transpose_byname(DF$m), list(mT, mT))
DF_expected <- data.frame(m = I(list()), mT = I(list()))
DF_expected[[1, "m"]] <- m
DF_expected[[2, "m"]] <- m
DF_expected[[1, "mT"]] <- mT
DF_expected[[2, "mT"]] <- mT
# Because DF_expected$mT is created with I(list()), its class is "AsIs".
# Because DF$mT is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mT to NULL to get a match.
attr(DF_expected$mT, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mT = transpose_byname(m)), DF_expected)
})
test_that("transpose_byname() works with lists of lists", {
m <- matrix(c(11,21,31,12,22,32), ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mT <- matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, dimnames = list(paste0("p", 1:2), paste0("i", 1:3))) %>%
setrowtype("Products") %>% setcoltype("Industries")
# Here, we put a list of matrices into subsequent rows of a column of a data frame.
# The unaryapply_byname function should recursively
# work its way down to the point where it finds matrices upon which it operates.
listofm <- list(a = m, b = m)
DF <- data.frame(listofm = I(list()))
DF[[1,"listofm"]] <- listofm
DF[[2,"listofm"]] <- listofm
res <- DF %>%
dplyr::mutate(
listofmT = transpose_byname(listofm)
)
expect_equal(res$listofmT[[1]][[1]], mT)
expect_equal(res$listofmT[[1]][[2]], mT)
expect_equal(res$listofmT[[2]][[1]], mT)
expect_equal(res$listofmT[[2]][[2]], mT)
# Ensure that names of the list are preserved
expect_equal(names(res$listofmT[[1]]), c("a", "b"))
expect_equal(names(res$listofmT[[2]]), c("a", "b"))
})
test_that("transpose_byname() correctly handles constants", {
expect_equal(transpose_byname(0), 0)
expect_true(!is.matrix(transpose_byname(0)))
expect_equal(transpose_byname(42), 42)
expect_equal(transpose_byname(-10), -10)
})
test_that("transpose_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(11,21,31,12,22,32), nrow = 3, ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
MT <- matsbyname::Matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, ncol = 3, dimnames = list(paste0("p", 1:2), paste0("i", 1:3)),
rowtype = "Products", coltype = "Industries")
expect_equal(transpose_byname(M), MT)
})
test_that("eigenvalues_byname() works as expected", {
m <- matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- c(4, 2, 0)
expect_equal(eigenvalues_byname(m), expected)
expect_equal(eigenvalues_byname(list(m, 2*m)), list(expected, 2*expected))
DF <- tibble::tibble(m_col = list(m, 2*m)) %>%
dplyr::mutate(
eigen_col = eigenvalues_byname(m_col)
)
expect_equal(DF$eigen_col[[1]], expected)
expect_equal(DF$eigen_col[[2]], 2*expected)
})
test_that("eigenvalues_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- c(4, 2, 0)
expect_equal(eigenvalues_byname(M), expected)
})
test_that("eigenvectors_byname() works as expected", {
m <- matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- matrix(c(0.457495711, 0.408248290, -0.577350269,
0.762492852, -0.816496581, -0.577350269,
-0.457495711, 0.408248290, 0.577350269), byrow = TRUE, nrow = 3, ncol = 3)
expect_equal(eigenvectors_byname(m), expected)
expect_equal(eigenvectors_byname(list(m, 2*m)), list(expected, expected))
DF <- tibble::tibble(m_col = list(m, 2*m)) %>%
dplyr::mutate(
eigen_col = eigenvectors_byname(m_col)
)
expect_equal(DF$eigen_col[[1]], expected)
expect_equal(DF$eigen_col[[2]], expected)
})
test_that("eigenvectors_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- matrix(c(0.457495711, 0.408248290, -0.577350269,
0.762492852, -0.816496581, -0.577350269,
-0.457495711, 0.408248290, 0.577350269), byrow = TRUE, nrow = 3, ncol = 3)
expect_equal(eigenvectors_byname(M), expected)
expect_equal(eigenvectors_byname(list(M, 2*M)), list(expected, expected))
})
test_that("svd_byname() works as expected", {
# Example from https://medium.com/intuition/singular-value-decomposition-svd-working-example-c2b6135673b5
test_func <- function(A_mat) {
D <- svd_byname(A_mat)
expected_D <- diag(c(sqrt(40), sqrt(10)))
rownames(expected_D) <- rownames(A_mat)
colnames(expected_D) <- colnames(A_mat)
expected_D <- expected_D %>%
setrowtype(rowtype(A_mat)) %>%
setcoltype(coltype(A_mat))
expect_equal(D, expected_D)
U <- svd_byname(A_mat, which = "u")
expected_U <- matrix(c(-1/sqrt(5), -2/sqrt(5),
-2/sqrt(5), 1/sqrt(5)), byrow = TRUE, nrow = 2, ncol = 2)
rownames(expected_U) <- rownames(A_mat)
colnames(expected_U) <- rownames(A_mat)
expected_U <- expected_U %>%
setrowtype(rowtype(A_mat)) %>%
setcoltype(rowtype(A_mat))
expect_equal(U, expected_U)
V <- svd_byname(A_mat, which = "v")
expected_V <- matrix(c(-1/sqrt(2), -1/sqrt(2),
1/sqrt(2), -1/sqrt(2)), byrow = TRUE, nrow = 2, ncol = 2)
rownames(expected_V) <- colnames(A_mat)
colnames(expected_V) <- colnames(A_mat)
expected_V <- expected_V %>%
setrowtype(coltype(A_mat)) %>%
setcoltype(coltype(A_mat))
expect_equal(V, expected_V)
# Double-check multiplication
should_be_A <- matrixproduct_byname(U, D) %>%
matrixproduct_byname(transpose_byname(V))
matsbyname:::expect_equal_matrix_or_Matrix(should_be_A, A_mat, tolerance = 1e-14)
}
# Try with a matrix object
A <- matrix(c(4, 0,
3, -5), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2"))) %>%
setrowtype("rowtype") %>% setcoltype("coltype")
test_func(A)
# Try with a Matrix object
AM <- matsbyname::Matrix(c(4, 0,
3, -5), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rowtype", coltype = "coltype")
# Does not work at present.
# Need to figure out how to do an SVD on a Matrix object
test_func(AM)
})
test_that("hatize_byname() works as expected", {
g <- matrix(4, dimnames = list("I", "Products"))
expect_error(hatize_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
expect_equal(hatize_byname(g, keep = "rownames"),
matrix(4, dimnames = list("I", "I")))
expect_equal(hatize_byname(g, keep = "colnames"),
matrix(4, dimnames = list("Products", "Products")))
v <- matrix(1:3, ncol = 1, dimnames = list(c(paste0("i", 1:3)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
# Try to hatize with the wrong keep argument
expect_error(hatize_byname(v, keep = "colnames"), 'In hatize_byname\\(\\), argument "keep" set to "colnames", but you supplied a column vector. Consider setting keep = "rownames".')
expect_error(hatize_byname(matrix(v, nrow = 1), keep = "rownames"), 'In hatize_byname\\(\\), argument "keep" set to "rownames", but you supplied a row vector. Consider setting keep = "colnames".')
# Try to hatize a list.
v_list <- list(v, v)
expected_m <- matrix(c(1, 0, 0,
0, 2, 0,
0, 0, 3), nrow = 3, byrow = TRUE,
dimnames = list(c("i1", "i2", "i3"), c("i1", "i2", "i3"))) %>%
setrowtype("Industries") %>% setcoltype("Industries")
expect_equal(hatize_byname(v_list, keep = "rownames"), list(expected_m, expected_m))
})
test_that("hatize_byname() works as expected", {
# Check the absurd situation where a non-vector is sent to hatize()
supposed_to_be_a_vector <- matrix(1:4, nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("c1", "c2")))
expect_error(hatize_byname(supposed_to_be_a_vector, keep = "rownames"),
'In hatize_byname\\(\\), matrix v must have at least 1 dimension of length 1.')
v <- matrix(1:10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
orderedRowNames <- c("i1", "i10", paste0("i", 2:9))
v_hat_expected <- matrix(c(1,0,0,0,0,0,0,0,0,0,
0,10,0,0,0,0,0,0,0,0,
0,0,2,0,0,0,0,0,0,0,
0,0,0,3,0,0,0,0,0,0,
0,0,0,0,4,0,0,0,0,0,
0,0,0,0,0,5,0,0,0,0,
0,0,0,0,0,0,6,0,0,0,
0,0,0,0,0,0,0,7,0,0,
0,0,0,0,0,0,0,0,8,0,
0,0,0,0,0,0,0,0,0,9),
nrow = 10,
dimnames = list(orderedRowNames, orderedRowNames)) %>%
setrowtype(rowtype(v)) %>% setcoltype(rowtype(v))
r <- matrix(1:5, nrow = 1, dimnames = list("i1", paste0("p", 1:5))) %>%
setrowtype(NA) %>% setcoltype("Commodities")
orderedColNames <- paste0("p", 1:5)
r_hat_expected <- matrix(c(1,0,0,0,0,
0,2,0,0,0,
0,0,3,0,0,
0,0,0,4,0,
0,0,0,0,5),
nrow = 5,
dimnames = list(orderedColNames, orderedColNames)) %>%
setrowtype(coltype(r)) %>% setcoltype(coltype(r))
expect_equal(hatize_byname(r, keep = "colnames"), r_hat_expected)
# This also works with lists.
expect_equal(hatize_byname(list(v, v), keep = "rownames"), list(v_hat_expected, v_hat_expected))
# And it works with data frames.
DF <- data.frame(v = I(list()))
DF[[1,"v"]] <- v
DF[[2,"v"]] <- v
expect_equal(hatize_byname(DF$v, keep = "rownames"), list(v_hat_expected, v_hat_expected))
DF_expected <- data.frame(v = I(list()), v_hat = I(list()))
DF_expected[[1,"v"]] <- v
DF_expected[[2,"v"]] <- v
DF_expected[[1,"v_hat"]] <- v_hat_expected
DF_expected[[2,"v_hat"]] <- v_hat_expected
# Because DF_expected$v_hat is created with I(list()), its class is "AsIs".
# Because DF$v_hat is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$v_hat to NULL to get a match.
attr(DF_expected$v_hat, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(v_hat = hatize_byname(v, keep = "rownames")), DF_expected)
})
test_that("hatize_byname() works with a simple vector", {
# I'm running into a bug where hatize doesn't work on a 1x1 vector that lacks a column name
# Verify that a 2x1 vector works correctly.
v1 <- matrix(c(1,
2), nrow = 2, ncol = 1, dimnames = list(c("r1", "r2"))) %>%
setrowtype("Product -> Industry")
v1_hat <- hatize_byname(v1, keep = "rownames")
v1_hat_expected <- matrix(c(1, 0,
0, 2), nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("r1", "r2"))) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
expect_equal(v1_hat, v1_hat_expected)
# Now try with a 1x1 column vector
v2 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1")) %>%
setrowtype("Product -> Industry")
v2_hat <- hatize_byname(v2, keep = "rownames")
v2_hat_expected <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1", "r1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
expect_equal(v2_hat, v2_hat_expected)
# Try with a 1x1 row vector
v3 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(NULL, "c1")) %>%
setcoltype("Industry -> Product")
v3_hat <- hatize_byname(v3, keep = "colnames")
v3_hat_expected <- matrix(42, nrow = 1, ncol = 1, dimnames = list("c1", "c1")) %>%
setrowtype("Industry -> Product") %>%
setcoltype("Industry -> Product")
expect_equal(v3_hat, v3_hat_expected)
# Try with 1x1 vector with both dimensions named.
# This should fail, because rownames or colnames must be specified in the keep argument.
v4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Industry -> Product")
expect_error(hatize_byname(v4), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
expect_equal(hatize_byname(v4, keep = "rownames"), matrix(42, dimnames = list("r1", "r1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry"))
expect_equal(hatize_byname(v4, keep = "colnames"), matrix(42, dimnames = list("c1", "c1")) %>%
setrowtype("Industry -> Product") %>%
setcoltype("Industry -> Product"))
})
test_that("hatize_byname() issues a warning when keep is wrong", {
v <- matrix(c(1, 2), nrow = 2, dimnames = list(c("r1", "r2"), "c1"))
expect_equal(hatize_byname(v, keep = "rownames"), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("r1", "r2"))))
expect_equal(hatize_byname(v), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("r1", "r2"))))
expect_error(hatize_byname(v, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
r <- matrix(c(1, 2), ncol = 2, dimnames = list("r1", c("c1", "c2")))
expect_equal(hatize_byname(r, keep = "colnames"), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("c1", "c2"), c("c1", "c2"))))
expect_error(hatize_byname(r, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
})
test_that("hatize_byname() works with a Matrix vector", {
v1 <- matsbyname::Matrix(c(1,
2), nrow = 2, ncol = 1, dimnames = list(c("r1", "r2"), c("c1")),
rowtype = "Product -> Industry")
v1_hat <- hatize_byname(v1, keep = "rownames")
v1_hat_expected <- matrix(c(1, 0,
0, 2), nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("r1", "r2"))) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
matsbyname:::expect_equal_matrix_or_Matrix(v1_hat, v1_hat_expected)
expect_true(inherits(v1_hat, "ddiMatrix"))
v2 <- matsbyname::Matrix(1:10, nrow = 10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1")),
rowtype = "Industries", coltype = NA)
orderedRowNames <- c("i1", "i10", paste0("i", 2:9))
v2_hat_expected <- matsbyname::Matrix(c(1,0,0,0,0,0,0,0,0,0,
0,10,0,0,0,0,0,0,0,0,
0,0,2,0,0,0,0,0,0,0,
0,0,0,3,0,0,0,0,0,0,
0,0,0,0,4,0,0,0,0,0,
0,0,0,0,0,5,0,0,0,0,
0,0,0,0,0,0,6,0,0,0,
0,0,0,0,0,0,0,7,0,0,
0,0,0,0,0,0,0,0,8,0,
0,0,0,0,0,0,0,0,0,9),
nrow = 10, ncol = 10,
dimnames = list(orderedRowNames, orderedRowNames),
rowtype = "Industries", coltype = "Industries")
res2 <- hatize_byname(v2)
matsbyname:::expect_equal_matrix_or_Matrix(res2, v2_hat_expected)
r <- matsbyname::Matrix(1:5, nrow = 1, ncol = 5, dimnames = list("i1", paste0("p", 1:5)),
rowtype = NA, coltype = "Industries")
orderedColNames <- paste0("p", 1:5)
r_hat_expected <- matsbyname::Matrix(c(1,0,0,0,0,
0,2,0,0,0,
0,0,3,0,0,
0,0,0,4,0,
0,0,0,0,5),
nrow = 5, ncol = 5,
dimnames = list(orderedColNames, orderedColNames),
rowtype = coltype(r), coltype = coltype(r))
matsbyname:::expect_equal_matrix_or_Matrix(hatize_byname(r, keep = "colnames"), r_hat_expected)
})
test_that("hatize_byname() tests hit all lines of code", {
v1 <- matrix(c(42), nrow = 1, ncol = 1)
expect_error(hatize_byname(v1), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
v2 <- matrix(c(42), nrow = 1, ncol = 1, dimnames = list("r1"))
expect_error(hatize_byname(v2, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
expect_error(hatize_byname(NA), "argument is of length zero")
expect_null(hatize_byname(NULL))
})
test_that("hatinv_byname() works as expected", {
# Test with a column vector
v <- matrix(1:10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
res <- hatinv_byname(v, keep = "rownames")
expected <- v %>%
hatize_byname(keep = "rownames") %>%
invert_byname()
expect_equal(res, expected)
# Test with a row vector
r <- matrix(1:5, nrow = 1, dimnames = list(c("r1"), c(paste0("c", 1:5)))) %>%
setrowtype(NA) %>% setcoltype("Commodities")
expect_equal(hatinv_byname(r, keep = "colnames"), r %>% hatize_byname(keep = "colnames") %>% invert_byname())
# Test with a list
v_list <- list(v, v)
expect_equal(hatinv_byname(v_list, keep = "rownames"), v_list %>% hatize_byname(keep = "rownames") %>% invert_byname())
# Test with a data frame
DF <- data.frame(v_list = I(list()))
DF[[1, "v_list"]] <- v
DF[[2, "v_list"]] <- v
DF <- DF %>%
dplyr::mutate(
hatinv = hatinv_byname(v_list, keep = "rownames")
)
DF_expected <- data.frame(v_list = I(list()), hatinv = I(list()))
DF_expected[[1, "v_list"]] <- v
DF_expected[[2, "v_list"]] <- v
DF_expected[[1, "hatinv"]] <- v %>% hatize_byname(keep = "rownames") %>% invert_byname()
DF_expected[[2, "hatinv"]] <- v %>% hatize_byname(keep = "rownames") %>% invert_byname()
# The hatinv column of DF_expected will have matrix_class = 'AsIs', but
# the hatinv column of DF will have no class attribute.
# Eliminate that mismatch.
attr(DF_expected$hatinv, which = "class") <- NULL
expect_equal(DF, DF_expected)
# Test when one of the elements of v is 0.
v2 <- matrix(0:1, ncol = 1, dimnames = list(c(paste0("i", 0:1)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
expect_equal(hatinv_byname(v2, keep = "rownames"), matrix(c(.Machine$double.xmax, 0,
0, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c(paste0("i", 0:1)), c(paste0("i", 0:1)))) %>%
setrowtype("Industries") %>% setcoltype("Industries"))
# Test when we want the 0 element of v to give Inf instead of .Machine$double.xmax.
expect_equal(hatinv_byname(v2, inf_becomes = NULL, keep = "rownames"), matrix(c(Inf, 0,
0, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c(paste0("i", 0:1)), c(paste0("i", 0:1)))) %>%
setrowtype("Industries") %>% setcoltype("Industries"))
# Test that hatinv works with a 1x1 vector
g <- matrix(4, dimnames = list("I", "Products"))
expect_error(hatinv_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
})
test_that("hatinv_byname() works with a Matrix object", {
# Test with a column vector
v <- matsbyname::Matrix(1:10, nrow = 10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1")),
rowtype = "Industries", coltype = NA)
res <- hatinv_byname(v, keep = "rownames")
expected <- v %>%
hatize_byname(keep = "rownames") %>%
invert_byname()
expect_equal(res, expected)
# Test with a row vector
r <- matsbyname::Matrix(1:5, nrow = 1, ncol = 5, dimnames = list(c("r1"), c(paste0("c", 1:5))),
rowtype = NA, coltype = "Commodities")
expect_equal(hatinv_byname(r, keep = "colnames"),
r %>%
hatize_byname(keep = "colnames") %>%
invert_byname())
# Test that hatinv works with a 1x1 Matrix
g <- matsbyname::Matrix(4, dimnames = list("I", "Products"))
expect_error(hatinv_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
})
test_that("identize_byname() works as expected", {
# Try first with a single number
expect_equal(identize_byname(42), 1)
# Now try with matrices.
m <- matrix(1:16, ncol = 4, dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = dimnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
# Test for errors
expect_error(identize_byname(m, margin = c(1,2,3,4)), "margin should have length 1 or 2 in identize_byname")
expect_error(identize_byname(m, margin = c(3)), "Unknown margin 3 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m, margin = c(-1)), "Unknown margin -1 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m, margin = c(1,1,2,2)), "margin should have length 1 or 2 in identize_byname")
# Test for column vector
expect_equal(identize_byname(m, margin = 1),
matrix(1, nrow = nrow(m), ncol = 1) %>%
setrownames_byname(rownames(m)) %>% setcolnames_byname(coltype(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Test for row vector
expect_equal(identize_byname(m, margin = 2),
matrix(1, nrow = 1, ncol = ncol(m)) %>%
setrownames_byname(rowtype(m)) %>% setcolnames_byname(colnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Test for identity matrix
expect_equal(identize_byname(m), mI_expected)
expect_equal(identize_byname(m, margin = c(1,2)), mI_expected)
expect_equal(identize_byname(m, margin = c(2,1)), mI_expected)
# This also works with lists
expect_equal(identize_byname(list(m, m, m)), list(mI_expected, mI_expected, mI_expected))
# This also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(identize_byname(DF$m, margin = list(c(1, 2))), list(mI_expected, mI_expected))
expect_equal(identize_byname(DF$m, margin = list(c(1,2))), list(mI_expected, mI_expected))
expect_equal(identize_byname(DF$m, margin = list(c(2,1))), list(mI_expected, mI_expected))
DF_expected <- data.frame(m = I(list()), mI = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mI"]] <- mI_expected
DF_expected[[2,"mI"]] <- mI_expected
# Because DF_expected$mI is created with I(list()), its class is "AsIs".
# Because DF$mI is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mI to NULL to get a match.
attr(DF_expected$mI, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mI = identize_byname(m, margin = list(c(1, 2)))), DF_expected)
})
test_that("identize_byname() works with a Matrix object", {
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Try with matrices.
m <- matsbyname::Matrix(42, nrow = 4, ncol = 4,
dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4)),
rowtype = "Industries", coltype = "Products")
res <- identize_byname(m)
matsbyname:::expect_equal_matrix_or_Matrix(res, mI_expected)
m1 <- matsbyname::Matrix(1:16, nrow = 4, ncol = 4, dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4)),
rowtype = "Industries", coltype = "Products")
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = dimnames(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1))
# Test for errors
expect_error(identize_byname(m1, margin = c(1,2,3,4)), "margin should have length 1 or 2 in identize_byname")
expect_error(identize_byname(m1, margin = c(3)), "Unknown margin 3 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m1, margin = c(-1)), "Unknown margin -1 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m1, margin = c(1,1,2,2)), "margin should have length 1 or 2 in identize_byname")
# Test for column vector
res <- identize_byname(m1, margin = 1)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res,
matrix(1, nrow = nrow(m1), ncol = 1) %>%
setrownames_byname(rownames(m1)) %>% setcolnames_byname(coltype(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1)))
# Test for row vector
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = 2),
matrix(1, nrow = 1, ncol = ncol(m1)) %>%
setrownames_byname(rowtype(m1)) %>% setcolnames_byname(colnames(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1)))
# Test for identity matrix
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1), mI_expected)
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = c(1,2)), mI_expected)
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = c(2,1)), mI_expected)
})
test_that("vectorize_byname() works as expected", {
# Try with a square matrix
m1 <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected1 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
expect_equal(actual1, expected1)
# Try with null notation
expect_equal(vectorize_byname(m1, notation = NULL), m1)
# Try with a rectangular matrix
m2 <- matrix(c(1, 2, 3,
4, 5, 6),
nrow = 2, ncol = 3, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2", "i3"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected2 <- matrix(c(1,
4,
2,
5,
3,
6),
nrow = 6, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2", "p1 -> i3", "p2 -> i3"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual2 <- vectorize_byname(m2, notation = RCLabels::arrow_notation)
expect_equal(actual2, expected2)
# Try with a single number
m3 <- 42
expected3 <- m3
dim(expected3) <- c(1, 1)
dimnames(expected3) <- NULL
actual3 <- vectorize_byname(m3, notation = RCLabels::arrow_notation)
expect_equal(actual3, expected3)
# Try with a different separator
m4 <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected4 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1---i1", "p2---i1", "p1---i2", "p2---i2"))) %>%
setrowtype("Products---Industries") %>% setcoltype(NULL)
actual4 <- vectorize_byname(m4, notation = RCLabels::notation_vec(sep = "---"))
expect_equal(actual4, expected4)
# Test with a matrix that is already a column vector
m5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1", "p2", "p3"), "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
actual5 <- vectorize_byname(m5, notation = RCLabels::notation_vec(sep = "***"))
expected5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1***i1", "p2***i1", "p3***i1"))) %>%
setrowtype("Products***Industries") %>% setcoltype(NULL)
expect_equal(actual5, expected5)
# Test with NULL. Should get NULL back.
expect_null(vectorize_byname(NULL, NULL))
# Test with NA.
expect_error(vectorize_byname(NA, notation = RCLabels::arrow_notation), "a is not numeric or a Matrix in vectorize_byname")
# Test with string
expect_error(vectorize_byname("a", notation = RCLabels::arrow_notation), "a is not numeric or a Matrix in vectorize_byname")
# Test with a list of matrices
list6 <- list(m1, m1)
actual6 <- vectorize_byname(list6, notation = list(RCLabels::arrow_notation))
expected6 <- list(expected1, expected1)
expect_equal(actual6, expected6)
})
test_that("vectorize_byname() works with 4 matrices in a list", {
m <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
l <- list(m, m, m, m)
actual <- vectorize_byname(l, notation = list(RCLabels::arrow_notation))
e <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
expect_equal(actual, list(e, e, e, e))
})
test_that("vectorize_byname() works with Matrix objects", {
# Try with a square Matrix
m1 <- matsbyname::Matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expected1 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
matsbyname:::expect_equal_matrix_or_Matrix(actual1, expected1)
# Try with a rectangular matrix
m2 <- matsbyname::Matrix(c(1, 2, 3,
4, 5, 6),
nrow = 2, ncol = 3, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2", "i3")),
rowtype = "Products", coltype = "Industries")
expected2 <- matrix(c(1,
4,
2,
5,
3,
6),
nrow = 6, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2", "p1 -> i3", "p2 -> i3"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual2 <- vectorize_byname(m2, notation = RCLabels::arrow_notation)
matsbyname:::expect_equal_matrix_or_Matrix(actual2, expected2)
# Test with a Matrix that is already a column vector
m5 <- matsbyname::Matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1", "p2", "p3"), "i1"),
rowtype = "Products", coltype = "Industries")
actual5 <- vectorize_byname(m5, notation = RCLabels::notation_vec(sep = "***"))
expected5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1***i1", "p2***i1", "p3***i1"))) %>%
setrowtype("Products***Industries") %>% setcoltype(NULL)
matsbyname:::expect_equal_matrix_or_Matrix(actual5, expected5)
})
test_that("matricize_byname() works as expected", {
v1 <- array(dim = c(2, 2, 2))
expect_error(matricize_byname(v1, notation = RCLabels::arrow_notation), "== 2 in matricize_byname")
# Try with a column vector
v2 <- matrix(c(1,
2,
3,
4),
nrow = 4, ncol = 1, dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries")
actual2 <- matricize_byname(v2, notation = RCLabels::arrow_notation)
expected2 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual2, expected2)
# Try with a row vector
v3 <- matrix(c(1, 2, 3, 4),
nrow = 1, ncol = 4, dimnames = list(NULL, c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setcoltype("Products -> Industries")
actual3 <- matricize_byname(v3, notation = RCLabels::arrow_notation)
expected3 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual3, expected3)
# Try with a 1x1 matrix as a column vector.
v4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(c("p2 -> i1"))) %>%
setrowtype("Products -> Industries")
actual4 <- matricize_byname(v4, notation = RCLabels::arrow_notation)
expected4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("p2", "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual4, expected4)
# Try with a 1x1 matrix as a row vector.
v5 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(NULL, c("p2 -> i1"))) %>%
setcoltype("Products -> Industries")
actual5 <- matricize_byname(v5, notation = RCLabels::arrow_notation)
expected5 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("p2", "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual5, expected5)
# Try with a non-square result
v6 <- matrix(c(1, 2, 3, 4, 5, 6),
nrow = 1, ncol = 6, dimnames = list(NULL, c("p1 -> i1", "p1 -> i2",
"p2 -> i1", "p2 -> i2",
"p3 -> i1", "p3 -> i2"))) %>%
setcoltype("Products -> Industries")
actual6 <- matricize_byname(v6, notation = RCLabels::arrow_notation)
expected6 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual6, expected6)
})
test_that("matricize_byname() works with Matrix objects", {
# Try with a column vector that is a Matrix object
v2 <- matsbyname::Matrix(c(1,
2,
3,
4),
nrow = 4, ncol = 1, dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"), NULL),
rowtype = "Products -> Industries")
actual2 <- matricize_byname(v2, notation = RCLabels::arrow_notation)
expected2 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
matsbyname:::expect_equal_matrix_or_Matrix(actual2, expected2)
expect_true(is.Matrix(actual2))
})
test_that("matricize_byname() coltype work correctly when input rowtype is NULL", {
# On 17 October 2023, Emmanuel and I noticed that some NULL-type matrices
# were showing coltype = list() after matricize.
am_vec <- matrix(data = c(1:2), nrow = 2, dimnames = list(c("p1 -> i1", "p2 -> i2"), c("onecol"))) |>
setrowtype(NULL) |> setcoltype("coltype_am")
am_mat <- matricize_byname(am_vec, notation = RCLabels::arrow_notation)
expect_null(rowtype(am_mat))
expect_null(coltype(am_mat))
aM_vec <- Matrix::Matrix(data = c(1:2), nrow = 2, dimnames = list(c("p1 -> i1", "p2 -> i2"), c("onecol"))) |>
setrowtype(NULL) |> setcoltype("coltype_aM")
aM_mat <- matricize_byname(aM_vec, notation = RCLabels::arrow_notation)
expect_null(rowtype(aM_mat))
expect_null(coltype(aM_mat))
})
test_that("vectorize_byname() and matricize_byname() are inverses of each other", {
m1 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
v1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
m2 <- matricize_byname(v1, notation = RCLabels::arrow_notation)
expect_equal(m2, m1)
v3 <- transpose_byname(v1)
m4 <- matricize_byname(v3, notation = RCLabels::arrow_notation)
expect_equal(m4, m1)
# Try with a Matrix object.
M1 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
V1 <- vectorize_byname(M1, notation = RCLabels::arrow_notation)
M2 <- matricize_byname(V1, notation = RCLabels::arrow_notation)
expect_equal(M2, M1)
V3 <- transpose_byname(V1)
M4 <- matricize_byname(V3, notation = RCLabels::arrow_notation)
expect_equal(M4, M1)
})
test_that("fractionze_byname() works as expected", {
M <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_rows <- matrix(c(1/6, 5/6,
4/9, 5/9),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_cols <- matrix(c(1/5, 5/10,
4/5, 5/10),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_sumall <- matrix(c(1/15, 5/15,
4/15, 5/15),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
# Test for errors
expect_error(fractionize_byname(M, margin = c(2,2,1,1,0)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(2,2,1,1)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(1,1)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(2,2)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(1,2,3)), "margin should have length 1 or 2 in fractionize_byname")
expect_error(fractionize_byname(M, margin = 3), "Unknown margin 3 in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(3,4)), "Unknown margin")
expect_error(fractionize_byname(M, margin = -1), "Unknown margin")
# Test with a single number
expect_equal(fractionize_byname(2, margin = 1), 1)
expect_equal(fractionize_byname(-1, margin = 2), 1)
expect_equal(fractionize_byname(-5000, margin = c(1,2)), 1)
expect_equal(fractionize_byname(0, margin = 1), .Machine$double.xmax)
# Test dividing by row sums
expect_equal(fractionize_byname(M, margin = 1), expectedM_rows)
# Test dividing by column sums
expect_equal(fractionize_byname(M, margin = 2), expectedM_cols)
# Test dividing by sum of all entries
expect_equal(fractionize_byname(M, margin = c(1,2)), expectedM_sumall)
expect_equal(fractionize_byname(M, margin = c(2,1)), expectedM_sumall)
# Should also work for lists
expect_equal(fractionize_byname(list(M,M), margin = 1), list(expectedM_rows, expectedM_rows))
# Should also work for data frames
DF <- data.frame(case = I(list()), M = I(list()))
DF[[1, "case"]] <- 1
DF[[1, "case"]] <- 2
DF[[1, "M"]] <- M
DF[[2, "M"]] <- M
DF2 <- DF %>%
dplyr::mutate(
F_row = fractionize_byname(M, margin = 1),
F_col = fractionize_byname(M, margin = 2),
F_tot = fractionize_byname(M, margin = list(c(2,1)))
)
expect_equal(DF2$F_row, list(expectedM_rows, expectedM_rows))
expect_equal(DF2$F_col, list(expectedM_cols, expectedM_cols))
expect_equal(DF2$F_tot, list(expectedM_sumall, expectedM_sumall))
# Test when a column contains zeroes
Mzerocol <- matrix(c(1, 0,
2, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzerocol, margin = c(1,2)),
matrix(c(1/3, 0,
2/3, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerocol, margin = 1),
matrix(c(1, 0,
1, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# Verify that the zero column now works and gives NaNs.
expect_equal(fractionize_byname(Mzerocol, margin = 2, inf_becomes = Inf),
matrix(c(1/3, 0/0,
2/3, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# But if we clean the matrix first, we will also get something that makes sense.
expect_equal(fractionize_byname(clean_byname(Mzerocol, margin = 2), margin = 2),
matrix(c(1/3,
2/3),
nrow = 2, ncol = 1, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1"))))
# Test when rows are zero.
Mzerorow <- matrix(c(0, 0,
1, 2),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzerorow, margin = c(1,2)),
matrix(c(0, 0,
1/3, 2/3),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerorow, margin = 1, inf_becomes = NaN),
matrix(c(0/0, 0/0,
1/3, 2/3),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerorow, margin = 2),
matrix(c(0, 0,
1, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# Test when everything is zero
Mzero <- matrix(c(0, 0,
0, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzero, margin = 1, inf_becomes = NaN),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzero, margin = 2, inf_becomes = NaN),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzero, margin = c(1,2)),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
})
test_that("fractionize_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_rows <- matsbyname::Matrix(c(1/6, 5/6,
4/9, 5/9),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_cols <- matsbyname::Matrix(c(1/5, 5/10,
4/5, 5/10),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_sumall <- matsbyname::Matrix(c(1/15, 5/15,
4/15, 5/15),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
# Test dividing by row sums
expect_equal(fractionize_byname(M, margin = 1), expectedM_rows)
# Test dividing by column sums
expect_equal(fractionize_byname(M, margin = 2), expectedM_cols)
# Test dividing by sum of all entries
expect_equal(fractionize_byname(M, margin = c(1,2)), expectedM_sumall)
expect_equal(fractionize_byname(M, margin = c(2,1)), expectedM_sumall)
})
test_that("fractionize_byname() works with a single number 0", {
expect_equal(fractionize_byname(0, margin = c(1, 2)), .Machine$double.xmax)
})
test_that("rowsums_byname() works as expected", {
m_rownames <- paste0("i", 1:4)
m_colnames <- paste0("p", 1:4)
m <- matrix(1:16, ncol = 4, dimnames = list(m_rownames, m_colnames)) %>%
setrowtype("Industries") %>% setcoltype("Products")
expect_error(rowsums_byname("bogus"), "Unknown type for 'a' in rowsums_byname")
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Note, columns are sorted by name after rowsums_byname
rowsumsm_expected <- matrix(c(9, 7, 5), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(rowsums_byname(m), rowsumsm_expected)
expect_equal(rowsums_byname(m, "E.ktoe"), rowsumsm_expected %>% setcolnames_byname("E.ktoe"))
# This also works with lists
expect_equal(rowsums_byname(list(m, m)), list(rowsumsm_expected, rowsumsm_expected))
expect_equal(rowsums_byname(list(m, m), "E.ktoe"),
list(rowsumsm_expected %>% setcolnames_byname("E.ktoe"),
rowsumsm_expected %>% setcolnames_byname("E.ktoe")))
rowsum_expected_no_colname <- rowsumsm_expected %>%
magrittr::set_colnames(NULL)
expect_equal(rowsums_byname(list(m, m), NULL), list(rowsum_expected_no_colname, rowsum_expected_no_colname))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(rowsums_byname(DF$m), list(rowsumsm_expected, rowsumsm_expected))
DF_expected <- data.frame(m = I(list()), mi = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mi"]] <- rowsumsm_expected
DF_expected[[2,"mi"]] <- rowsumsm_expected
# Because DF_expected$mi is created with I(list()), its class is "AsIs".
# Because DF$mi is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mi to NULL to get a match.
attr(DF_expected$mi, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mi = rowsums_byname(m)), DF_expected)
})
test_that("rowsums_byname() works with single numbers and matrices", {
expect_equal(rowsums_byname(1), 1)
expect_equal(rowsums_byname(matrix(1)), matrix(1))
expect_equal(rowsums_byname(list(1, 42)), list(1, 42))
expect_equal(rowsums_byname(list(matrix(c(1, 42)), matrix(c(2, 43)))), list(matrix(c(1, 42)), matrix(c(2, 43))))
})
test_that("rowsums_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
# Note, columns are sorted by name after rowsums_byname()
rowsumsM_expected <- matrix(c(9, 7, 5), nrow = 3, ncol = 1, dimnames = list(paste0("i", 1:3), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- rowsums_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, rowsumsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(rowsums_byname(M, "E.ktoe"), rowsumsM_expected %>% setcolnames_byname("E.ktoe"))
})
test_that("colsums_byname() works as expected", {
expect_error(colsums_byname("bogus"), "Unknown type for 'a' in colsums_byname")
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
colsumsm_expected <- matrix(c(6, 15), nrow = 1, dimnames = list(rowtype(m), colnames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(colsums_byname(m), colsumsm_expected)
expect_equal(colsums_byname(m, "E.ktoe"), colsumsm_expected %>% setrownames_byname("E.ktoe"))
# This also works with lists
expect_equal(colsums_byname(list(m, m)), list(colsumsm_expected, colsumsm_expected))
expect_equal(colsums_byname(list(m, m), "E.ktoe"),
list(colsumsm_expected %>% setrownames_byname("E.ktoe"),
colsumsm_expected %>% setrownames_byname("E.ktoe")))
colsum_expected_no_colname <- colsumsm_expected %>%
magrittr::set_rownames(NULL)
expect_equal(colsums_byname(list(m, m), NULL), list(colsum_expected_no_colname, colsum_expected_no_colname))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(colsums_byname(DF$m), list(colsumsm_expected, colsumsm_expected))
DF_expected <- data.frame(m = I(list()), iTm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"iTm"]] <- colsumsm_expected
DF_expected[[2,"iTm"]] <- colsumsm_expected
# Because DF_expected$iTm is created with I(list()), its class is "AsIs".
# Because DF$iTm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$iTm to NULL to get a match.
attr(DF_expected$iTm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(iTm = colsums_byname(m)), DF_expected)
})
test_that("colsums_byname() works with single numbers and matrices", {
expect_equal(colsums_byname(1), 1)
expect_equal(colsums_byname(matrix(1)), matrix(1))
expect_equal(colsums_byname(list(1, 42)), list(1, 42))
expect_equal(colsums_byname(list(matrix(c(1, 42)), matrix(c(2, 43)))), list(matrix(43), matrix(45)))
})
test_that("colsums_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
colsumsM_expected <- matrix(c(6, 15), nrow = 1, dimnames = list(rowtype(M), colnames(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- colsums_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, colsumsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(colsums_byname(M, "E.ktoe"), colsumsM_expected %>% setrownames_byname("E.ktoe"))
})
test_that("sumall_byname() works as expected", {
expect_error(sumall_byname("bogus"), "Unknown type for 'a' in sumall_byname")
m <- matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Commodity")
expect_equal(sumall_byname(m), 8)
expect_equal(m %>% rowsums_byname %>% colsums_byname,
matrix(8, nrow = 1, ncol = 1, dimnames = list(rowtype(m), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(sumall_byname(list(m,m)), list(8, 8))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(sumall_byname(DF$m), list(8,8))
DF_expected <- data.frame(m = I(list()), summ = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"summ"]] <- 8
DF_expected[[2,"summ"]] <- 8
# Because DF_expected$summ is created with I(list()), its class is "AsIs".
# Because DF$summ is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$summ to NULL to get a match.
attr(DF_expected$summ, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(summ = sumall_byname(m)), DF_expected)
})
test_that("sumall_byname() works for single numbers", {
expect_equal(sumall_byname(matrix(1)), 1)
expect_equal(sumall_byname(list(matrix(1), matrix(42))), list(1, 42))
expect_equal(sumall_byname(1), 1)
expect_equal(sumall_byname(1), 1)
})
test_that("sumall_byname() works with Matrix objects", {
M <- matsbyname::Matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Commodity")
res <- sumall_byname(M)
expect_equal(res, 8)
matsbyname:::expect_equal_matrix_or_Matrix(M %>% rowsums_byname %>% colsums_byname,
matrix(8, nrow = 1, ncol = 1, dimnames = list(rowtype(M), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M)))
})
test_that("sum_byname() and sumall_byname() behave same with NULL", {
expect_equal(sum_byname(0, 0), 0)
expect_equal(sum_byname(1, 0), 1)
expect_equal(sum_byname(1, NULL), 1)
# I wish this were 0, but can't figure out how to make it so at the moment.
# This result is inconsistent with sum_byname(NULL, NULL) returning 0.
# expect_true(sum_byname(NULL), 0)
expect_null(sum_byname(NULL))
expect_equal(sum_byname(NULL, NULL), 0)
expect_equal(sum_byname(NULL, NULL, NULL), 0)
# Again, it seems like this should return 0, but it does not currently.
# expect_equal(sumall_byname(NULL), 0)
expect_null(sumall_byname(NULL))
# expect_equal(sumall_byname(list(NULL, NULL)), list(0, 0))
expect_equal(sum_byname(list(NULL, NULL)), list(NULL, NULL))
expect_equal(sumall_byname(matrix(0, nrow = 1, ncol = 1)), 0)
expect_equal(sumall_byname(matrix(1, nrow = 1, ncol = 1)), 1)
})
test_that("rowprods_byname() works as expected", {
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Note, columns are sorted by name after rowprods_byname
rowprodsm_expected <- matrix(c(18, 10, 4), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(rowprods_byname(m), rowprodsm_expected)
expect_equal(rowprods_byname(m, "E.ktoe"), rowprodsm_expected %>% setcolnames_byname("E.ktoe"))
# This also works with lists
expect_equal(rowprods_byname(list(m, m)), list(rowprodsm_expected, rowprodsm_expected))
expect_equal(rowprods_byname(list(m, m), "E.ktoe"),
list(rowprodsm_expected %>% setcolnames_byname("E.ktoe"),
rowprodsm_expected %>% setcolnames_byname("E.ktoe")))
expect_equal(rowprods_byname(list(m, m), NULL), list(rowprodsm_expected, rowprodsm_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(rowprods_byname(DF$m), list(rowprodsm_expected, rowprodsm_expected))
DF_expected <- data.frame(m = I(list()), mi = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mi"]] <- rowprodsm_expected
DF_expected[[2,"mi"]] <- rowprodsm_expected
# Because DF_expected$mi is created with I(list()), its class is "AsIs".
# Because DF$mi is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mi to NULL to get a match.
attr(DF_expected$mi, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mi = rowprods_byname(m)), DF_expected)
})
test_that("rowprods_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
# Note, columns are sorted by name after rowprods_byname
rowprodsM_expected <- matrix(c(18, 10, 4), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- rowprods_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, rowprodsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(rowprods_byname(M, "E.ktoe"), rowprodsM_expected %>% setcolnames_byname("E.ktoe"))
})
test_that("colprods_byname() works as expected", {
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
colprodsm_expected <- matrix(c(6, 120), nrow = 1, dimnames = list(rowtype(m), colnames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(colprods_byname(m), colprodsm_expected)
expect_equal(colprods_byname(m, "E.ktoe"), colprodsm_expected %>% setrownames_byname("E.ktoe"))
# This also works with lists
expect_equal(colprods_byname(list(m, m)), list(colprodsm_expected, colprodsm_expected))
expect_equal(colprods_byname(list(m, m), "E.ktoe"),
list(colprodsm_expected %>% setrownames_byname("E.ktoe"),
colprodsm_expected %>% setrownames_byname("E.ktoe")))
expect_equal(colprods_byname(list(m, m), NULL), list(colprodsm_expected, colprodsm_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(colprods_byname(DF$m), list(colprodsm_expected, colprodsm_expected))
DF_expected <- data.frame(m = I(list()), iTm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"iTm"]] <- colprodsm_expected
DF_expected[[2,"iTm"]] <- colprodsm_expected
# Because DF_expected$iTm is created with I(list()), its class is "AsIs".
# Because DF$iTm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$iTm to NULL to get a match.
attr(DF_expected$iTm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(iTm = colprods_byname(m)), DF_expected)
})
test_that("colprods_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
colprodsM_expected <- matrix(c(6, 120), nrow = 1, dimnames = list(rowtype(M), colnames(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- colprods_byname(M)
expect_true(is.Matrix(M))
matsbyname:::expect_equal_matrix_or_Matrix(res, colprodsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(colprods_byname(M, "E.ktoe"), colprodsM_expected %>% setrownames_byname("E.ktoe"))
})
test_that("prodall_byname() works as expected", {
m <- matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(prodall_byname(m), 16)
expect_equal(m %>% rowprods_byname %>% colprods_byname,
matrix(16, nrow = 1, ncol = 1, dimnames = list(rowtype(m), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(prodall_byname(list(m,m)), list(16, 16))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(prodall_byname(DF$m), list(16, 16))
DF_expected <- data.frame(m = I(list()), prodm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"prodm"]] <- 16
DF_expected[[2,"prodm"]] <- 16
# Because DF_expected$summ is created with I(list()), its class is "AsIs".
# Because DF$summ is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$summ to NULL to get a match.
attr(DF_expected$prodm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(prodm = prodall_byname(m)), DF_expected)
})
test_that("prodall_byname() works with Matrix objects", {
M <- matsbyname::Matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Product")
expect_equal(prodall_byname(M), 16)
matsbyname:::expect_equal_matrix_or_Matrix(M %>% rowprods_byname() %>% colprods_byname(),
matrix(16, nrow = 1, ncol = 1, dimnames = list(rowtype(M), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M)))
})
test_that("Iminus_byname() works as expected", {
m <- matrix(c(-21, -12, -21, -10), ncol = 2, dimnames = list(c("b", "a"), c("b", "a"))) %>%
setrowtype("Industries") %>% setcoltype("Products")
Iminus_expected <- matrix(c(11, 12,
21, 22),
nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b"))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
# Rows and columns of m are unsorted
expect_equal(diag(1, nrow = 2) - m, matrix(c(22, 12, 21, 11), nrow = 2, dimnames = dimnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Rows and columns of m are sorted prior to subtracting from the identity matrix
expect_equal(Iminus_byname(m), Iminus_expected)
# This also works with lists
expect_equal(Iminus_byname(list(m,m)), list(Iminus_expected, Iminus_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(Iminus_byname(DF$m), list(Iminus_expected, Iminus_expected))
DF_expected <- data.frame(m = I(list()), Iminusm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"Iminusm"]] <- Iminus_expected
DF_expected[[2,"Iminusm"]] <- Iminus_expected
# Because DF_expected$Iminusm is created with I(list()), its class is "AsIs".
# Because DF$Iminusm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$Iminusm to NULL to get a match.
attr(DF_expected$Iminusm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(Iminusm = Iminus_byname(m)), DF_expected)
# If m is not square before subtracting from I,
# it will be made square by the function complete_and_sort.
m2 <- matrix(c(1,2,3,4,5,6), ncol = 2, dimnames = list(c("a", "b", "c"), c("a", "b"))) %>%
setrowtype("Industries") %>% setcoltype("Products")
expect_equal(Iminus_byname(m2),
matrix(c(0, -4, 0,
-2, -4, 0,
-3, -6, 1),
nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c"))) %>%
setrowtype(rowtype(m2)) %>% setcoltype(coltype(m2)))
})
test_that("iminus_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(-21, -12, -21, -10), nrow = 2, ncol = 2, dimnames = list(c("b", "a"), c("b", "a")),
rowtype = "Industries", coltype = "Products")
Iminus_expected <- matsbyname::Matrix(c(11, 12,
21, 22),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b")),
rowtype = rowtype(M), coltype = coltype(M))
# Rows and columns of m are unsorted
expect_equal(matsbyname::Matrix(diag(1, nrow = 2, ncol = 2) - M), matsbyname::Matrix(c(22, 12, 21, 11), nrow = 2, ncol = 2))
# Rows and columns of m are sorted prior to subtracting from the identity matrix
expect_equal(Iminus_byname(M), Iminus_expected)
# This also works with lists
expect_equal(Iminus_byname(list(M, M)), list(Iminus_expected, Iminus_expected))
})
test_that("clean_byname() works as expected", {
# Clean on rows
mat1 <- matrix(c(0,1,0,1), nrow = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols")
# Now clean in rows Should eliminate row 1.
expect_equal(mat1 %>% clean_byname(margin = 1, clean_value = 0),
matrix(1, nrow = 1, ncol = 2, dimnames = list("r (2)", c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
# No column consists of all zeroes. So nothing to clean in columns Should get "mat1" back.
expect_equal(mat1 %>% clean_byname(margin = 2, clean_value = 0), mat1)
# Clean on columns
mat2 <- matrix(c(0,0,1,1), nrow = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols")
# No row consists of all zeroes. So nothing to clean in rows. Should get "mat2" back.
expect_equal(mat2 %>% clean_byname(margin = 1, clean_value = 0), mat2)
# Now clean in columns. Should eliminate column 1.
expect_equal(mat2 %>% clean_byname(margin = 2, clean_value = 0),
matrix(1, nrow = 2, ncol = 1, dimnames = list(c("r (1)", "r (2)"), "c (2)")) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
})
test_that("clean_byname() works as expected for Matrix objects", {
Mat1 <- matsbyname::Matrix(c(0,1,0,1), nrow = 2, ncol = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)")),
rowtype = "Rows", coltype = "Cols")
# Now clean in rows Should eliminate row 1.
res1 <- Mat1 %>%
clean_byname(margin = 1, clean_value = 0)
expect_true(is.Matrix(res1))
matsbyname:::expect_equal_matrix_or_Matrix(res1,
matrix(1, nrow = 1, ncol = 2, dimnames = list("r (2)", c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
# No column consists of all zeroes. So nothing to clean in columns Should get "mat1" back.
matsbyname:::expect_equal_matrix_or_Matrix(Mat1 %>%
clean_byname(margin = 2, clean_value = 0),
Mat1)
# Clean on columns
Mat2 <- matsbyname::Matrix(c(0,0,1,1), nrow = 2, ncol = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)")),
rowtype = "Rows", coltype = "Cols")
res2 <- Mat2 %>%
clean_byname(margin = 1, clean_value = 0)
# No row consists of all zeroes. So nothing to clean in rows. Should get "mat2" back.
matsbyname:::expect_equal_matrix_or_Matrix(res2, Mat2)
# Now clean in columns. Should eliminate column 1.
res3 <- Mat2 %>%
clean_byname(margin = 2, clean_value = 0)
expect_true(is.Matrix(res3))
matsbyname:::expect_equal_matrix_or_Matrix(res3,
matrix(1, nrow = 2, ncol = 1, dimnames = list(c("r (1)", "r (2)"), "c (2)")) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
})
test_that("cumsum_byname() works as expected", {
expect_null(cumsum_byname(NULL))
expect_true(is.na(cumsum_byname(NA)))
expect_equal(cumsum_byname(2), 2)
lst <- list(1, 2, 3, 4, 5)
lst_expected <- list(1, 3, 6, 10, 15)
expect_equal(cumsum_byname(lst), lst_expected)
# Try in a data frame.
DF <- data.frame(l1 = I(lst), l2 = I(lst))
CS <- DF %>%
dplyr::mutate(
cs1 = cumsum_byname(l1),
cs2 = cumsum_byname(l2)
)
expect_equal(CS$cs1, lst_expected)
expect_equal(CS$cs2, lst_expected)
# Try with matrices
rowmat <- matrix(c(1, 2, 3), nrow = 1)
expect_equal(cumsum_byname(rowmat), rowmat)
# Test in a list
expect_equal(cumsum_byname(list(rowmat, rowmat, rowmat)), list(rowmat, 2*rowmat, 3*rowmat))
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF2$m2, list(rowmat, 2*rowmat, 3*rowmat))
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("row") %>% setcoltype("col")
m2 <- matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2")) %>%
setrowtype("row") %>% setcoltype("col")
m3 <- matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3")) %>%
setrowtype("row") %>% setcoltype("col")
mlist <- list(m1, m2, m3)
expected <- list(m1, sum_byname(m1, m2), sum_byname(m1, m2) %>% sum_byname(m3))
expect_equal(cumsum_byname(mlist), expected)
# Ensure that groups are respected in the context of mutate.
DF3 <- tibble::tibble(grp = c("A", "A", "B"), m = mlist) %>%
dplyr::group_by(grp) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF3$m2, list(m1, sum_byname(m1, m2), m3))
})
test_that("cumsum_byname() works with Matrix objects", {
rowmat <- matsbyname::Matrix(c(1, 2, 3), nrow = 1, ncol = 3)
expect_equal(cumsum_byname(rowmat), rowmat)
# Test in a list
expect_equal(cumsum_byname(list(rowmat, rowmat, rowmat)), list(rowmat, 2*rowmat, 3*rowmat))
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF2$m2, list(rowmat, 2*rowmat, 3*rowmat))
})
test_that("cumprod_byname() works as expected", {
expect_null(cumprod_byname(NULL))
expect_true(is.na(cumprod_byname(NA)))
expect_equal(cumprod_byname(2), 2)
lst <- list(1, 2, 3, 4, 5)
lst_expected <- list(1, 2, 6, 24, 120)
expect_equal(cumprod_byname(lst), lst_expected)
# Try in a data frame.
DF <- data.frame(l1 = I(lst), l2 = I(lst))
CS <- DF %>%
dplyr::mutate(
cs1 = cumprod_byname(l1),
cs2 = cumprod_byname(l2)
)
expect_equal(CS$cs1, lst_expected)
expect_equal(CS$cs2, lst_expected)
# Try with matrices
rowmat <- matrix(c(1, 2, 3), nrow = 1)
expect_equal(cumprod_byname(rowmat), rowmat)
# Test in a list
expected_powers <- list(rowmat, rowmat*rowmat, rowmat*rowmat*rowmat)
expect_equal(cumprod_byname(list(rowmat, rowmat, rowmat)), expected_powers)
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF2$m2, expected_powers)
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("row") %>% setcoltype("col")
m2 <- matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2")) %>%
setrowtype("row") %>% setcoltype("col")
m3 <- matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3")) %>%
setrowtype("row") %>% setcoltype("col")
mlist <- list(m1, m2, m3)
expected <- list(m1, sum_byname(m1, m2) * 0, (sum_byname(m1, m2, m3)) * 0)
expect_equal(cumprod_byname(mlist), expected)
# Ensure that groups are respected in the context of mutate.
# DF3 <- data.frame(grp = c("A", "A", "B"), m = I(mlist)) %>%
DF3 <- tibble::tibble(grp = c("A", "A", "B"), m = mlist) %>%
dplyr::group_by(grp) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF3$m2, list(m1, sum_byname(m1, m2) * 0, m3))
})
test_that("cumprod_byname() works with Matrix objects", {
# Try with matrices
rowmat <- matsbyname::Matrix(c(1, 2, 3), nrow = 1, ncol = 3)
expect_equal(cumprod_byname(rowmat), rowmat)
# Test in a list
expected_powers <- list(rowmat, rowmat*rowmat, rowmat*rowmat*rowmat)
expect_equal(cumprod_byname(list(rowmat, rowmat, rowmat)), expected_powers)
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF2$m2, expected_powers)
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matsbyname::Matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1"), rowtype = "row", coltype = "col")
m2 <- matsbyname::Matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2"), rowtype = "row", coltype = "col")
m3 <- matsbyname::Matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3"), rowtype = "row", coltype = "col")
mlist <- list(m1, m2, m3)
res <- cumprod_byname(mlist)
expected <- list(m1, sum_byname(m1, m2) * 0, (sum_byname(m1, m2, m3)) * 0)
for (i in 1:3) {
expect_true(is.Matrix(res[[i]]))
matsbyname:::expect_equal_matrix_or_Matrix(res[[i]], expected[[i]])
}
})
test_that("replaceNaN() works as expected", {
expected <- matrix(c(1, 0))
suppressWarnings(a <- matrix(c(1, sqrt(-1))))
expect_equal(replaceNaN_byname(a), expected)
# Should work with lists
expect_equal(replaceNaN_byname(list(a,a)), list(expected, expected))
# Try with a different value
expect_equal(replaceNaN_byname(a, 42), matrix(c(1,42)))
})
test_that("replaceNaN_byname() works with Matrix objects", {
suppressWarnings(a <- matsbyname::Matrix(c(1,
sqrt(-1)), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
rowtype = "row", coltype = "col"))
expected <- matsbyname::Matrix(c(1,
0), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
rowtype = "row", coltype = "col")
expect_equal(replaceNaN_byname(a), expected)
# Should work with lists
expect_equal(replaceNaN_byname(list(a,a)), list(expected, expected))
# Try with a different value
expect_equal(replaceNaN_byname(a, 42),
matsbyname::Matrix(c(1,
42), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
coltype = "col", rowtype = "row"))
})
test_that("replaceNaN_byname() works with nothing to replace and sparseMatrix objects", {
m <- Matrix::sparseMatrix(i = c(1, 2, 2),
j = c(1, 5, 6),
x = c(11, 25, 26),
dimnames = list(paste0("r", 1:2), paste0("c", 1:6)))
# This errored when m had nothing to replace.
replaced <- replaceNaN_byname(m)
expect_equal(replaced, m)
})
test_that("count_vals_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_byname(m), 2)
expect_equal(count_vals_byname(m, compare_fun = "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = `==`, 0), 2)
expect_equal(count_vals_byname(m, "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = "!="), 4)
expect_equal(count_vals_byname(m, compare_fun = `!=`), 4)
expect_equal(count_vals_byname(m, "<", 1), 2)
expect_equal(count_vals_byname(m, "<=", 1), 3)
expect_equal(count_vals_byname(m, ">=", 3), 2)
expect_equal(count_vals_byname(m, ">", 4), 0)
expect_equal(count_vals_byname(m, `>`, 4), 0)
# Should also work for lists
l <- list(m, m)
expect_equal(count_vals_byname(l, `>`, 4), list(0, 0))
})
test_that("count_vals_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_byname(m), 2)
expect_equal(count_vals_byname(m, compare_fun = "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = `==`, 0), 2)
expect_equal(count_vals_byname(m, "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = "!="), 4)
expect_equal(count_vals_byname(m, compare_fun = `!=`), 4)
expect_equal(count_vals_byname(m, "<", 1), 2)
expect_equal(count_vals_byname(m, "<=", 1), 3)
expect_equal(count_vals_byname(m, ">=", 3), 2)
expect_equal(count_vals_byname(m, ">", 4), 0)
expect_equal(count_vals_byname(m, `>`, 4), 0)
# Should also work for lists
l <- list(m, m)
expect_equal(count_vals_byname(l, `>`, 4), list(0, 0))
})
test_that("compare_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
expect_equal(compare_byname(m), matrix(c(TRUE, FALSE, FALSE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
expect_equal(compare_byname(m, "<", 3),
matrix(c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
})
test_that("compare_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
matsbyname:::expect_equal_matrix_or_Matrix(compare_byname(m),
matsbyname::Matrix(c(TRUE, FALSE, FALSE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
expect_equal(compare_byname(m, "<", 3),
matsbyname::Matrix(c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
})
test_that("count_vals_inrows_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_inrows_byname(m), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = `==`, 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = "!="), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = `!=`), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "<", 1), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "<=", 1), matrix(1, nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, ">=", 3), matrix(c(1, 1, 0), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, ">", 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, `>`, 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 0, 0), nrow = 3, ncol = 1)
expect_equal(count_vals_inrows_byname(l, `>`, 4), list(ans, ans))
})
test_that("count_vals_inrows_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m),
matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = `==`, 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = "!="), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = `!=`), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "<", 1), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "<=", 1), matrix(1, nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, ">=", 3), matrix(c(1, 1, 0), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, ">", 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, `>`, 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 0, 0), nrow = 3, ncol = 1)
Map(f = matsbyname:::expect_equal_matrix_or_Matrix, count_vals_inrows_byname(l, `>`, 4), list(ans, ans))
})
test_that("count_vals_incols_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_incols_byname(m), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = `==`, 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = "!="), matrix(c(2, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = `!=`), matrix(c(2, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "<", 1), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "<=", 1), matrix(c(2, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, ">=", 3), matrix(c(0, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, ">", 4), matrix(c(0, 0), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, `>`, 4), matrix(c(0, 0), nrow = 1, ncol = 2))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 2), nrow = 1, ncol = 2)
expect_equal(count_vals_incols_byname(l, `>`, 2), list(ans, ans))
})
test_that("count_vals_incols_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = `==`, 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = "!="), matrix(c(2, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = `!=`), matrix(c(2, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "<", 1), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "<=", 1), matrix(c(2, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, ">=", 3), matrix(c(0, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, ">", 4), matrix(c(0, 0), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, `>`, 4), matrix(c(0, 0), nrow = 1, ncol = 2))
# Should also work for lists
l <- list(M, M)
ans <- matrix(c(0, 2), nrow = 1, ncol = 2)
Map(f = matsbyname:::expect_equal_matrix_or_Matrix, count_vals_incols_byname(l, `>`, 2), list(ans, ans))
})
test_that("any_byname() works as expected", {
m <- matrix(rep(TRUE, times = 4), nrow = 2, ncol = 2)
expect_true(all_byname(m))
expect_true(any_byname(m))
n <- matrix(c(TRUE, FALSE), nrow = 2, ncol = 1)
expect_false(all_byname(n))
expect_true(any_byname(n))
# Also works for lists
expect_equal(all_byname(list(m,m)), list(TRUE, TRUE))
expect_equal(any_byname(list(m,m)), list(TRUE, TRUE))
expect_equal(all_byname(list(n,n)), list(FALSE, FALSE))
expect_equal(any_byname(list(n,n)), list(TRUE, TRUE))
})
test_that("any_byname() works as expected with Matrix objexts", {
M <- matsbyname::Matrix(rep(TRUE, times = 4), nrow = 2, ncol = 2)
expect_true(all_byname(M))
expect_true(any_byname(M))
N <- matsbyname::Matrix(c(TRUE, FALSE), nrow = 2, ncol = 1)
expect_false(all_byname(N))
expect_true(any_byname(N))
# Also works for lists
expect_equal(all_byname(list(M, M)), list(TRUE, TRUE))
expect_equal(any_byname(list(M, M)), list(TRUE, TRUE))
expect_equal(all_byname(list(N, N)), list(FALSE, FALSE))
expect_equal(any_byname(list(N, N)), list(TRUE, TRUE))
})
test_that("rename_to_pref_suff_byname() works as expected", {
m <- matrix(1:4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
# This aggregation should simply return m with a renamed column.
res <- rename_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("rename_to_pref_suff_byname() works with Matrix objects", {
m <- matsbyname::Matrix(1:4, nrow = 4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
# This aggregation should simply return m with a renamed column.
res <- rename_to_pref_suff_byname(m, keep = "suff", margin = 2, notation = RCLabels::arrow_notation)
expected <- m %>%
magrittr::set_colnames("Industry")
expect_equal(res, expected)
})
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("abs_byname() works as expected", {
expect_equal(abs_byname(1), 1)
expect_equal(abs_byname(-1), 1)
m <- matrix(c(-10,1,1,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Commodity")
expect_equal(abs_byname(m), abs(m))
# Test with a Matrix object
M <- matsbyname::Matrix(c(-10,1,1,100), nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Commodity")
absM <- abs(M) |>
setrowtype("Industry") |> setcoltype("Commodity")
expect_equal(abs_byname(M), absM)
})
test_that("abs_byname() works with a matrix without dimnames or types", {
m <- matrix(c(-10,1,1,100), nrow = 2)
expect_equal(abs_byname(m), abs(m))
# Check speed: base is 1461x faster than byname
bench::mark(base = abs(m),
byname = abs_byname(m), relative = TRUE)
})
test_that("log_byname() works as expected", {
expect_equal(log_byname(exp(1)), 1)
m <- matrix(c(10,1,1,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(log_byname(m),
matrix(c(2.302585, 0,
0, 4.60517), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product"),
tolerance = 1e-7)
expected_log10 <- matrix(c(1, 0,
0, 2), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(log_byname(m, base = 10), expected_log10)
# Also works with lists
expect_equal(log_byname(list(m, m), base = 10), list(expected_log10, expected_log10))
})
test_that("log_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(10,1,1,100), nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
matsbyname:::expect_equal_matrix_or_Matrix(log_byname(M),
matsbyname::Matrix(c(2.302585, 0,
0, 4.60517), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product"),
tolerance = 1e-6)
expected_log10 <- matsbyname::Matrix(c(1, 0,
0, 2), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
matsbyname:::expect_equal_matrix_or_Matrix(log_byname(M, base = 10), expected_log10)
})
test_that("exp_byname() works as expected", {
expect_equal(exp_byname(1), exp(1))
m <- matrix(c(log(10), log(1),
log(1), log(100)),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expected <- matrix(c(10, 1,
1, 100), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(exp_byname(m), expected)
# Also works for lists.
expect_equal(exp_byname(list(m, m)), list(expected, expected))
})
test_that("exp_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(log(10), log(1),
log(1), log(100),
log(2), log(42)),
byrow = TRUE, nrow = 3, ncol = 2,
dimnames = list(paste0("i", 1:3), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
expectedM <- matrix(c(10, 1,
1, 100,
2, 42),
byrow = TRUE, nrow = 3, ncol = 2,
dimnames = list(c("i1", "i2", "i3"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
matsbyname:::expect_equal_matrix_or_Matrix(exp_byname(M), expectedM, tolerance = 1e-12)
# rownames(M) are same as colnames(M). Why? Because it is a symmetric matrix!
# This looks to be a bug in the Matrix package.
M2 <- matsbyname::Matrix(c(log(10), log(1),
log(1), log(100)),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2)),
rowtype = "Industry", coltype = "Product")
expectedM2 <- matrix(c(10, 1,
1, 100),
byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(c("i1", "i2"), c("p1", "p2"))) %>%
setrowtype("Industry") %>% setcoltype("Product")
res2 <- exp_byname(M2)
matsbyname:::expect_equal_matrix_or_Matrix(res2, expectedM2, tolerance = 1e-12)
})
test_that("invert_byname() works as expected", {
# Singular matrix
sing <- matrix(c(1, 0,
42, 0), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2")))
expect_error(invert_byname(sing), regexp = "Attempt to invert a singular matrix. Zero rows and columns: c2.")
# Not a matrix
expect_error(invert_byname("not a matrix"), "'a' must be a numeric matrix")
m <- matrix(c(10,0,0,100), nrow = 2, dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# For matrix inversion, rows become columns and columns become rows.
# Furthermore, the types on rows and columns are flipped.
minv <- matrix(c(0.1, 0, 0, 0.01), nrow = 2, dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
expect_equal(invert_byname(m), minv)
expect_equal(matrixproduct_byname(m, invert_byname(m)),
matrix(c(1,0,0,1), nrow = 2, dimnames = list(rownames(m), rownames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(rowtype(m)))
expect_equal(matrixproduct_byname(invert_byname(m), m),
matrix(c(1,0,0,1), nrow = 2, dimnames = list(colnames(m), colnames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(invert_byname(list(m,m)), list(minv, minv))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1, "m"]] <- m
DF[[2, "m"]] <- m
expect_equal(invert_byname(DF$m), list(minv, minv))
DF_expected <- data.frame(m = I(list()), minv = I(list()))
DF_expected[[1, "m"]] <- m
DF_expected[[2, "m"]] <- m
DF_expected[[1, "minv"]] <- minv
DF_expected[[2, "minv"]] <- minv
# Because DF_expected$minv is created with I(list()), its class is "AsIs".
# Because DF$minv is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$minv to NULL to get a match.
attr(DF_expected$minv, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(minv = invert_byname(m)), DF_expected)
})
test_that("invert_byname() works correctly with a tol argument", {
m <- matrix(c(-3, 4,
2, 5), byrow = TRUE, nrow = 2, ncol = 2,
dimnames = list(paste0("i", 1:2), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
minv <- matrix(c(-5/23, 4/23,
2/23, 3/23), byrow = TRUE, nrow = 2, ncol = 2, dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
# Make sure the tol argument is, ahem, tolerated.
expect_equal(invert_byname(m), minv) # Default value of tol
expect_equal(invert_byname(m, tol = 1e-7), minv)
expect_equal(invert_byname(m, tol = 1e-10), minv)
expect_equal(invert_byname(m, tol = 1e-16), minv)
})
test_that("invert_byname() works correctly with the method argument", {
m <- matrix(c(4, -2, 1,
5, 0, 3,
-1, 2, 6), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(paste0("i", 1:3), paste0("p", 1:3))) %>%
setrowtype("Industries") %>% setcoltype("Products")
minv <- matrix(c( -3/26, 7/26, -3/26,
-33/52, 25/52, -7/52,
5/26, -3/26, 5/26), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(colnames(m), rownames(m))) %>%
setrowtype(coltype(m)) %>% setcoltype(rowtype(m))
expect_error(invert_byname(m, method = "bogus"), regexp = "'arg' should be one of ")
expect_equal(invert_byname(m), minv)
expect_equal(invert_byname(m, method = "QR"), minv)
expect_equal(invert_byname(m, method = "SVD"), minv)
})
test_that("invert_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, -2, 1,
5, 0, 3,
-1, 2, 6), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(paste0("i", 1:3), paste0("p", 1:3)),
rowtype = "Industries", coltype = "Products")
Minv <- matrix(c( -3/26, 7/26, -3/26,
-33/52, 25/52, -7/52,
5/26, -3/26, 5/26), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(colnames(M), rownames(M))) %>%
setrowtype(coltype(M)) %>% setcoltype(rowtype(M))
expect_error(invert_byname(M, method = "bogus"), regexp = "'arg' should be one of ")
matsbyname:::expect_equal_matrix_or_Matrix(invert_byname(M), Minv, tolerance = 1e-15)
expect_true(is.Matrix(invert_byname(M, method = "solve")))
expect_false(is.matrix(invert_byname(M, method = "solve")))
resQR <- invert_byname(M, method = "QR")
matsbyname:::expect_equal_matrix_or_Matrix(resQR, Minv, tolerance = 1e-15)
expect_true(is.Matrix(resQR))
res_SVD <- invert_byname(M, method = "SVD")
matsbyname:::expect_equal_matrix_or_Matrix(res_SVD, Minv, tolerance = 1e-15)
expect_true(is.Matrix(res_SVD))
})
test_that("transpose_byname() works as expected", {
m <- matrix(c(11,21,31,12,22,32), ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mT <- matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, dimnames = list(paste0("p", 1:2), paste0("i", 1:3))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(transpose_byname(m), mT)
# Works for lists
expect_equal(transpose_byname(list(m,m)), list(mT, mT))
# Works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(transpose_byname(DF$m), list(mT, mT))
DF_expected <- data.frame(m = I(list()), mT = I(list()))
DF_expected[[1, "m"]] <- m
DF_expected[[2, "m"]] <- m
DF_expected[[1, "mT"]] <- mT
DF_expected[[2, "mT"]] <- mT
# Because DF_expected$mT is created with I(list()), its class is "AsIs".
# Because DF$mT is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mT to NULL to get a match.
attr(DF_expected$mT, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mT = transpose_byname(m)), DF_expected)
})
test_that("transpose_byname() works with lists of lists", {
m <- matrix(c(11,21,31,12,22,32), ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mT <- matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, dimnames = list(paste0("p", 1:2), paste0("i", 1:3))) %>%
setrowtype("Products") %>% setcoltype("Industries")
# Here, we put a list of matrices into subsequent rows of a column of a data frame.
# The unaryapply_byname function should recursively
# work its way down to the point where it finds matrices upon which it operates.
listofm <- list(a = m, b = m)
DF <- data.frame(listofm = I(list()))
DF[[1,"listofm"]] <- listofm
DF[[2,"listofm"]] <- listofm
res <- DF %>%
dplyr::mutate(
listofmT = transpose_byname(listofm)
)
expect_equal(res$listofmT[[1]][[1]], mT)
expect_equal(res$listofmT[[1]][[2]], mT)
expect_equal(res$listofmT[[2]][[1]], mT)
expect_equal(res$listofmT[[2]][[2]], mT)
# Ensure that names of the list are preserved
expect_equal(names(res$listofmT[[1]]), c("a", "b"))
expect_equal(names(res$listofmT[[2]]), c("a", "b"))
})
test_that("transpose_byname() correctly handles constants", {
expect_equal(transpose_byname(0), 0)
expect_true(!is.matrix(transpose_byname(0)))
expect_equal(transpose_byname(42), 42)
expect_equal(transpose_byname(-10), -10)
})
test_that("transpose_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(11,21,31,12,22,32), nrow = 3, ncol = 2, dimnames = list(paste0("i", 1:3), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
MT <- matsbyname::Matrix(c(11, 12, 21, 22, 31, 32), nrow = 2, ncol = 3, dimnames = list(paste0("p", 1:2), paste0("i", 1:3)),
rowtype = "Products", coltype = "Industries")
expect_equal(transpose_byname(M), MT)
})
test_that("eigenvalues_byname() works as expected", {
m <- matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- c(4, 2, 0)
expect_equal(eigenvalues_byname(m), expected)
expect_equal(eigenvalues_byname(list(m, 2*m)), list(expected, 2*expected))
DF <- tibble::tibble(m_col = list(m, 2*m)) %>%
dplyr::mutate(
eigen_col = eigenvalues_byname(m_col)
)
expect_equal(DF$eigen_col[[1]], expected)
expect_equal(DF$eigen_col[[2]], 2*expected)
})
test_that("eigenvalues_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- c(4, 2, 0)
expect_equal(eigenvalues_byname(M), expected)
})
test_that("eigenvectors_byname() works as expected", {
m <- matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- matrix(c(0.457495711, 0.408248290, -0.577350269,
0.762492852, -0.816496581, -0.577350269,
-0.457495711, 0.408248290, 0.577350269), byrow = TRUE, nrow = 3, ncol = 3)
expect_equal(eigenvectors_byname(m), expected)
expect_equal(eigenvectors_byname(list(m, 2*m)), list(expected, expected))
DF <- tibble::tibble(m_col = list(m, 2*m)) %>%
dplyr::mutate(
eigen_col = eigenvectors_byname(m_col)
)
expect_equal(DF$eigen_col[[1]], expected)
expect_equal(DF$eigen_col[[2]], expected)
})
test_that("eigenvectors_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(4, 6, 10,
3, 10 , 13,
-2, -6, -8), byrow = TRUE, nrow = 3, ncol = 3,
dimnames = list(c("p1", "p2", "p3"), c("p1", "p2", "p3")))
expected <- matrix(c(0.457495711, 0.408248290, -0.577350269,
0.762492852, -0.816496581, -0.577350269,
-0.457495711, 0.408248290, 0.577350269), byrow = TRUE, nrow = 3, ncol = 3)
expect_equal(eigenvectors_byname(M), expected)
expect_equal(eigenvectors_byname(list(M, 2*M)), list(expected, expected))
})
test_that("svd_byname() works as expected", {
# Example from https://medium.com/intuition/singular-value-decomposition-svd-working-example-c2b6135673b5
test_func <- function(A_mat) {
D <- svd_byname(A_mat)
expected_D <- diag(c(sqrt(40), sqrt(10)))
rownames(expected_D) <- rownames(A_mat)
colnames(expected_D) <- colnames(A_mat)
expected_D <- expected_D %>%
setrowtype(rowtype(A_mat)) %>%
setcoltype(coltype(A_mat))
expect_equal(D, expected_D)
U <- svd_byname(A_mat, which = "u")
expected_U <- matrix(c(-1/sqrt(5), -2/sqrt(5),
-2/sqrt(5), 1/sqrt(5)), byrow = TRUE, nrow = 2, ncol = 2)
rownames(expected_U) <- rownames(A_mat)
colnames(expected_U) <- rownames(A_mat)
expected_U <- expected_U %>%
setrowtype(rowtype(A_mat)) %>%
setcoltype(rowtype(A_mat))
expect_equal(U, expected_U)
V <- svd_byname(A_mat, which = "v")
expected_V <- matrix(c(-1/sqrt(2), -1/sqrt(2),
1/sqrt(2), -1/sqrt(2)), byrow = TRUE, nrow = 2, ncol = 2)
rownames(expected_V) <- colnames(A_mat)
colnames(expected_V) <- colnames(A_mat)
expected_V <- expected_V %>%
setrowtype(coltype(A_mat)) %>%
setcoltype(coltype(A_mat))
expect_equal(V, expected_V)
# Double-check multiplication
should_be_A <- matrixproduct_byname(U, D) %>%
matrixproduct_byname(transpose_byname(V))
matsbyname:::expect_equal_matrix_or_Matrix(should_be_A, A_mat, tolerance = 1e-14)
}
# Try with a matrix object
A <- matrix(c(4, 0,
3, -5), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("c1", "c2"))) %>%
setrowtype("rowtype") %>% setcoltype("coltype")
test_func(A)
# Try with a Matrix object
AM <- matsbyname::Matrix(c(4, 0,
3, -5), nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("r1", "r2"), c("c1", "c2")),
rowtype = "rowtype", coltype = "coltype")
# Does not work at present.
# Need to figure out how to do an SVD on a Matrix object
test_func(AM)
})
test_that("hatize_byname() works as expected", {
g <- matrix(4, dimnames = list("I", "Products"))
expect_error(hatize_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
expect_equal(hatize_byname(g, keep = "rownames"),
matrix(4, dimnames = list("I", "I")))
expect_equal(hatize_byname(g, keep = "colnames"),
matrix(4, dimnames = list("Products", "Products")))
v <- matrix(1:3, ncol = 1, dimnames = list(c(paste0("i", 1:3)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
# Try to hatize with the wrong keep argument
expect_error(hatize_byname(v, keep = "colnames"), 'In hatize_byname\\(\\), argument "keep" set to "colnames", but you supplied a column vector. Consider setting keep = "rownames".')
expect_error(hatize_byname(matrix(v, nrow = 1), keep = "rownames"), 'In hatize_byname\\(\\), argument "keep" set to "rownames", but you supplied a row vector. Consider setting keep = "colnames".')
# Try to hatize a list.
v_list <- list(v, v)
expected_m <- matrix(c(1, 0, 0,
0, 2, 0,
0, 0, 3), nrow = 3, byrow = TRUE,
dimnames = list(c("i1", "i2", "i3"), c("i1", "i2", "i3"))) %>%
setrowtype("Industries") %>% setcoltype("Industries")
expect_equal(hatize_byname(v_list, keep = "rownames"), list(expected_m, expected_m))
})
test_that("hatize_byname() works as expected", {
# Check the absurd situation where a non-vector is sent to hatize()
supposed_to_be_a_vector <- matrix(1:4, nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("c1", "c2")))
expect_error(hatize_byname(supposed_to_be_a_vector, keep = "rownames"),
'In hatize_byname\\(\\), matrix v must have at least 1 dimension of length 1.')
v <- matrix(1:10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
orderedRowNames <- c("i1", "i10", paste0("i", 2:9))
v_hat_expected <- matrix(c(1,0,0,0,0,0,0,0,0,0,
0,10,0,0,0,0,0,0,0,0,
0,0,2,0,0,0,0,0,0,0,
0,0,0,3,0,0,0,0,0,0,
0,0,0,0,4,0,0,0,0,0,
0,0,0,0,0,5,0,0,0,0,
0,0,0,0,0,0,6,0,0,0,
0,0,0,0,0,0,0,7,0,0,
0,0,0,0,0,0,0,0,8,0,
0,0,0,0,0,0,0,0,0,9),
nrow = 10,
dimnames = list(orderedRowNames, orderedRowNames)) %>%
setrowtype(rowtype(v)) %>% setcoltype(rowtype(v))
r <- matrix(1:5, nrow = 1, dimnames = list("i1", paste0("p", 1:5))) %>%
setrowtype(NA) %>% setcoltype("Commodities")
orderedColNames <- paste0("p", 1:5)
r_hat_expected <- matrix(c(1,0,0,0,0,
0,2,0,0,0,
0,0,3,0,0,
0,0,0,4,0,
0,0,0,0,5),
nrow = 5,
dimnames = list(orderedColNames, orderedColNames)) %>%
setrowtype(coltype(r)) %>% setcoltype(coltype(r))
expect_equal(hatize_byname(r, keep = "colnames"), r_hat_expected)
# This also works with lists.
expect_equal(hatize_byname(list(v, v), keep = "rownames"), list(v_hat_expected, v_hat_expected))
# And it works with data frames.
DF <- data.frame(v = I(list()))
DF[[1,"v"]] <- v
DF[[2,"v"]] <- v
expect_equal(hatize_byname(DF$v, keep = "rownames"), list(v_hat_expected, v_hat_expected))
DF_expected <- data.frame(v = I(list()), v_hat = I(list()))
DF_expected[[1,"v"]] <- v
DF_expected[[2,"v"]] <- v
DF_expected[[1,"v_hat"]] <- v_hat_expected
DF_expected[[2,"v_hat"]] <- v_hat_expected
# Because DF_expected$v_hat is created with I(list()), its class is "AsIs".
# Because DF$v_hat is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$v_hat to NULL to get a match.
attr(DF_expected$v_hat, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(v_hat = hatize_byname(v, keep = "rownames")), DF_expected)
})
test_that("hatize_byname() works with a simple vector", {
# I'm running into a bug where hatize doesn't work on a 1x1 vector that lacks a column name
# Verify that a 2x1 vector works correctly.
v1 <- matrix(c(1,
2), nrow = 2, ncol = 1, dimnames = list(c("r1", "r2"))) %>%
setrowtype("Product -> Industry")
v1_hat <- hatize_byname(v1, keep = "rownames")
v1_hat_expected <- matrix(c(1, 0,
0, 2), nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("r1", "r2"))) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
expect_equal(v1_hat, v1_hat_expected)
# Now try with a 1x1 column vector
v2 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1")) %>%
setrowtype("Product -> Industry")
v2_hat <- hatize_byname(v2, keep = "rownames")
v2_hat_expected <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1", "r1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
expect_equal(v2_hat, v2_hat_expected)
# Try with a 1x1 row vector
v3 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(NULL, "c1")) %>%
setcoltype("Industry -> Product")
v3_hat <- hatize_byname(v3, keep = "colnames")
v3_hat_expected <- matrix(42, nrow = 1, ncol = 1, dimnames = list("c1", "c1")) %>%
setrowtype("Industry -> Product") %>%
setcoltype("Industry -> Product")
expect_equal(v3_hat, v3_hat_expected)
# Try with 1x1 vector with both dimensions named.
# This should fail, because rownames or colnames must be specified in the keep argument.
v4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Industry -> Product")
expect_error(hatize_byname(v4), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
expect_equal(hatize_byname(v4, keep = "rownames"), matrix(42, dimnames = list("r1", "r1")) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry"))
expect_equal(hatize_byname(v4, keep = "colnames"), matrix(42, dimnames = list("c1", "c1")) %>%
setrowtype("Industry -> Product") %>%
setcoltype("Industry -> Product"))
})
test_that("hatize_byname() issues a warning when keep is wrong", {
v <- matrix(c(1, 2), nrow = 2, dimnames = list(c("r1", "r2"), "c1"))
expect_equal(hatize_byname(v, keep = "rownames"), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("r1", "r2"))))
expect_equal(hatize_byname(v), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("r1", "r2"), c("r1", "r2"))))
expect_error(hatize_byname(v, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
r <- matrix(c(1, 2), ncol = 2, dimnames = list("r1", c("c1", "c2")))
expect_equal(hatize_byname(r, keep = "colnames"), matrix(c(1, 0,
0, 2), nrow = 2, byrow = TRUE, dimnames = list(c("c1", "c2"), c("c1", "c2"))))
expect_error(hatize_byname(r, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
})
test_that("hatize_byname() works with a Matrix vector", {
v1 <- matsbyname::Matrix(c(1,
2), nrow = 2, ncol = 1, dimnames = list(c("r1", "r2"), c("c1")),
rowtype = "Product -> Industry")
v1_hat <- hatize_byname(v1, keep = "rownames")
v1_hat_expected <- matrix(c(1, 0,
0, 2), nrow = 2, ncol = 2, dimnames = list(c("r1", "r2"), c("r1", "r2"))) %>%
setrowtype("Product -> Industry") %>%
setcoltype("Product -> Industry")
matsbyname:::expect_equal_matrix_or_Matrix(v1_hat, v1_hat_expected)
expect_true(inherits(v1_hat, "ddiMatrix"))
v2 <- matsbyname::Matrix(1:10, nrow = 10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1")),
rowtype = "Industries", coltype = NA)
orderedRowNames <- c("i1", "i10", paste0("i", 2:9))
v2_hat_expected <- matsbyname::Matrix(c(1,0,0,0,0,0,0,0,0,0,
0,10,0,0,0,0,0,0,0,0,
0,0,2,0,0,0,0,0,0,0,
0,0,0,3,0,0,0,0,0,0,
0,0,0,0,4,0,0,0,0,0,
0,0,0,0,0,5,0,0,0,0,
0,0,0,0,0,0,6,0,0,0,
0,0,0,0,0,0,0,7,0,0,
0,0,0,0,0,0,0,0,8,0,
0,0,0,0,0,0,0,0,0,9),
nrow = 10, ncol = 10,
dimnames = list(orderedRowNames, orderedRowNames),
rowtype = "Industries", coltype = "Industries")
res2 <- hatize_byname(v2)
matsbyname:::expect_equal_matrix_or_Matrix(res2, v2_hat_expected)
r <- matsbyname::Matrix(1:5, nrow = 1, ncol = 5, dimnames = list("i1", paste0("p", 1:5)),
rowtype = NA, coltype = "Industries")
orderedColNames <- paste0("p", 1:5)
r_hat_expected <- matsbyname::Matrix(c(1,0,0,0,0,
0,2,0,0,0,
0,0,3,0,0,
0,0,0,4,0,
0,0,0,0,5),
nrow = 5, ncol = 5,
dimnames = list(orderedColNames, orderedColNames),
rowtype = coltype(r), coltype = coltype(r))
matsbyname:::expect_equal_matrix_or_Matrix(hatize_byname(r, keep = "colnames"), r_hat_expected)
})
test_that("hatize_byname() tests hit all lines of code", {
v1 <- matrix(c(42), nrow = 1, ncol = 1)
expect_error(hatize_byname(v1), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
v2 <- matrix(c(42), nrow = 1, ncol = 1, dimnames = list("r1"))
expect_error(hatize_byname(v2, keep = "bogus"), 'In hatize_byname\\(\\), argument "keep" must be one of "colnames" or "rownames".')
expect_error(hatize_byname(NA), "argument is of length zero")
expect_null(hatize_byname(NULL))
})
test_that("hatinv_byname() works as expected", {
# Test with a column vector
v <- matrix(1:10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
res <- hatinv_byname(v, keep = "rownames")
expected <- v %>%
hatize_byname(keep = "rownames") %>%
invert_byname()
expect_equal(res, expected)
# Test with a row vector
r <- matrix(1:5, nrow = 1, dimnames = list(c("r1"), c(paste0("c", 1:5)))) %>%
setrowtype(NA) %>% setcoltype("Commodities")
expect_equal(hatinv_byname(r, keep = "colnames"), r %>% hatize_byname(keep = "colnames") %>% invert_byname())
# Test with a list
v_list <- list(v, v)
expect_equal(hatinv_byname(v_list, keep = "rownames"), v_list %>% hatize_byname(keep = "rownames") %>% invert_byname())
# Test with a data frame
DF <- data.frame(v_list = I(list()))
DF[[1, "v_list"]] <- v
DF[[2, "v_list"]] <- v
DF <- DF %>%
dplyr::mutate(
hatinv = hatinv_byname(v_list, keep = "rownames")
)
DF_expected <- data.frame(v_list = I(list()), hatinv = I(list()))
DF_expected[[1, "v_list"]] <- v
DF_expected[[2, "v_list"]] <- v
DF_expected[[1, "hatinv"]] <- v %>% hatize_byname(keep = "rownames") %>% invert_byname()
DF_expected[[2, "hatinv"]] <- v %>% hatize_byname(keep = "rownames") %>% invert_byname()
# The hatinv column of DF_expected will have matrix_class = 'AsIs', but
# the hatinv column of DF will have no class attribute.
# Eliminate that mismatch.
attr(DF_expected$hatinv, which = "class") <- NULL
expect_equal(DF, DF_expected)
# Test when one of the elements of v is 0.
v2 <- matrix(0:1, ncol = 1, dimnames = list(c(paste0("i", 0:1)), c("p1"))) %>%
setrowtype("Industries") %>% setcoltype(NA)
expect_equal(hatinv_byname(v2, keep = "rownames"), matrix(c(.Machine$double.xmax, 0,
0, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c(paste0("i", 0:1)), c(paste0("i", 0:1)))) %>%
setrowtype("Industries") %>% setcoltype("Industries"))
# Test when we want the 0 element of v to give Inf instead of .Machine$double.xmax.
expect_equal(hatinv_byname(v2, inf_becomes = NULL, keep = "rownames"), matrix(c(Inf, 0,
0, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c(paste0("i", 0:1)), c(paste0("i", 0:1)))) %>%
setrowtype("Industries") %>% setcoltype("Industries"))
# Test that hatinv works with a 1x1 vector
g <- matrix(4, dimnames = list("I", "Products"))
expect_error(hatinv_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
})
test_that("hatinv_byname() works with a Matrix object", {
# Test with a column vector
v <- matsbyname::Matrix(1:10, nrow = 10, ncol = 1, dimnames = list(c(paste0("i", 1:10)), c("p1")),
rowtype = "Industries", coltype = NA)
res <- hatinv_byname(v, keep = "rownames")
expected <- v %>%
hatize_byname(keep = "rownames") %>%
invert_byname()
expect_equal(res, expected)
# Test with a row vector
r <- matsbyname::Matrix(1:5, nrow = 1, ncol = 5, dimnames = list(c("r1"), c(paste0("c", 1:5))),
rowtype = NA, coltype = "Commodities")
expect_equal(hatinv_byname(r, keep = "colnames"),
r %>%
hatize_byname(keep = "colnames") %>%
invert_byname())
# Test that hatinv works with a 1x1 Matrix
g <- matsbyname::Matrix(4, dimnames = list("I", "Products"))
expect_error(hatinv_byname(g), "Unable to determine which names to keep \\(rows or cols\\) in hatize_byname\\(\\). Try setting the 'keep' argument.")
})
test_that("identize_byname() works as expected", {
# Try first with a single number
expect_equal(identize_byname(42), 1)
# Now try with matrices.
m <- matrix(1:16, ncol = 4, dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4))) %>%
setrowtype("Industries") %>% setcoltype("Products")
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = dimnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
# Test for errors
expect_error(identize_byname(m, margin = c(1,2,3,4)), "margin should have length 1 or 2 in identize_byname")
expect_error(identize_byname(m, margin = c(3)), "Unknown margin 3 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m, margin = c(-1)), "Unknown margin -1 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m, margin = c(1,1,2,2)), "margin should have length 1 or 2 in identize_byname")
# Test for column vector
expect_equal(identize_byname(m, margin = 1),
matrix(1, nrow = nrow(m), ncol = 1) %>%
setrownames_byname(rownames(m)) %>% setcolnames_byname(coltype(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Test for row vector
expect_equal(identize_byname(m, margin = 2),
matrix(1, nrow = 1, ncol = ncol(m)) %>%
setrownames_byname(rowtype(m)) %>% setcolnames_byname(colnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Test for identity matrix
expect_equal(identize_byname(m), mI_expected)
expect_equal(identize_byname(m, margin = c(1,2)), mI_expected)
expect_equal(identize_byname(m, margin = c(2,1)), mI_expected)
# This also works with lists
expect_equal(identize_byname(list(m, m, m)), list(mI_expected, mI_expected, mI_expected))
# This also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(identize_byname(DF$m, margin = list(c(1, 2))), list(mI_expected, mI_expected))
expect_equal(identize_byname(DF$m, margin = list(c(1,2))), list(mI_expected, mI_expected))
expect_equal(identize_byname(DF$m, margin = list(c(2,1))), list(mI_expected, mI_expected))
DF_expected <- data.frame(m = I(list()), mI = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mI"]] <- mI_expected
DF_expected[[2,"mI"]] <- mI_expected
# Because DF_expected$mI is created with I(list()), its class is "AsIs".
# Because DF$mI is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mI to NULL to get a match.
attr(DF_expected$mI, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mI = identize_byname(m, margin = list(c(1, 2)))), DF_expected)
})
test_that("identize_byname() works with a Matrix object", {
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Try with matrices.
m <- matsbyname::Matrix(42, nrow = 4, ncol = 4,
dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4)),
rowtype = "Industries", coltype = "Products")
res <- identize_byname(m)
matsbyname:::expect_equal_matrix_or_Matrix(res, mI_expected)
m1 <- matsbyname::Matrix(1:16, nrow = 4, ncol = 4, dimnames = list(c(paste0("i", 1:4)), paste0("p", 1:4)),
rowtype = "Industries", coltype = "Products")
mI_expected <- matrix(c(1,0,0,0,
0,1,0,0,
0,0,1,0,
0,0,0,1),
nrow = 4,
dimnames = dimnames(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1))
# Test for errors
expect_error(identize_byname(m1, margin = c(1,2,3,4)), "margin should have length 1 or 2 in identize_byname")
expect_error(identize_byname(m1, margin = c(3)), "Unknown margin 3 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m1, margin = c(-1)), "Unknown margin -1 in identize_byname. margin should be 1, 2, or c\\(1,2\\)")
expect_error(identize_byname(m1, margin = c(1,1,2,2)), "margin should have length 1 or 2 in identize_byname")
# Test for column vector
res <- identize_byname(m1, margin = 1)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res,
matrix(1, nrow = nrow(m1), ncol = 1) %>%
setrownames_byname(rownames(m1)) %>% setcolnames_byname(coltype(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1)))
# Test for row vector
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = 2),
matrix(1, nrow = 1, ncol = ncol(m1)) %>%
setrownames_byname(rowtype(m1)) %>% setcolnames_byname(colnames(m1)) %>%
setrowtype(rowtype(m1)) %>% setcoltype(coltype(m1)))
# Test for identity matrix
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1), mI_expected)
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = c(1,2)), mI_expected)
matsbyname:::expect_equal_matrix_or_Matrix(identize_byname(m1, margin = c(2,1)), mI_expected)
})
test_that("vectorize_byname() works as expected", {
# Try with a square matrix
m1 <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected1 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
expect_equal(actual1, expected1)
# Try with null notation
expect_equal(vectorize_byname(m1, notation = NULL), m1)
# Try with a rectangular matrix
m2 <- matrix(c(1, 2, 3,
4, 5, 6),
nrow = 2, ncol = 3, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2", "i3"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected2 <- matrix(c(1,
4,
2,
5,
3,
6),
nrow = 6, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2", "p1 -> i3", "p2 -> i3"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual2 <- vectorize_byname(m2, notation = RCLabels::arrow_notation)
expect_equal(actual2, expected2)
# Try with a single number
m3 <- 42
expected3 <- m3
dim(expected3) <- c(1, 1)
dimnames(expected3) <- NULL
actual3 <- vectorize_byname(m3, notation = RCLabels::arrow_notation)
expect_equal(actual3, expected3)
# Try with a different separator
m4 <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expected4 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1---i1", "p2---i1", "p1---i2", "p2---i2"))) %>%
setrowtype("Products---Industries") %>% setcoltype(NULL)
actual4 <- vectorize_byname(m4, notation = RCLabels::notation_vec(sep = "---"))
expect_equal(actual4, expected4)
# Test with a matrix that is already a column vector
m5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1", "p2", "p3"), "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
actual5 <- vectorize_byname(m5, notation = RCLabels::notation_vec(sep = "***"))
expected5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1***i1", "p2***i1", "p3***i1"))) %>%
setrowtype("Products***Industries") %>% setcoltype(NULL)
expect_equal(actual5, expected5)
# Test with NULL. Should get NULL back.
expect_null(vectorize_byname(NULL, NULL))
# Test with NA.
expect_error(vectorize_byname(NA, notation = RCLabels::arrow_notation), "a is not numeric or a Matrix in vectorize_byname")
# Test with string
expect_error(vectorize_byname("a", notation = RCLabels::arrow_notation), "a is not numeric or a Matrix in vectorize_byname")
# Test with a list of matrices
list6 <- list(m1, m1)
actual6 <- vectorize_byname(list6, notation = list(RCLabels::arrow_notation))
expected6 <- list(expected1, expected1)
expect_equal(actual6, expected6)
})
test_that("vectorize_byname() works with 4 matrices in a list", {
m <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
l <- list(m, m, m, m)
actual <- vectorize_byname(l, notation = list(RCLabels::arrow_notation))
e <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
expect_equal(actual, list(e, e, e, e))
})
test_that("vectorize_byname() works with Matrix objects", {
# Try with a square Matrix
m1 <- matsbyname::Matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expected1 <- matrix(c(1,
4,
5,
5),
nrow = 4, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
matsbyname:::expect_equal_matrix_or_Matrix(actual1, expected1)
# Try with a rectangular matrix
m2 <- matsbyname::Matrix(c(1, 2, 3,
4, 5, 6),
nrow = 2, ncol = 3, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2", "i3")),
rowtype = "Products", coltype = "Industries")
expected2 <- matrix(c(1,
4,
2,
5,
3,
6),
nrow = 6, ncol = 1,
dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2", "p1 -> i3", "p2 -> i3"))) %>%
setrowtype("Products -> Industries") %>% setcoltype(NULL)
actual2 <- vectorize_byname(m2, notation = RCLabels::arrow_notation)
matsbyname:::expect_equal_matrix_or_Matrix(actual2, expected2)
# Test with a Matrix that is already a column vector
m5 <- matsbyname::Matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1", "p2", "p3"), "i1"),
rowtype = "Products", coltype = "Industries")
actual5 <- vectorize_byname(m5, notation = RCLabels::notation_vec(sep = "***"))
expected5 <- matrix(c(1,
2,
3),
nrow = 3, ncol = 1,
dimnames = list(c("p1***i1", "p2***i1", "p3***i1"))) %>%
setrowtype("Products***Industries") %>% setcoltype(NULL)
matsbyname:::expect_equal_matrix_or_Matrix(actual5, expected5)
})
test_that("matricize_byname() works as expected", {
v1 <- array(dim = c(2, 2, 2))
expect_error(matricize_byname(v1, notation = RCLabels::arrow_notation), "== 2 in matricize_byname")
# Try with a column vector
v2 <- matrix(c(1,
2,
3,
4),
nrow = 4, ncol = 1, dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setrowtype("Products -> Industries")
actual2 <- matricize_byname(v2, notation = RCLabels::arrow_notation)
expected2 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual2, expected2)
# Try with a row vector
v3 <- matrix(c(1, 2, 3, 4),
nrow = 1, ncol = 4, dimnames = list(NULL, c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"))) %>%
setcoltype("Products -> Industries")
actual3 <- matricize_byname(v3, notation = RCLabels::arrow_notation)
expected3 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual3, expected3)
# Try with a 1x1 matrix as a column vector.
v4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(c("p2 -> i1"))) %>%
setrowtype("Products -> Industries")
actual4 <- matricize_byname(v4, notation = RCLabels::arrow_notation)
expected4 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("p2", "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual4, expected4)
# Try with a 1x1 matrix as a row vector.
v5 <- matrix(42, nrow = 1, ncol = 1, dimnames = list(NULL, c("p2 -> i1"))) %>%
setcoltype("Products -> Industries")
actual5 <- matricize_byname(v5, notation = RCLabels::arrow_notation)
expected5 <- matrix(42, nrow = 1, ncol = 1, dimnames = list("p2", "i1")) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual5, expected5)
# Try with a non-square result
v6 <- matrix(c(1, 2, 3, 4, 5, 6),
nrow = 1, ncol = 6, dimnames = list(NULL, c("p1 -> i1", "p1 -> i2",
"p2 -> i1", "p2 -> i2",
"p3 -> i1", "p3 -> i2"))) %>%
setcoltype("Products -> Industries")
actual6 <- matricize_byname(v6, notation = RCLabels::arrow_notation)
expected6 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expect_equal(actual6, expected6)
})
test_that("matricize_byname() works with Matrix objects", {
# Try with a column vector that is a Matrix object
v2 <- matsbyname::Matrix(c(1,
2,
3,
4),
nrow = 4, ncol = 1, dimnames = list(c("p1 -> i1", "p2 -> i1", "p1 -> i2", "p2 -> i2"), NULL),
rowtype = "Products -> Industries")
actual2 <- matricize_byname(v2, notation = RCLabels::arrow_notation)
expected2 <- matrix(c(1, 3,
2, 4),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
matsbyname:::expect_equal_matrix_or_Matrix(actual2, expected2)
expect_true(is.Matrix(actual2))
})
test_that("matricize_byname() coltype work correctly when input rowtype is NULL", {
# On 17 October 2023, Emmanuel and I noticed that some NULL-type matrices
# were showing coltype = list() after matricize.
am_vec <- matrix(data = c(1:2), nrow = 2, dimnames = list(c("p1 -> i1", "p2 -> i2"), c("onecol"))) |>
setrowtype(NULL) |> setcoltype("coltype_am")
am_mat <- matricize_byname(am_vec, notation = RCLabels::arrow_notation)
expect_null(rowtype(am_mat))
expect_null(coltype(am_mat))
aM_vec <- Matrix::Matrix(data = c(1:2), nrow = 2, dimnames = list(c("p1 -> i1", "p2 -> i2"), c("onecol"))) |>
setrowtype(NULL) |> setcoltype("coltype_aM")
aM_mat <- matricize_byname(aM_vec, notation = RCLabels::arrow_notation)
expect_null(rowtype(aM_mat))
expect_null(coltype(aM_mat))
})
test_that("vectorize_byname() and matricize_byname() are inverses of each other", {
m1 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
v1 <- vectorize_byname(m1, notation = RCLabels::arrow_notation)
m2 <- matricize_byname(v1, notation = RCLabels::arrow_notation)
expect_equal(m2, m1)
v3 <- transpose_byname(v1)
m4 <- matricize_byname(v3, notation = RCLabels::arrow_notation)
expect_equal(m4, m1)
# Try with a Matrix object.
M1 <- matrix(c(1, 2,
3, 4,
5, 6),
nrow = 3, ncol = 2, byrow = TRUE, dimnames = list(c("p1", "p2", "p3"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
V1 <- vectorize_byname(M1, notation = RCLabels::arrow_notation)
M2 <- matricize_byname(V1, notation = RCLabels::arrow_notation)
expect_equal(M2, M1)
V3 <- transpose_byname(V1)
M4 <- matricize_byname(V3, notation = RCLabels::arrow_notation)
expect_equal(M4, M1)
})
test_that("fractionze_byname() works as expected", {
M <- matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_rows <- matrix(c(1/6, 5/6,
4/9, 5/9),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_cols <- matrix(c(1/5, 5/10,
4/5, 5/10),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
expectedM_sumall <- matrix(c(1/15, 5/15,
4/15, 5/15),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))) %>%
setrowtype("Products") %>% setcoltype("Industries")
# Test for errors
expect_error(fractionize_byname(M, margin = c(2,2,1,1,0)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(2,2,1,1)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(1,1)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(2,2)), "margin should contain unique integers in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(1,2,3)), "margin should have length 1 or 2 in fractionize_byname")
expect_error(fractionize_byname(M, margin = 3), "Unknown margin 3 in fractionize_byname")
expect_error(fractionize_byname(M, margin = c(3,4)), "Unknown margin")
expect_error(fractionize_byname(M, margin = -1), "Unknown margin")
# Test with a single number
expect_equal(fractionize_byname(2, margin = 1), 1)
expect_equal(fractionize_byname(-1, margin = 2), 1)
expect_equal(fractionize_byname(-5000, margin = c(1,2)), 1)
expect_equal(fractionize_byname(0, margin = 1), .Machine$double.xmax)
# Test dividing by row sums
expect_equal(fractionize_byname(M, margin = 1), expectedM_rows)
# Test dividing by column sums
expect_equal(fractionize_byname(M, margin = 2), expectedM_cols)
# Test dividing by sum of all entries
expect_equal(fractionize_byname(M, margin = c(1,2)), expectedM_sumall)
expect_equal(fractionize_byname(M, margin = c(2,1)), expectedM_sumall)
# Should also work for lists
expect_equal(fractionize_byname(list(M,M), margin = 1), list(expectedM_rows, expectedM_rows))
# Should also work for data frames
DF <- data.frame(case = I(list()), M = I(list()))
DF[[1, "case"]] <- 1
DF[[1, "case"]] <- 2
DF[[1, "M"]] <- M
DF[[2, "M"]] <- M
DF2 <- DF %>%
dplyr::mutate(
F_row = fractionize_byname(M, margin = 1),
F_col = fractionize_byname(M, margin = 2),
F_tot = fractionize_byname(M, margin = list(c(2,1)))
)
expect_equal(DF2$F_row, list(expectedM_rows, expectedM_rows))
expect_equal(DF2$F_col, list(expectedM_cols, expectedM_cols))
expect_equal(DF2$F_tot, list(expectedM_sumall, expectedM_sumall))
# Test when a column contains zeroes
Mzerocol <- matrix(c(1, 0,
2, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzerocol, margin = c(1,2)),
matrix(c(1/3, 0,
2/3, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerocol, margin = 1),
matrix(c(1, 0,
1, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# Verify that the zero column now works and gives NaNs.
expect_equal(fractionize_byname(Mzerocol, margin = 2, inf_becomes = Inf),
matrix(c(1/3, 0/0,
2/3, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# But if we clean the matrix first, we will also get something that makes sense.
expect_equal(fractionize_byname(clean_byname(Mzerocol, margin = 2), margin = 2),
matrix(c(1/3,
2/3),
nrow = 2, ncol = 1, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1"))))
# Test when rows are zero.
Mzerorow <- matrix(c(0, 0,
1, 2),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzerorow, margin = c(1,2)),
matrix(c(0, 0,
1/3, 2/3),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerorow, margin = 1, inf_becomes = NaN),
matrix(c(0/0, 0/0,
1/3, 2/3),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzerorow, margin = 2),
matrix(c(0, 0,
1, 1),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
# Test when everything is zero
Mzero <- matrix(c(0, 0,
0, 0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")))
expect_equal(fractionize_byname(Mzero, margin = 1, inf_becomes = NaN),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzero, margin = 2, inf_becomes = NaN),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
expect_equal(fractionize_byname(Mzero, margin = c(1,2)),
matrix(c(0/0, 0/0,
0/0, 0/0),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2"))))
})
test_that("fractionize_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1, 5,
4, 5),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_rows <- matsbyname::Matrix(c(1/6, 5/6,
4/9, 5/9),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_cols <- matsbyname::Matrix(c(1/5, 5/10,
4/5, 5/10),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
expectedM_sumall <- matsbyname::Matrix(c(1/15, 5/15,
4/15, 5/15),
nrow = 2, ncol = 2, byrow = TRUE,
dimnames = list(c("p1", "p2"), c("i1", "i2")),
rowtype = "Products", coltype = "Industries")
# Test dividing by row sums
expect_equal(fractionize_byname(M, margin = 1), expectedM_rows)
# Test dividing by column sums
expect_equal(fractionize_byname(M, margin = 2), expectedM_cols)
# Test dividing by sum of all entries
expect_equal(fractionize_byname(M, margin = c(1,2)), expectedM_sumall)
expect_equal(fractionize_byname(M, margin = c(2,1)), expectedM_sumall)
})
test_that("fractionize_byname() works with a single number 0", {
expect_equal(fractionize_byname(0, margin = c(1, 2)), .Machine$double.xmax)
})
test_that("rowsums_byname() works as expected", {
m_rownames <- paste0("i", 1:4)
m_colnames <- paste0("p", 1:4)
m <- matrix(1:16, ncol = 4, dimnames = list(m_rownames, m_colnames)) %>%
setrowtype("Industries") %>% setcoltype("Products")
expect_error(rowsums_byname("bogus"), "Unknown type for 'a' in rowsums_byname")
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Note, columns are sorted by name after rowsums_byname
rowsumsm_expected <- matrix(c(9, 7, 5), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(rowsums_byname(m), rowsumsm_expected)
expect_equal(rowsums_byname(m, "E.ktoe"), rowsumsm_expected %>% setcolnames_byname("E.ktoe"))
# This also works with lists
expect_equal(rowsums_byname(list(m, m)), list(rowsumsm_expected, rowsumsm_expected))
expect_equal(rowsums_byname(list(m, m), "E.ktoe"),
list(rowsumsm_expected %>% setcolnames_byname("E.ktoe"),
rowsumsm_expected %>% setcolnames_byname("E.ktoe")))
rowsum_expected_no_colname <- rowsumsm_expected %>%
magrittr::set_colnames(NULL)
expect_equal(rowsums_byname(list(m, m), NULL), list(rowsum_expected_no_colname, rowsum_expected_no_colname))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(rowsums_byname(DF$m), list(rowsumsm_expected, rowsumsm_expected))
DF_expected <- data.frame(m = I(list()), mi = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mi"]] <- rowsumsm_expected
DF_expected[[2,"mi"]] <- rowsumsm_expected
# Because DF_expected$mi is created with I(list()), its class is "AsIs".
# Because DF$mi is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mi to NULL to get a match.
attr(DF_expected$mi, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mi = rowsums_byname(m)), DF_expected)
})
test_that("rowsums_byname() works with single numbers and matrices", {
expect_equal(rowsums_byname(1), 1)
expect_equal(rowsums_byname(matrix(1)), matrix(1))
expect_equal(rowsums_byname(list(1, 42)), list(1, 42))
expect_equal(rowsums_byname(list(matrix(c(1, 42)), matrix(c(2, 43)))), list(matrix(c(1, 42)), matrix(c(2, 43))))
})
test_that("rowsums_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
# Note, columns are sorted by name after rowsums_byname()
rowsumsM_expected <- matrix(c(9, 7, 5), nrow = 3, ncol = 1, dimnames = list(paste0("i", 1:3), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- rowsums_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, rowsumsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(rowsums_byname(M, "E.ktoe"), rowsumsM_expected %>% setcolnames_byname("E.ktoe"))
})
test_that("colsums_byname() works as expected", {
expect_error(colsums_byname("bogus"), "Unknown type for 'a' in colsums_byname")
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
colsumsm_expected <- matrix(c(6, 15), nrow = 1, dimnames = list(rowtype(m), colnames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(colsums_byname(m), colsumsm_expected)
expect_equal(colsums_byname(m, "E.ktoe"), colsumsm_expected %>% setrownames_byname("E.ktoe"))
# This also works with lists
expect_equal(colsums_byname(list(m, m)), list(colsumsm_expected, colsumsm_expected))
expect_equal(colsums_byname(list(m, m), "E.ktoe"),
list(colsumsm_expected %>% setrownames_byname("E.ktoe"),
colsumsm_expected %>% setrownames_byname("E.ktoe")))
colsum_expected_no_colname <- colsumsm_expected %>%
magrittr::set_rownames(NULL)
expect_equal(colsums_byname(list(m, m), NULL), list(colsum_expected_no_colname, colsum_expected_no_colname))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(colsums_byname(DF$m), list(colsumsm_expected, colsumsm_expected))
DF_expected <- data.frame(m = I(list()), iTm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"iTm"]] <- colsumsm_expected
DF_expected[[2,"iTm"]] <- colsumsm_expected
# Because DF_expected$iTm is created with I(list()), its class is "AsIs".
# Because DF$iTm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$iTm to NULL to get a match.
attr(DF_expected$iTm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(iTm = colsums_byname(m)), DF_expected)
})
test_that("colsums_byname() works with single numbers and matrices", {
expect_equal(colsums_byname(1), 1)
expect_equal(colsums_byname(matrix(1)), matrix(1))
expect_equal(colsums_byname(list(1, 42)), list(1, 42))
expect_equal(colsums_byname(list(matrix(c(1, 42)), matrix(c(2, 43)))), list(matrix(43), matrix(45)))
})
test_that("colsums_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
colsumsM_expected <- matrix(c(6, 15), nrow = 1, dimnames = list(rowtype(M), colnames(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- colsums_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, colsumsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(colsums_byname(M, "E.ktoe"), colsumsM_expected %>% setrownames_byname("E.ktoe"))
})
test_that("sumall_byname() works as expected", {
expect_error(sumall_byname("bogus"), "Unknown type for 'a' in sumall_byname")
m <- matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Commodity")
expect_equal(sumall_byname(m), 8)
expect_equal(m %>% rowsums_byname %>% colsums_byname,
matrix(8, nrow = 1, ncol = 1, dimnames = list(rowtype(m), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(sumall_byname(list(m,m)), list(8, 8))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(sumall_byname(DF$m), list(8,8))
DF_expected <- data.frame(m = I(list()), summ = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"summ"]] <- 8
DF_expected[[2,"summ"]] <- 8
# Because DF_expected$summ is created with I(list()), its class is "AsIs".
# Because DF$summ is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$summ to NULL to get a match.
attr(DF_expected$summ, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(summ = sumall_byname(m)), DF_expected)
})
test_that("sumall_byname() works for single numbers", {
expect_equal(sumall_byname(matrix(1)), 1)
expect_equal(sumall_byname(list(matrix(1), matrix(42))), list(1, 42))
expect_equal(sumall_byname(1), 1)
expect_equal(sumall_byname(1), 1)
})
test_that("sumall_byname() works with Matrix objects", {
M <- matsbyname::Matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Commodity")
res <- sumall_byname(M)
expect_equal(res, 8)
matsbyname:::expect_equal_matrix_or_Matrix(M %>% rowsums_byname %>% colsums_byname,
matrix(8, nrow = 1, ncol = 1, dimnames = list(rowtype(M), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M)))
})
test_that("sum_byname() and sumall_byname() behave same with NULL", {
expect_equal(sum_byname(0, 0), 0)
expect_equal(sum_byname(1, 0), 1)
expect_equal(sum_byname(1, NULL), 1)
# I wish this were 0, but can't figure out how to make it so at the moment.
# This result is inconsistent with sum_byname(NULL, NULL) returning 0.
# expect_true(sum_byname(NULL), 0)
expect_null(sum_byname(NULL))
expect_equal(sum_byname(NULL, NULL), 0)
expect_equal(sum_byname(NULL, NULL, NULL), 0)
# Again, it seems like this should return 0, but it does not currently.
# expect_equal(sumall_byname(NULL), 0)
expect_null(sumall_byname(NULL))
# expect_equal(sumall_byname(list(NULL, NULL)), list(0, 0))
expect_equal(sum_byname(list(NULL, NULL)), list(NULL, NULL))
expect_equal(sumall_byname(matrix(0, nrow = 1, ncol = 1)), 0)
expect_equal(sumall_byname(matrix(1, nrow = 1, ncol = 1)), 1)
})
test_that("rowprods_byname() works as expected", {
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
# Note, columns are sorted by name after rowprods_byname
rowprodsm_expected <- matrix(c(18, 10, 4), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(rowprods_byname(m), rowprodsm_expected)
expect_equal(rowprods_byname(m, "E.ktoe"), rowprodsm_expected %>% setcolnames_byname("E.ktoe"))
# This also works with lists
expect_equal(rowprods_byname(list(m, m)), list(rowprodsm_expected, rowprodsm_expected))
expect_equal(rowprods_byname(list(m, m), "E.ktoe"),
list(rowprodsm_expected %>% setcolnames_byname("E.ktoe"),
rowprodsm_expected %>% setcolnames_byname("E.ktoe")))
expect_equal(rowprods_byname(list(m, m), NULL), list(rowprodsm_expected, rowprodsm_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(rowprods_byname(DF$m), list(rowprodsm_expected, rowprodsm_expected))
DF_expected <- data.frame(m = I(list()), mi = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"mi"]] <- rowprodsm_expected
DF_expected[[2,"mi"]] <- rowprodsm_expected
# Because DF_expected$mi is created with I(list()), its class is "AsIs".
# Because DF$mi is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$mi to NULL to get a match.
attr(DF_expected$mi, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(mi = rowprods_byname(m)), DF_expected)
})
test_that("rowprods_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
# Note, columns are sorted by name after rowprods_byname
rowprodsM_expected <- matrix(c(18, 10, 4), nrow = 3, dimnames = list(paste0("i", 1:3), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- rowprods_byname(M)
expect_true(is.Matrix(res))
matsbyname:::expect_equal_matrix_or_Matrix(res, rowprodsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(rowprods_byname(M, "E.ktoe"), rowprodsM_expected %>% setcolnames_byname("E.ktoe"))
})
test_that("colprods_byname() works as expected", {
m <- matrix(c(1:6), ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2))) %>%
setrowtype("Industries") %>% setcoltype("Products")
colprodsm_expected <- matrix(c(6, 120), nrow = 1, dimnames = list(rowtype(m), colnames(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
expect_equal(colprods_byname(m), colprodsm_expected)
expect_equal(colprods_byname(m, "E.ktoe"), colprodsm_expected %>% setrownames_byname("E.ktoe"))
# This also works with lists
expect_equal(colprods_byname(list(m, m)), list(colprodsm_expected, colprodsm_expected))
expect_equal(colprods_byname(list(m, m), "E.ktoe"),
list(colprodsm_expected %>% setrownames_byname("E.ktoe"),
colprodsm_expected %>% setrownames_byname("E.ktoe")))
expect_equal(colprods_byname(list(m, m), NULL), list(colprodsm_expected, colprodsm_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(colprods_byname(DF$m), list(colprodsm_expected, colprodsm_expected))
DF_expected <- data.frame(m = I(list()), iTm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"iTm"]] <- colprodsm_expected
DF_expected[[2,"iTm"]] <- colprodsm_expected
# Because DF_expected$iTm is created with I(list()), its class is "AsIs".
# Because DF$iTm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$iTm to NULL to get a match.
attr(DF_expected$iTm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(iTm = colprods_byname(m)), DF_expected)
})
test_that("colprods_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(1:6), nrow = 3, ncol = 2, dimnames = list(paste0("i", 3:1), paste0("p", 1:2)),
rowtype = "Industries", coltype = "Products")
colprodsM_expected <- matrix(c(6, 120), nrow = 1, dimnames = list(rowtype(M), colnames(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M))
res <- colprods_byname(M)
expect_true(is.Matrix(M))
matsbyname:::expect_equal_matrix_or_Matrix(res, colprodsM_expected)
matsbyname:::expect_equal_matrix_or_Matrix(colprods_byname(M, "E.ktoe"), colprodsM_expected %>% setrownames_byname("E.ktoe"))
})
test_that("prodall_byname() works as expected", {
m <- matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2))) %>%
setrowtype("Industry") %>% setcoltype("Product")
expect_equal(prodall_byname(m), 16)
expect_equal(m %>% rowprods_byname %>% colprods_byname,
matrix(16, nrow = 1, ncol = 1, dimnames = list(rowtype(m), coltype(m))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Also works for lists
expect_equal(prodall_byname(list(m,m)), list(16, 16))
# Also works for data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(prodall_byname(DF$m), list(16, 16))
DF_expected <- data.frame(m = I(list()), prodm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"prodm"]] <- 16
DF_expected[[2,"prodm"]] <- 16
# Because DF_expected$summ is created with I(list()), its class is "AsIs".
# Because DF$summ is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$summ to NULL to get a match.
attr(DF_expected$prodm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(prodm = prodall_byname(m)), DF_expected)
})
test_that("prodall_byname() works with Matrix objects", {
M <- matsbyname::Matrix(2, nrow = 2, ncol = 2, dimnames = list(paste0("i", 1:2), paste0("c", 1:2)),
rowtype = "Industry", coltype = "Product")
expect_equal(prodall_byname(M), 16)
matsbyname:::expect_equal_matrix_or_Matrix(M %>% rowprods_byname() %>% colprods_byname(),
matrix(16, nrow = 1, ncol = 1, dimnames = list(rowtype(M), coltype(M))) %>%
setrowtype(rowtype(M)) %>% setcoltype(coltype(M)))
})
test_that("Iminus_byname() works as expected", {
m <- matrix(c(-21, -12, -21, -10), ncol = 2, dimnames = list(c("b", "a"), c("b", "a"))) %>%
setrowtype("Industries") %>% setcoltype("Products")
Iminus_expected <- matrix(c(11, 12,
21, 22),
nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b"))) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m))
# Rows and columns of m are unsorted
expect_equal(diag(1, nrow = 2) - m, matrix(c(22, 12, 21, 11), nrow = 2, dimnames = dimnames(m)) %>%
setrowtype(rowtype(m)) %>% setcoltype(coltype(m)))
# Rows and columns of m are sorted prior to subtracting from the identity matrix
expect_equal(Iminus_byname(m), Iminus_expected)
# This also works with lists
expect_equal(Iminus_byname(list(m,m)), list(Iminus_expected, Iminus_expected))
# Also works with data frames
DF <- data.frame(m = I(list()))
DF[[1,"m"]] <- m
DF[[2,"m"]] <- m
expect_equal(Iminus_byname(DF$m), list(Iminus_expected, Iminus_expected))
DF_expected <- data.frame(m = I(list()), Iminusm = I(list()))
DF_expected[[1,"m"]] <- m
DF_expected[[2,"m"]] <- m
DF_expected[[1,"Iminusm"]] <- Iminus_expected
DF_expected[[2,"Iminusm"]] <- Iminus_expected
# Because DF_expected$Iminusm is created with I(list()), its class is "AsIs".
# Because DF$Iminusm is created from an actual calculation, its class is NULL.
# Need to set the class of DF_expected$Iminusm to NULL to get a match.
attr(DF_expected$Iminusm, which = "class") <- NULL
expect_equal(DF %>% dplyr::mutate(Iminusm = Iminus_byname(m)), DF_expected)
# If m is not square before subtracting from I,
# it will be made square by the function complete_and_sort.
m2 <- matrix(c(1,2,3,4,5,6), ncol = 2, dimnames = list(c("a", "b", "c"), c("a", "b"))) %>%
setrowtype("Industries") %>% setcoltype("Products")
expect_equal(Iminus_byname(m2),
matrix(c(0, -4, 0,
-2, -4, 0,
-3, -6, 1),
nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c"))) %>%
setrowtype(rowtype(m2)) %>% setcoltype(coltype(m2)))
})
test_that("iminus_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(-21, -12, -21, -10), nrow = 2, ncol = 2, dimnames = list(c("b", "a"), c("b", "a")),
rowtype = "Industries", coltype = "Products")
Iminus_expected <- matsbyname::Matrix(c(11, 12,
21, 22),
nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b")),
rowtype = rowtype(M), coltype = coltype(M))
# Rows and columns of m are unsorted
expect_equal(matsbyname::Matrix(diag(1, nrow = 2, ncol = 2) - M), matsbyname::Matrix(c(22, 12, 21, 11), nrow = 2, ncol = 2))
# Rows and columns of m are sorted prior to subtracting from the identity matrix
expect_equal(Iminus_byname(M), Iminus_expected)
# This also works with lists
expect_equal(Iminus_byname(list(M, M)), list(Iminus_expected, Iminus_expected))
})
test_that("clean_byname() works as expected", {
# Clean on rows
mat1 <- matrix(c(0,1,0,1), nrow = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols")
# Now clean in rows Should eliminate row 1.
expect_equal(mat1 %>% clean_byname(margin = 1, clean_value = 0),
matrix(1, nrow = 1, ncol = 2, dimnames = list("r (2)", c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
# No column consists of all zeroes. So nothing to clean in columns Should get "mat1" back.
expect_equal(mat1 %>% clean_byname(margin = 2, clean_value = 0), mat1)
# Clean on columns
mat2 <- matrix(c(0,0,1,1), nrow = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols")
# No row consists of all zeroes. So nothing to clean in rows. Should get "mat2" back.
expect_equal(mat2 %>% clean_byname(margin = 1, clean_value = 0), mat2)
# Now clean in columns. Should eliminate column 1.
expect_equal(mat2 %>% clean_byname(margin = 2, clean_value = 0),
matrix(1, nrow = 2, ncol = 1, dimnames = list(c("r (1)", "r (2)"), "c (2)")) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
})
test_that("clean_byname() works as expected for Matrix objects", {
Mat1 <- matsbyname::Matrix(c(0,1,0,1), nrow = 2, ncol = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)")),
rowtype = "Rows", coltype = "Cols")
# Now clean in rows Should eliminate row 1.
res1 <- Mat1 %>%
clean_byname(margin = 1, clean_value = 0)
expect_true(is.Matrix(res1))
matsbyname:::expect_equal_matrix_or_Matrix(res1,
matrix(1, nrow = 1, ncol = 2, dimnames = list("r (2)", c("c (1)", "c (2)"))) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
# No column consists of all zeroes. So nothing to clean in columns Should get "mat1" back.
matsbyname:::expect_equal_matrix_or_Matrix(Mat1 %>%
clean_byname(margin = 2, clean_value = 0),
Mat1)
# Clean on columns
Mat2 <- matsbyname::Matrix(c(0,0,1,1), nrow = 2, ncol = 2, dimnames = list(c("r (1)", "r (2)"), c("c (1)", "c (2)")),
rowtype = "Rows", coltype = "Cols")
res2 <- Mat2 %>%
clean_byname(margin = 1, clean_value = 0)
# No row consists of all zeroes. So nothing to clean in rows. Should get "mat2" back.
matsbyname:::expect_equal_matrix_or_Matrix(res2, Mat2)
# Now clean in columns. Should eliminate column 1.
res3 <- Mat2 %>%
clean_byname(margin = 2, clean_value = 0)
expect_true(is.Matrix(res3))
matsbyname:::expect_equal_matrix_or_Matrix(res3,
matrix(1, nrow = 2, ncol = 1, dimnames = list(c("r (1)", "r (2)"), "c (2)")) %>%
setrowtype("Rows") %>% setcoltype("Cols"))
})
test_that("cumsum_byname() works as expected", {
expect_null(cumsum_byname(NULL))
expect_true(is.na(cumsum_byname(NA)))
expect_equal(cumsum_byname(2), 2)
lst <- list(1, 2, 3, 4, 5)
lst_expected <- list(1, 3, 6, 10, 15)
expect_equal(cumsum_byname(lst), lst_expected)
# Try in a data frame.
DF <- data.frame(l1 = I(lst), l2 = I(lst))
CS <- DF %>%
dplyr::mutate(
cs1 = cumsum_byname(l1),
cs2 = cumsum_byname(l2)
)
expect_equal(CS$cs1, lst_expected)
expect_equal(CS$cs2, lst_expected)
# Try with matrices
rowmat <- matrix(c(1, 2, 3), nrow = 1)
expect_equal(cumsum_byname(rowmat), rowmat)
# Test in a list
expect_equal(cumsum_byname(list(rowmat, rowmat, rowmat)), list(rowmat, 2*rowmat, 3*rowmat))
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF2$m2, list(rowmat, 2*rowmat, 3*rowmat))
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("row") %>% setcoltype("col")
m2 <- matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2")) %>%
setrowtype("row") %>% setcoltype("col")
m3 <- matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3")) %>%
setrowtype("row") %>% setcoltype("col")
mlist <- list(m1, m2, m3)
expected <- list(m1, sum_byname(m1, m2), sum_byname(m1, m2) %>% sum_byname(m3))
expect_equal(cumsum_byname(mlist), expected)
# Ensure that groups are respected in the context of mutate.
DF3 <- tibble::tibble(grp = c("A", "A", "B"), m = mlist) %>%
dplyr::group_by(grp) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF3$m2, list(m1, sum_byname(m1, m2), m3))
})
test_that("cumsum_byname() works with Matrix objects", {
rowmat <- matsbyname::Matrix(c(1, 2, 3), nrow = 1, ncol = 3)
expect_equal(cumsum_byname(rowmat), rowmat)
# Test in a list
expect_equal(cumsum_byname(list(rowmat, rowmat, rowmat)), list(rowmat, 2*rowmat, 3*rowmat))
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumsum_byname(m)
)
expect_equal(DF2$m2, list(rowmat, 2*rowmat, 3*rowmat))
})
test_that("cumprod_byname() works as expected", {
expect_null(cumprod_byname(NULL))
expect_true(is.na(cumprod_byname(NA)))
expect_equal(cumprod_byname(2), 2)
lst <- list(1, 2, 3, 4, 5)
lst_expected <- list(1, 2, 6, 24, 120)
expect_equal(cumprod_byname(lst), lst_expected)
# Try in a data frame.
DF <- data.frame(l1 = I(lst), l2 = I(lst))
CS <- DF %>%
dplyr::mutate(
cs1 = cumprod_byname(l1),
cs2 = cumprod_byname(l2)
)
expect_equal(CS$cs1, lst_expected)
expect_equal(CS$cs2, lst_expected)
# Try with matrices
rowmat <- matrix(c(1, 2, 3), nrow = 1)
expect_equal(cumprod_byname(rowmat), rowmat)
# Test in a list
expected_powers <- list(rowmat, rowmat*rowmat, rowmat*rowmat*rowmat)
expect_equal(cumprod_byname(list(rowmat, rowmat, rowmat)), expected_powers)
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF2$m2, expected_powers)
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1")) %>%
setrowtype("row") %>% setcoltype("col")
m2 <- matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2")) %>%
setrowtype("row") %>% setcoltype("col")
m3 <- matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3")) %>%
setrowtype("row") %>% setcoltype("col")
mlist <- list(m1, m2, m3)
expected <- list(m1, sum_byname(m1, m2) * 0, (sum_byname(m1, m2, m3)) * 0)
expect_equal(cumprod_byname(mlist), expected)
# Ensure that groups are respected in the context of mutate.
# DF3 <- data.frame(grp = c("A", "A", "B"), m = I(mlist)) %>%
DF3 <- tibble::tibble(grp = c("A", "A", "B"), m = mlist) %>%
dplyr::group_by(grp) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF3$m2, list(m1, sum_byname(m1, m2) * 0, m3))
})
test_that("cumprod_byname() works with Matrix objects", {
# Try with matrices
rowmat <- matsbyname::Matrix(c(1, 2, 3), nrow = 1, ncol = 3)
expect_equal(cumprod_byname(rowmat), rowmat)
# Test in a list
expected_powers <- list(rowmat, rowmat*rowmat, rowmat*rowmat*rowmat)
expect_equal(cumprod_byname(list(rowmat, rowmat, rowmat)), expected_powers)
# Test in a data frame
DF2 <- data.frame(m = I(list(rowmat, rowmat, rowmat))) %>%
dplyr::mutate(
m2 = cumprod_byname(m)
)
expect_equal(DF2$m2, expected_powers)
# Test with a matrix that will take advantage of the "by name" aspect of sum_byname
m1 <- matsbyname::Matrix(c(1), nrow = 1, ncol = 1, dimnames = list("r1", "c1"), rowtype = "row", coltype = "col")
m2 <- matsbyname::Matrix(c(2), nrow = 1, ncol = 1, dimnames = list("r2", "c2"), rowtype = "row", coltype = "col")
m3 <- matsbyname::Matrix(c(3), nrow = 1, ncol = 1, dimnames = list("r3", "c3"), rowtype = "row", coltype = "col")
mlist <- list(m1, m2, m3)
res <- cumprod_byname(mlist)
expected <- list(m1, sum_byname(m1, m2) * 0, (sum_byname(m1, m2, m3)) * 0)
for (i in 1:3) {
expect_true(is.Matrix(res[[i]]))
matsbyname:::expect_equal_matrix_or_Matrix(res[[i]], expected[[i]])
}
})
test_that("replaceNaN() works as expected", {
expected <- matrix(c(1, 0))
suppressWarnings(a <- matrix(c(1, sqrt(-1))))
expect_equal(replaceNaN_byname(a), expected)
# Should work with lists
expect_equal(replaceNaN_byname(list(a,a)), list(expected, expected))
# Try with a different value
expect_equal(replaceNaN_byname(a, 42), matrix(c(1,42)))
})
test_that("replaceNaN_byname() works with Matrix objects", {
suppressWarnings(a <- matsbyname::Matrix(c(1,
sqrt(-1)), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
rowtype = "row", coltype = "col"))
expected <- matsbyname::Matrix(c(1,
0), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
rowtype = "row", coltype = "col")
expect_equal(replaceNaN_byname(a), expected)
# Should work with lists
expect_equal(replaceNaN_byname(list(a,a)), list(expected, expected))
# Try with a different value
expect_equal(replaceNaN_byname(a, 42),
matsbyname::Matrix(c(1,
42), byrow = TRUE,
nrow = 2, ncol = 1,
dimnames <- list(c("r1", "r2"), "c1"),
coltype = "col", rowtype = "row"))
})
test_that("replaceNaN_byname() works with nothing to replace and sparseMatrix objects", {
m <- Matrix::sparseMatrix(i = c(1, 2, 2),
j = c(1, 5, 6),
x = c(11, 25, 26),
dimnames = list(paste0("r", 1:2), paste0("c", 1:6)))
# This errored when m had nothing to replace.
replaced <- replaceNaN_byname(m)
expect_equal(replaced, m)
})
test_that("count_vals_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_byname(m), 2)
expect_equal(count_vals_byname(m, compare_fun = "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = `==`, 0), 2)
expect_equal(count_vals_byname(m, "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = "!="), 4)
expect_equal(count_vals_byname(m, compare_fun = `!=`), 4)
expect_equal(count_vals_byname(m, "<", 1), 2)
expect_equal(count_vals_byname(m, "<=", 1), 3)
expect_equal(count_vals_byname(m, ">=", 3), 2)
expect_equal(count_vals_byname(m, ">", 4), 0)
expect_equal(count_vals_byname(m, `>`, 4), 0)
# Should also work for lists
l <- list(m, m)
expect_equal(count_vals_byname(l, `>`, 4), list(0, 0))
})
test_that("count_vals_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_byname(m), 2)
expect_equal(count_vals_byname(m, compare_fun = "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = `==`, 0), 2)
expect_equal(count_vals_byname(m, "==", 0), 2)
expect_equal(count_vals_byname(m, compare_fun = "!="), 4)
expect_equal(count_vals_byname(m, compare_fun = `!=`), 4)
expect_equal(count_vals_byname(m, "<", 1), 2)
expect_equal(count_vals_byname(m, "<=", 1), 3)
expect_equal(count_vals_byname(m, ">=", 3), 2)
expect_equal(count_vals_byname(m, ">", 4), 0)
expect_equal(count_vals_byname(m, `>`, 4), 0)
# Should also work for lists
l <- list(m, m)
expect_equal(count_vals_byname(l, `>`, 4), list(0, 0))
})
test_that("compare_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
expect_equal(compare_byname(m), matrix(c(TRUE, FALSE, FALSE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
expect_equal(compare_byname(m, "<", 3),
matrix(c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
})
test_that("compare_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
matsbyname:::expect_equal_matrix_or_Matrix(compare_byname(m),
matsbyname::Matrix(c(TRUE, FALSE, FALSE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
expect_equal(compare_byname(m, "<", 3),
matsbyname::Matrix(c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE), nrow = 3, ncol = 2))
})
test_that("count_vals_inrows_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_inrows_byname(m), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = `==`, 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = "!="), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, compare_fun = `!=`), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "<", 1), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, "<=", 1), matrix(1, nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, ">=", 3), matrix(c(1, 1, 0), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, ">", 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
expect_equal(count_vals_inrows_byname(m, `>`, 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 0, 0), nrow = 3, ncol = 1)
expect_equal(count_vals_inrows_byname(l, `>`, 4), list(ans, ans))
})
test_that("count_vals_inrows_byname() works with Matrix objects", {
m <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m),
matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = `==`, 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "==", 0), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = "!="), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, compare_fun = `!=`), matrix(c(1, 2, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "<", 1), matrix(c(1, 0, 1), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, "<=", 1), matrix(1, nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, ">=", 3), matrix(c(1, 1, 0), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, ">", 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_inrows_byname(m, `>`, 4), matrix(c(0, 0, 0), nrow = 3, ncol = 1))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 0, 0), nrow = 3, ncol = 1)
Map(f = matsbyname:::expect_equal_matrix_or_Matrix, count_vals_inrows_byname(l, `>`, 4), list(ans, ans))
})
test_that("count_vals_incols_byname() works as expected", {
m <- matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
expect_equal(count_vals_incols_byname(m), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = `==`, 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = "!="), matrix(c(2, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, compare_fun = `!=`), matrix(c(2, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "<", 1), matrix(c(1, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, "<=", 1), matrix(c(2, 1), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, ">=", 3), matrix(c(0, 2), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, ">", 4), matrix(c(0, 0), nrow = 1, ncol = 2))
expect_equal(count_vals_incols_byname(m, `>`, 4), matrix(c(0, 0), nrow = 1, ncol = 2))
# Should also work for lists
l <- list(m, m)
ans <- matrix(c(0, 2), nrow = 1, ncol = 2)
expect_equal(count_vals_incols_byname(l, `>`, 2), list(ans, ans))
})
test_that("count_vals_incols_byname() works with Matrix objects", {
M <- matsbyname::Matrix(c(0, 1, 2, 3, 4, 0), nrow = 3, ncol = 2)
# By default, looks for 0's and checks for equality
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = `==`, 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "==", 0), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = "!="), matrix(c(2, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, compare_fun = `!=`), matrix(c(2, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "<", 1), matrix(c(1, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, "<=", 1), matrix(c(2, 1), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, ">=", 3), matrix(c(0, 2), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, ">", 4), matrix(c(0, 0), nrow = 1, ncol = 2))
matsbyname:::expect_equal_matrix_or_Matrix(count_vals_incols_byname(M, `>`, 4), matrix(c(0, 0), nrow = 1, ncol = 2))
# Should also work for lists
l <- list(M, M)
ans <- matrix(c(0, 2), nrow = 1, ncol = 2)
Map(f = matsbyname:::expect_equal_matrix_or_Matrix, count_vals_incols_byname(l, `>`, 2), list(ans, ans))
})
test_that("any_byname() works as expected", {
m <- matrix(rep(TRUE, times = 4), nrow = 2, ncol = 2)
expect_true(all_byname(m))
expect_true(any_byname(m))
n <- matrix(c(TRUE, FALSE), nrow = 2, ncol = 1)
expect_false(all_byname(n))
expect_true(any_byname(n))
# Also works for lists
expect_equal(all_byname(list(m,m)), list(TRUE, TRUE))
expect_equal(any_byname(list(m,m)), list(TRUE, TRUE))
expect_equal(all_byname(list(n,n)), list(FALSE, FALSE))
expect_equal(any_byname(list(n,n)), list(TRUE, TRUE))
})
test_that("any_byname() works as expected with Matrix objexts", {
M <- matsbyname::Matrix(rep(TRUE, times = 4), nrow = 2, ncol = 2)
expect_true(all_byname(M))
expect_true(any_byname(M))
N <- matsbyname::Matrix(c(TRUE, FALSE), nrow = 2, ncol = 1)
expect_false(all_byname(N))
expect_true(any_byname(N))
# Also works for lists
expect_equal(all_byname(list(M, M)), list(TRUE, TRUE))
expect_equal(any_byname(list(M, M)), list(TRUE, TRUE))
expect_equal(all_byname(list(N, N)), list(FALSE, FALSE))
expect_equal(any_byname(list(N, N)), list(TRUE, TRUE))
})
test_that("rename_to_pref_suff_byname() works as expected", {
m <- matrix(1:4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
# This aggregation should simply return m with a renamed column.
res <- rename_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("rename_to_pref_suff_byname() works with Matrix objects", {
m <- matsbyname::Matrix(1:4, nrow = 4, ncol = 1, dimnames = list(letters[1:4], "Product -> Industry"))
# This aggregation should simply return m with a renamed column.
res <- rename_to_pref_suff_byname(m, keep = "suff", margin = 2, notation = RCLabels::arrow_notation)
expected <- m %>%
magrittr::set_colnames("Industry")
expect_equal(res, expected)
})
Try the matsbyname package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.