context("rtables") test_that("rtable design decisions", { # An rtable gets created with header amd body specification t1 <- rtable( header = c("A", "B"), rrow("row 1", 1, 2), rrow("row 2", 3, 4), rrow("row 3", 5, 6) ) # t1 # t1[c(),] # t1[1,] # t1[1:2,] # t1[c(1,3),] t1 <- rtable(header = c("A", "B"), format = "xx", rrow("row 1", 1, 2)) expect_identical(names(t1), c("A", "B")) expect_equal(dim(t1), c(1, 2)) expect_identical(row.names(t1), "row 1") expect_identical(as.vector(t1[1, 1]), 1) expect_identical(as.vector(t1[1, 2]), 2) tbl <- rtable( header = c("Treatment\nN=100", "Comparison\nN=300"), format = "xx (xx.xx%)", rrow("A", c(104, .2), c(100, .4)), rrow("B", c(23, .4), c(43, .5)), rrow(), rrow("this is a very long section header"), rrow("estimate", rcell(55.23, "xx.xx", colspan = 2)), rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2)) ) tbl ## see redesign/breaking_changes.md ## expect_identical(names(tbl), c("Treatment\nN=100", "Comparison\nN=300")) expect_identical(names(tbl), c("Treatment", "Comparison")) ## replace once the colspan rows are uncommented expect_equal(dim(tbl), c(6, 2)) expect_identical(row.names(tbl), c("A", "B", "", "this is a very long section header", "estimate", "95% CI")) expect_identical(as.vector(tbl[1, 1]), c(104, .2)) expect_identical(as.vector(tbl[1, 2]), c(100, .4)) expect_identical(as.vector(tbl[2, 1]), c(23, .4)) expect_identical(as.vector(tbl[2, 2]), c(43, .5)) expect_true(is.null(as.vector(tbl[3, 1]))) expect_true(is.null(as.vector(tbl[3, 2]))) expect_true(is.null(as.vector(tbl[4, 1]))) expect_true(is.null(as.vector(tbl[4, 2]))) expect_identical(as.vector(tbl[5, 1]), 55.23) expect_identical(as.vector(tbl[5, 2]), 55.23) expect_identical(as.vector(tbl[6, 1]), c(44.8, 67.4)) expect_identical(as.vector(tbl[6, 2]), c(44.8, 67.4)) t3 <- rtable( header = "B", format = "xx (xx.xx%)", rrow("group 1", c(1.1234, .20222)), rrow("group 2", c(4.3214, .432132)) ) t3 }) test_that("multi-header tables work", { t1 <- rtable( header = rheader( rrow(NULL, rcell("A", colspan = 2), rcell("B", colspan = 2)), rrow(NULL, "x", "y", "x", "y") ), rrowl(row.name = "row 1", 1:4), rrowl(row.name = "row 2", 4:1) ) ## printing it works res <- toString(t1) expect_equal(nrow(t1), 2) expect_equal(ncol(t1), 4) expect_equal(names(t1), c("A", "A", "B", "B")) t2 <- rtable( header = rheader( rrow(NULL, rcell("A"), rcell("B")), rrow(NULL, rcell(50L, format = "(N=xx)"), rcell(70L, format = "(N=xx)")) ), rrowl("row 1", 1:2) ) expect_identical(col_counts(t2), c(50L, 70L)) }) test_that("test sprintf based format", { expect_equal(format_rcell(rcell(12.213743534, sprintf_format("%.3f"))), "12.214") expect_equal(format_rcell(rcell(12.2134543534, sprintf_format("%.3f"))), "12.213") expect_equal(format_rcell(rcell(c(12.21, 7.321), sprintf_format("%.1f and %.2f"))), "12.2 and 7.32") }) test_that("test p-value format", { expect_equal(format_rcell(rcell(0.02, "x.xxxx | (<0.0001)")), "0.0200") expect_equal(format_rcell(rcell(0.0234934, "x.xxxx | (<0.0001)")), "0.0235") expect_equal(format_rcell(rcell(0.00000001, "x.xxxx | (<0.0001)")), "<0.0001") }) test_that("test 3d format (estimate and CI)", { expect_equal(format_rcell(rcell(c(0.02, -0.05, 0.0434235), "xx.xx (xx.xx - xx.xx)")), "0.02 (-0.05 - 0.04)") expect_equal(format_rcell(rcell(c(12.34590, 3.2359, 324.2492), "xx.xx (xx.xx - xx.xx)")), "12.35 (3.24 - 324.25)") }) test_that("df_to_tt works", { mttt <- df_to_tt(mtcars) expect_identical(dim(mttt), dim(mtcars)) expect_identical(names(mttt), names(mtcars)) expect_identical(row.names(mttt), row.names(mtcars)) expect_equal(lapply(seq_along(mtcars[[1]]), function(i) unclass(mtcars[i, ])), unname(cell_values(mttt)), check.attributes = FALSE ) }) test_that("non-ref-rcell works", { expect_identical(format_rcell(non_ref_rcell(5, TRUE)), "") expect_identical(format_rcell(non_ref_rcell(5, FALSE)), "5") }) test_that("rtablel works", { tbl <- rtablel( c("hi", "there"), list(rrow("", 5, 6), rrow("B", 6, "")), list(rrow("C", 7, 8), rrow("what", 10, 11)) ) expect_identical(dim(tbl), c(4L, 2L)) expect_identical( unname(unlist(cell_values(tbl))), c("5", "6", "6", "", "7", "8", "10", "11") ) })