test_that("gtTable", { 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 gtTableInternal <- gtTableInternal( table_to_format, style = list( "header" = list( gt::cell_fill(color = "#c8c8c8"), gt::cell_text(weight = "bold") ), "header_name" = list(gt::cell_fill(color = "#d9d9d9"), gt::cell_text(weight = "bold")), "header_level" = list(gt::cell_fill(color = "#e1e1e1"), gt::cell_text(weight = "bold")), "column_name" = list(gt::cell_text(weight = "bold")), "title" = list(gt::cell_text(weight = "bold", color = "blue")) ), na = NULL, title = "Test 1", subtitle = NULL, caption = NULL, groupColumn = NULL, groupAsColumn = FALSE, groupOrder = NULL ) # Spanners expect_equal( gtTableInternal$`_spanners`$spanner_label |> unlist(), c("overall", "age_group &&& sex", "sex", "age_group", "overall", "age_group &&& sex", "sex", "age_group", "Study strata", "cohort1", "cohort2", "Study cohorts") ) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 1) == 8) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 2) == 1) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 3) == 2) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 4) == 1) # spanner styles expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level %in% c(1,3)]] |> unlist() |> unique(), c("#E1E1E1", "bold")) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level %in% c(2,4)]] |> unlist() |> unique(), c("#C8C8C8", "bold")) # title expect_true(gtTableInternal$`_heading`$title == "Test 1") expect_true(is.null(gtTableInternal$`_heading`$subtitle)) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "title"] |> unlist(), c("cell_text.color" = "#0000FF", "cell_text.weight" = "bold")) # column names expect_equal(unlist(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "columns_columns"])[1:36] |> unique(), c("#E1E1E1", "bold")) expect_true(unlist(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "columns_columns"])[37:44] |> unique() == "bold") expect_false(lapply(gtTableInternal$`_boxhead`$column_label, function(x){grepl("\\[header_level\\]", x)}) |> unlist() |> unique()) # na expect_identical(gtTableInternal$`_substitutions`, list()) # Group labels expect_true(is.null(gtTableInternal$`_stub_df`$group_label |> unlist())) expect_false(gtTableInternal$`_options`$value[gtTableInternal$`_options`$parameter == "row_group_as_column"] |> unlist()) # Input 2 ---- table_to_format <- mockSummarisedResult() |> formatEstimateName(estimateName = c("N (%)" = " (%)", "N" = "")) |> formatHeader(header = c("strata_name", "strata_level"), includeHeaderName = TRUE) |> dplyr::select(-result_id) gtTableInternal <- gtTableInternal( table_to_format, style = list( "subtitle" = list(gt::cell_text(weight = "lighter", size = "large", color = "blue")), "body" = list(gt::cell_text(color = "red"), gt::cell_borders(sides = "all")), "group_label" = list(gt::cell_fill(color = "#e1e1e1")), "header_name" = list(gt::cell_fill(color = "black"), gt::cell_text(color = "white")), "column_name" = list(gt::cell_text(weight = "bold")) ), 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 expect_equal( gtTableInternal$`_spanners`$spanner_label |> unlist(), c("strata_level", "overall", "age_group &&& sex", "sex", "age_group", "strata_name") ) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 1) == 1) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 2) == 4) expect_true(sum(gtTableInternal$`_spanners`$spanner_level == 3) == 1) # spanner styles expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level %in% c(1,3)]] |> unlist() |> unique(), c("#000000", "#FFFFFF")) expect_true(is.null(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level == 2]] |> unlist() |> unique())) # title &&& subtitle expect_true(gtTableInternal$`_heading`$title == "Title test 2") expect_true(gtTableInternal$`_heading`$subtitle == "Subtitle for test 2") expect_true(is.null(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "title"] |> unlist())) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "subtitle"] |> unlist(), c("cell_text.color" = "#0000FF", "cell_text.size" = "large", "cell_text.weight" = "lighter")) # column names expect_true(length(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "columns_columns"] |> unlist()) == 8) expect_false(lapply(gtTableInternal$`_boxhead`$column_label, function(x){grepl("\\[header\\]|\\[header_name\\]", x)}) |> unlist() |> unique()) # na expect_equal(unique(gtTableInternal$`_data`$variable_level[1:3]), "-") # Group labels expect_equal(gtTableInternal$`_stub_df`$group_label |> unlist() |> unique(), c("cohort1", "cohort2")) expect_false(gtTableInternal$`_options`$value[gtTableInternal$`_options`$parameter == "row_group_as_column"] |> unlist()) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "row_groups"] |> unlist() |> unique(), c("#E1E1E1")) # caption expect_equal(gtTableInternal$`_options`[2, "value"] |> unlist(), c("value" = "*This* is the caption")) expect_equal(gtTableInternal$`_options`$value[gtTableInternal$`_options`$parameter == "table_caption"][[1]] |> attr("class"), "from_markdown") # body body_style <- gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "data" & gtTableInternal$`_styles`$rownum %in% 2:8] |> unlist() expect_equal(body_style[names(body_style) %in% c("cell_text.color", "cell_border_top.color", "cell_border_top.style")] |> unique(), c("solid","#D3D3D3", "#FF0000", "#000000")) # 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) gtTableInternal <- gtTableInternal( table_to_format, delim = ":", style = list( "subtitle" = list(gt::cell_text(weight = "lighter", size = "large", color = "blue")), "body" = list(gt::cell_text(color = "red"), gt::cell_borders(sides = "all")), "group_label" = list(gt::cell_fill(color = "#e1e1e1")), "header_name" = list(gt::cell_fill(color = "black"), gt::cell_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") ) # groupAsColumn expect_true(gtTableInternal$`_options`$value[gtTableInternal$`_options`$parameter == "row_group_as_column"] |> unlist()) # groupOrder expect_identical(gtTableInternal$`_row_groups`, c( "cohort2", "cohort1")) }) test_that("gtTable, 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 ---- gtTableInternal <- gtTableInternal( table_to_format, style = NULL, na = NULL, title = "Test 1", subtitle = NULL, caption = NULL, groupColumn = NULL, groupAsColumn = FALSE, groupOrder = NULL ) # style expect_true(gtTableInternal$`_styles`$styles[1][[1]]$cell_text$align == "right") expect_true(gtTableInternal$`_styles`$styles[182][[1]]$cell_text$align == "left") # 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) gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), 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 expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level %in% c(1,3)]] |> unlist() |> unique(), c("#D9D9D9", "center", "bold")) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level == 2]] |> unlist() |> unique(), c("#E1E1E1", "center", "bold")) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$grpname %in% gtTableInternal$`_spanners`$spanner_id[gtTableInternal$`_spanners`$spanner_level == 4]] |> unlist() |> unique(), c("#C8C8C8", "center", "bold")) # title expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "title"] |> unlist() |> unique(), c("15", "center", "bold")) expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "subtitle"] |> unlist() |> unique(), c("12", "center", "bold")) # column names expect_equal(unlist(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "columns_columns"])[1:27] |> unique(), c("#E1E1E1", "center", "bold")) expect_equal(unlist(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "columns_columns"])[28:43] |> unique(), c("center", "bold")) expect_false(lapply(gtTableInternal$`_boxhead`$column_label, function(x){grepl("\\[header_level\\]", x)}) |> unlist() |> unique()) # Group labels expect_equal(gtTableInternal$`_styles`$styles[gtTableInternal$`_styles`$locname == "row_groups"] |> unlist() |> unique(), c("#E9E9E9", "bold")) }) test_that("gtTable, test merge", { table_to_format<- mockSummarisedResult() |> formatHeader(header = c("strata_name", "strata_level")) |> dplyr::select(-result_id) # merge = "all" gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), 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(gtTableInternal$`_data`$cdm_name, c("mock", "", "", "", "", "", "", "mock", "", "", "", "", "", "")) expect_equal(gtTableInternal$`_data`$variable_level, c("-", "-", "", "Amoxiciline", "", "Ibuprofen", "", "-", "-", "", "Amoxiciline", "","Ibuprofen", "" )) expect_equal(gtTableInternal$`_data`$group_level|> levels(), c("cohort1", "cohort2")) # merge = c("cdm_name", "variable_name") gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("group_level" = "group_level"), groupAsColumn = TRUE, groupOrder = NULL, merge = c("cdm_name", "variable_level") ) expect_equal(gtTableInternal$`_data`$cdm_name, c("mock", "", "", "", "", "", "", "mock", "", "", "", "", "", "")) expect_equal(gtTableInternal$`_data`$variable_level, c("-", "", "", "Amoxiciline", "", "Ibuprofen", "", "-", "", "", "Amoxiciline", "","Ibuprofen", "" )) expect_equal(gtTableInternal$`_data`$group_level|> levels(), c("cohort1", "cohort2")) # no groupColumn gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = NULL, groupAsColumn = FALSE, groupOrder = NULL, merge = "all_columns" ) expect_equal(gtTableInternal$`_data`$cdm_name, c("mock", "", "", "", "", "", "", "", "", "", "", "", "", "")) expect_equal(gtTableInternal$`_data`$variable_level, c("-", "-", "-", "-", "-", "-", "Amoxiciline", "Amoxiciline", "Amoxiciline", "Amoxiciline", "Ibuprofen", "Ibuprofen", "Ibuprofen","Ibuprofen")) expect_null(gtTableInternal$`_data`$group_level|> levels()) }) test_that("groupColumn",{ table_to_format<- mockSummarisedResult() |> formatHeader(header = c("strata_name", "strata_level")) |> dplyr::select(-result_id) gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), 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, groupOrder = NULL, merge = "all_columns" ) expect_equal(gtTableInternal$`_data`$cdm_name, c("mock", "", "", "", "", "", "", "mock", "", "", "", "", "", "")) expect_equal(gtTableInternal$`_data`$variable_level, c("-", "-", "", "Amoxiciline", "", "Ibuprofen", "", "-", "-", "", "Amoxiciline", "","Ibuprofen", "" )) expect_equal(gtTableInternal$`_data`$group_name_group_level |> levels(), c('cohort_name; cohort1', 'cohort_name; cohort2')) gtTableInternal <- gtTableInternal( table_to_format, style = gtStyleInternal("default"), na = "-", title = "Title test 2", subtitle = "Subtitle for test 2", caption = "*This* is the caption", groupColumn = list("hi_there" = c("group_name", "group_level")), groupAsColumn = TRUE, groupOrder = NULL, merge = "all_columns" ) expect_equal(gtTableInternal$`_data`$hi_there |> levels(), c('cohort_name; cohort1', 'cohort_name; cohort2')) }) test_that("lifestyle::deprecate_soft works", { x <- mockSummarisedResult() expect_warning(gtTable(x)) })