test_that("fxTableInternal", { table_to_format <- mockSummarisedResult() |> formatHeader(header = c("Study cohorts", "group_level", "Study strata", "strata_name", "strata_level"), includeHeaderName = FALSE) |> dplyr::select(-result_id) # Input 1 ---- # Title but no subtitle # Styles fxResult <- fxTableInternal( table_to_format, style = list( "header" = list( "cell" = officer::fp_cell(background.color = "#c8c8c8"), "text" = officer::fp_text(bold = TRUE)), "header_name" = list("cell" = officer::fp_cell(background.color = "#d9d9d9"), "text" = officer::fp_text(bold = TRUE)), "header_level" = list("cell" = officer::fp_cell(background.color = "#e1e1e1"), "text" = officer::fp_text(bold = TRUE)), "column_name" = list("text" = officer::fp_text(bold = TRUE)), "title" = list("text" = officer::fp_text(bold = TRUE, color = "blue")) ), na = NULL, title = "Test 1", subtitle = NULL, caption = NULL, groupColumn = NULL, groupAsColumn = FALSE, groupOrder = NULL ) # Spanners header_col_1 <- fxResult$header$dataset[, "Study cohorts\ncohort1\nStudy strata\noverall\noverall"] # cohort 1 - overall expect_equal(header_col_1, c("Test 1", "Study cohorts", "cohort1", "Study strata", "overall", "Study cohorts\ncohort1\nStudy strata\noverall\noverall")) # Spanner styles header_col_style <- fxResult$header$styles$cells$background.color$data[, "Study cohorts\ncohort1\nStudy strata\noverall\noverall"] expect_equal(header_col_style, c("#c8c8c8", "#c8c8c8", "#e1e1e1", "#c8c8c8", "#e1e1e1", "#e1e1e1")) expect_equal(fxResult$header$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") expect_equal(fxResult$header$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$header$styles$text$bold$data[, "cdm_name"] |> unique(), TRUE) expect_equal(fxResult$header$styles$text$color$data[, "cdm_name"][1], "blue") # default fxTableInternal format expect_equal(fxResult$body$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$body$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") # caption expect_null(fxResult$caption$value) # Alignment expect_equal(fxResult$body$styles$pars$text.align$data[1,9:26] |> unique(), "right") expect_equal(fxResult$body$styles$pars$text.align$data[3,9:26] |> unique(), "right") expect_equal(fxResult$body$styles$pars$text.align$data[5,9:26] |> unique(), "right") expect_equal(fxResult$body$styles$pars$text.align$data[1,1:8] |> unique(), "left") expect_equal(fxResult$body$styles$pars$text.align$data[3,1:8] |> unique(), "left") expect_equal(fxResult$body$styles$pars$text.align$data[5,1:8] |> unique(), "left") # Input 2 ---- table_to_format <- mockSummarisedResult() |> formatEstimateName(estimateName = c("N (%)" = " (%)", "N" = "")) |> formatHeader(header = c("strata_name", "strata_level"), includeHeaderName = TRUE) |> dplyr::select(-result_id) fxResult <- fxTableInternal( table_to_format, style = list( "subtitle" = list("text" = officer::fp_text(bold = TRUE, font.size = 12, color = "blue")), "body" = list("text" = officer::fp_text(color = "red"), "cell" = officer::fp_cell(border = officer::fp_border())), "group_label" = list("cell" = officer::fp_cell(background.color = "#e1e1e1")), "header_name" = list("cell" = officer::fp_cell(background.color = "black"), "text" = officer::fp_text(color = "white")), "column_name" = list("text" = officer::fp_text(bold = TRUE)) ), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = FALSE, groupOrder = NULL ) # Spanners header_col_1 <- fxResult$header$dataset[, "strata_name\noverall\nstrata_level\noverall"] # overall expect_equal(header_col_1, c("Title test 2", "Subtitle for test 2", "strata_name", "overall", "strata_level", "strata_name\noverall\nstrata_level\noverall")) # Spanner styles header_col_style <- fxResult$header$styles$cells$background.color$data[, "strata_name\noverall\nstrata_level\noverall"] expect_equal(header_col_style, c("black", "black", "black", "transparent", "black", "transparent")) expect_equal(fxResult$header$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") expect_equal(fxResult$header$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$header$styles$text$bold$data[, "cdm_name"] |> unique(), TRUE) expect_equal(fxResult$header$styles$text$color$data[, "cdm_name"], c("black", "blue", "black", "black", "black", "black")) expect_equal(fxResult$header$styles$text$color$data[, "strata_name\nage_group\nstrata_level\n>=40"], c("black", "blue", "white", "black", "white", "black")) # body expect_equal(fxResult$body$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), c(0,1)) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "black") expect_equal(fxResult$body$styles$cells$background.color$data[, "cdm_name"], c("#e1e1e1", "transparent", "transparent", "transparent", "transparent", "transparent", "#e1e1e1", "transparent", "transparent", "transparent", "transparent", "transparent")) expect_equal(fxResult$body$styles$text$color$data[, "cdm_name"] |> unique(), "red") # caption expect_equal(fxResult$caption$value, "*This* is the caption") # group label expect_equal(fxResult$body$spans$rows[1,], c(1, 17, rep(0, 16))) expect_equal(fxResult$body$spans$rows[7,], c(1, 17, rep(0, 16))) expect_equal(fxResult$body$spans$rows[3,], rep(1, 18)) # Input 3 ---- table_to_format <- mockSummarisedResult() |> formatEstimateName(estimateName = c("N (%)" = " (%)", "N" = "")) |> formatHeader(header = c("strata_name", "strata_level"), delim = ":", includeHeaderName = TRUE) |> dplyr::select(-result_id) fxResult <- fxTableInternal( table_to_format, delim = ":", style = list( "subtitle" = list("text" = officer::fp_text(bold = TRUE, font.size = 12, color = "blue")), "body" = list("text" = officer::fp_text(color = "red"), "cell" = officer::fp_cell(border = officer::fp_border())), "group_label" = list("cell" = officer::fp_cell(background.color = "#e1e1e1")), "header_name" = list("cell" = officer::fp_cell(background.color = "black"), "text" = officer::fp_text(color = "white")) ), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = TRUE, groupOrder = c("cohort2", "cohort1") ) # group label expect_equal(fxResult$body$spans$columns[,1], c(5, rep(0,4), 5, rep(0,4))) expect_equal(fxResult$body$dataset[,1] |> levels(), c("cohort2", "cohort1")) expect_equal(fxResult$body$spans$rows[3,], rep(1, 18)) expect_equal(fxResult$body$styles$cells$background.color$data[,1] |> unique(), "#e1e1e1") expect_equal(fxResult$body$styles$cells$background.color$data[,2] |> unique(), "transparent") }) test_that("fxTableInternal, test default styles and NULL", { table_to_format <- mockSummarisedResult() |> formatHeader(header = c("Study cohorts", "group_level", "Study strata", "strata_name", "strata_level"), includeHeaderName = FALSE) |> dplyr::select(-result_id) # Input 1: NULL ---- fxResult <- fxTableInternal( table_to_format, style = NULL, na = NULL, title = "Test 1", subtitle = NULL, caption = NULL, groupColumn = NULL, groupAsColumn = FALSE, groupOrder = NULL ) # Spanner styles expect_equal(unique(fxResult$header$styles$cells$background.color$data[, "Study cohorts\ncohort1\nStudy strata\noverall\noverall"]), "transparent") expect_equal(fxResult$header$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") expect_equal(fxResult$header$styles$cells$border.width.top$data[1,] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.width.top$data[2,] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.width.top$data[3,] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$header$styles$cells$border.color.left$data[2:6, "cdm_name"] |> unique(), "gray") expect_true(fxResult$header$styles$text$bold$data[1, "cdm_name"] |> unique()) expect_false(fxResult$header$styles$text$bold$data[2:6, "cdm_name"] |> unique()) # default fxTableInternal format expect_equal(fxResult$body$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$body$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") # Input 2 ---- table_to_format <- mockSummarisedResult() |> formatEstimateName(estimateName = c("N (%)" = " (%)", "N" = "")) |> formatHeader(header = c("Strata", "strata_name", "strata_level"), includeHeaderName = TRUE) |> dplyr::select(-result_id) style <- tableStyle(type = "flextable") |> rlang::eval_bare() fxResult <- fxTableInternal( table_to_format, style = style, na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = FALSE, groupOrder = NULL ) # Spanner styles header_col_style <- fxResult$header$styles$cells$background.color$data[, "Strata\nstrata_name\noverall\nstrata_level\noverall"] expect_equal(header_col_style, c("#c8c8c8", "#c8c8c8", "#c8c8c8", "#d9d9d9", "#e1e1e1", "#d9d9d9", "#e1e1e1")) expect_equal(fxResult$header$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") expect_equal(fxResult$header$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_true(fxResult$header$styles$text$bold$data[, "cdm_name"] |> unique()) expect_equal(fxResult$header$styles$text$color$data[, "cdm_name"] |> unique(), "black") expect_equal(fxResult$header$styles$text$color$data[, "cdm_name"] |> unique(), "black") expect_equal(fxResult$header$styles$text$font.size$data[, "cdm_name"] |> unique(), c(15, 12, 10)) # body expect_equal(fxResult$body$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(fxResult$body$styles$cells$background.color$data[, "cdm_name"], c("#e9e9e9", "transparent", "transparent", "transparent", "transparent","transparent", "#e9e9e9","transparent", "transparent", "transparent", "transparent", "transparent")) expect_equal(fxResult$body$styles$text$color$data[, "cdm_name"] |> unique(), "black") }) test_that("fxTableInternal, test merge", { table_to_format<- mockSummarisedResult() |> formatHeader(header = c("strata_name", "strata_level")) |> dplyr::select(-result_id) style <- tableStyle(type = "flextable") |> rlang::eval_bare() fxResult <- fxTableInternal( x = table_to_format, style = style, na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = FALSE, groupOrder = NULL, merge = "all_columns" ) expect_equal(fxResult$body$styles$cells$border.color.top$data[,1], c("gray", "black", "black", "black", "black", "black", "black", "black", "gray", "black", "black", "black", "black", "black", "black", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,2], c("gray", "gray", "black", "black", "black", "black", "black", "black", "gray", "gray", "black", "black", "black", "black", "black", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,4], c("gray", "gray", "gray", "black", "gray", "black", "black", "black", "gray", "gray", "gray", "black", "gray", "black", "black", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,5], c("gray", "gray", "gray", "black", "gray", "black", "gray", "black", "gray", "gray", "gray", "black", "gray", "black", "gray", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,16], c("gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray", "gray")) # merge = c("cdm_name", "variable_name") fxResult <- fxTableInternal( table_to_format, style = style, na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = FALSE, groupOrder = NULL, merge = c("cdm_name", "variable_name") ) expect_equal(fxResult$body$styles$cells$border.color.top$data[,1], c("gray", "black", "black", "black", "black", "black", "black", "black", "gray", "black", "black", "black", "black", "black", "black", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,2], c("gray", "gray", "black", "black", "black", "black", "black", "black", "gray", "gray", "black", "black", "black", "black", "black", "black")) expect_equal(fxResult$body$styles$cells$border.color.top$data[,4], c("gray", "gray", "gray", "black", "gray", "black", "black", "black", "gray", "gray", "gray", "black", "gray", "black", "black", "black")) }) test_that("multiple groupColumn", { table_to_format <- mockSummarisedResult() |> formatEstimateName(estimateName = c("N (%)" = " (%)", "N" = "")) |> formatHeader(header = c("strata_name", "strata_level"), delim = ":", includeHeaderName = TRUE) |> dplyr::select(-result_id) fxResult <- fxTableInternal( table_to_format, delim = ":", style = list( "subtitle" = list("text" = officer::fp_text(bold = TRUE, font.size = 12, color = "blue")), "body" = list("text" = officer::fp_text(color = "red"), "cell" = officer::fp_cell(border = officer::fp_border())), "group_label" = list("cell" = officer::fp_cell(background.color = "#e1e1e1"), "text" = officer::fp_text(color = "blue")), "header_name" = list("cell" = officer::fp_cell(background.color = "black"), "text" = officer::fp_text(color = "white")) ), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_name_group_level" = c("group_name", "group_level")), groupAsColumn = TRUE ) # Spanners header_col_1 <- fxResult$header$dataset[, "strata_name:overall:strata_level:overall"] # overall expect_equal(header_col_1, c("Title test 2", "Subtitle for test 2", "strata_name", "overall", "strata_level", "strata_name:overall:strata_level:overall")) # Spanner styles header_col_style <- fxResult$header$styles$cells$background.color$data[, "strata_name:overall:strata_level:overall"] expect_equal(header_col_style, c("black", "black", "black", "transparent", "black", "transparent")) expect_equal(fxResult$header$styles$cells$background.color$data[, "cdm_name"] |> unique(), "transparent") expect_equal(fxResult$header$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1.2) expect_equal(fxResult$header$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "gray") expect_equal(all(fxResult$header$styles$text$bold$data[, "cdm_name"] == c(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE)), TRUE) expect_equal(fxResult$header$styles$text$color$data[, "cdm_name"], c("black", "blue", "black", "black", "black", "black")) expect_equal(fxResult$header$styles$text$color$data[, "strata_name:age_group:strata_level:>=40"], c("black", "blue", "white", "black", "white", "black")) # body expect_equal(fxResult$body$styles$cells$border.width.top$data[, "cdm_name"] |> unique(), 1) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "cdm_name"] |> unique(), "black") expect_equal(fxResult$body$styles$text$color$data[, "cdm_name"] |> unique(), "red") expect_equal(fxResult$body$styles$cells$border.width.top$data[, "group_name_group_level"] |> unique(), 0) expect_equal(fxResult$body$styles$cells$border.color.left$data[, "group_name_group_level"] |> unique(), "black") expect_equal(fxResult$body$styles$text$color$data[, "group_name_group_level"] |> unique(), "blue") # caption expect_equal(fxResult$caption$value, "*This* is the caption") # group label expect_equal(fxResult$body$spans$rows[1,], rep(1, 17)) }) test_that("lifestyle::deprecate_soft works", { x <- mockSummarisedResult() expect_warning(fxTable(x)) }) test_that("abort when groupOrder doesn't match groupName", { x <- mockSummarisedResult() expect_error(fxTableInternal(x, groupColumn = c("variable_name", "variable_level"), groupOrder = "variable_name")) })