ga_to_mat <- function(ga) { mat_nrow <- mat_ncol <- ncol(ga) matrix(ga, nrow = mat_nrow, ncol = mat_nrow, byrow = TRUE) } # ga_to_mat(calc_chol$chol_x) get_upper_tri2 <- function(mat) { mat[upper.tri(mat)] } get_lower_tri <- function(mat) { mat[lower.tri(mat)] } expect_upper_tri <- function(object) { act <- quasi_label(rlang::enquo(object), arg = "object") act$mat <- object[1, , ] act$upper_tri <- get_upper_tri2(act$mat) act$lower_tri <- get_lower_tri(act$mat) all_lower_zero <- all(act$lower_tri == 0) all_upper_non_zero <- all(act$upper_tri != 0) is_upper_tri <- all_lower_zero && all_upper_non_zero if (is_upper_tri) { succeed() return(invisible(act$val)) } if (!all_lower_zero) { vals <- glue::glue_collapse( glue::glue("{round(act$lower_tri, 3)}"), sep = " " ) msg <- glue::glue( "{act$lab} is not upper triangular. Values below the \\ main diagonal are not all zero: {vals}" ) } if (!all_upper_non_zero) { vals <- glue::glue_collapse( glue::glue("{round(act$upper_tri, 3)}"), sep = " " ) msg <- glue::glue_collapse(glue::glue( "{act$lab} is not upper triangular. Some values above \\ the main diagonal contain zero: {vals}" )) } fail(msg) } expect_square <- function(object) { # 1. Capture object and label act <- quasi_label(rlang::enquo(object), arg = "object") # 2. Call expect() act$nrow <- dim(act$val[1, , ])[1] act$ncol <- dim(act$val[1, , ])[2] expect( ok = act$nrow == act$ncol, failure_message = glue::glue( "{act$lab} has dim {act$nrow}x{act$ncol}, and is not square." ) ) # 3. Invisibly return the value invisible(act$val) } # expect_square(calc_chol$chol_x) # expect_square(array(data = 1:9, c(1,3,3))) # expect_square(array(data = 1:12, c(1,3,4))) expect_symmetric <- function(object) { # 1. Capture object and label act <- quasi_label(rlang::enquo(object), arg = "object") act$mat <- ga_to_mat(object) act$upper <- get_upper_tri2(act$mat) act$lower <- get_lower_tri(act$mat) # 2. Call expect() expect( ok = all.equal(act$upper, act$lower), failure_message = glue::glue("{act$lab} is not symmetric") ) # 3. Invisibly return the value invisible(act$val) } # xmat <- calculate(x, nsim = 1)[[1]] |> ga_to_mat() # # xmat # # expect_symmetric(calculate(x, nsim = 1)[[1]]) # # all.equal(get_lower_tri(xmat),get_upper_tri2(xmat))