test_that("markdown column labels - no spanning",{
mock_data <- tibble(rowlbl1 =c(rep("Completion Status",12),rep("Primary reason for withdrawal",28)),
rowlbl2 =c(rep("Completed",4),rep("Prematurely Withdrawn",4),rep("Unknown",4),rep("Adverse Event",4),rep("Lost to follow-up",4),rep("Protocol violation",4),rep("Subject decided to withdraw",4),rep("Protocol Violation",4),rep("Pre-Operative Dose[1]",4),rep("Other",4)),
param=c(rep(c("n","n","pct","pct"),10)),
column=c(rep(c("Placebo
(N=20)","Treatment"),20)),
value=c(24,19,2400/48,1900/38,5,1,500/48,100/38,19,18,1900/48,1800/38,1,1,100/48,100/38,0,0,0,0,0,0,0,0,1,1,100/48,100/38,1,4,100/48,400/38,1,0,100/48,0,2,3,200/48,300/38)
)
test_tfrmt <- tfrmt(
# specify columns in the data
group = c(rowlbl1),
label = rowlbl2,
column = column,
param = param,
value = value,
# set formatting for values
body_plan = body_plan(
frmt_structure(
group_val = ".default",
label_val = ".default",
frmt_combine(
"{n} {pct}",
n = frmt("xxx"),
pct = frmt_when("==100" ~ "",
"==0" ~ "",
TRUE ~ frmt("(xx.x %)"))
)
)
),
# Specify row group plan
# Indent the rowlbl2
row_grp_plan = row_grp_plan(
row_grp_structure(group_val = ".default", element_block(post_space = " ")),
label_loc = element_row_grp_loc(location = "indented")
)
) %>%
print_to_gt(mock_data) %>%
tab_options(container.width = 1000)
# test that format of column headers is markdown
expect_equal(lapply(test_tfrmt$`_boxhead`$column_label,attr,"class"),
as.list(rep("from_markdown",length(test_tfrmt$`_boxhead`$column_label)))
)
})
test_that("markdown column labels - spanning", {
# set up data for tfrmt
mock_data <- tibble::tribble(
~`Pooled Id`, ~`Site Id`,
"701", "701",
"703", "703",
"704", "704",
"705", "705",
"708", "708",
"709", "709",
"710", "710",
"713", "713",
"716", "716",
"718", "718",
"900", "702",
"900", "706",
"900", "707",
"900", "711",
"900", "714",
"900", "715",
"900", "717",
"Total", " ") %>%
crossing(col1 = c("Placebo (N=86)",
"Xanomeline Low Dose
(N=84)",
"Xanomeline High Dose (N=84)",
"Total (N=254)"),
col2 = factor(c("ITT (N=10)", "Eff", "Com"), levels = c("ITT (N=10)", "Eff", "Com"))) %>%
mutate(val = rpois(216, 15),
param = "val")
# create output with spanning headers
test_tfrmt<-tfrmt(
param = "param",
value = "val",
column = vars(col1, col2),
body_plan = body_plan(
frmt_structure(group_val = ".default", label_val = ".default", frmt("XX"))
),
row_grp_plan = row_grp_plan(label_loc =element_row_grp_loc("column")),
col_plan = col_plan(
`Pooled Id`, `Site Id`,
contains("Placebo"),
contains("High Dose"),
contains("Low Dose"),
everything()
)
) %>%
print_to_gt(mock_data)
# test that format of both column headers and spannning headers is markdown
expect_equal(lapply(test_tfrmt$`_boxhead`$column_label,attr,"class"),
as.list(rep("from_markdown",length(test_tfrmt$`_boxhead`$column_label)))
)
expect_equal(lapply(test_tfrmt$`_spanners`$spanner_label,attr,"class"),
as.list(rep("from_markdown",length(test_tfrmt$`_spanners`$spanner_label)))
)
})
test_that("markdown column labels - renamed", {
mock_data <- tibble::tribble(
~group, ~label, ~my_col, ~parm, ~val,
"g1", "rowlabel1", "col1" , "value", 1,
"g1", "rowlabel1", "col2" , "value", 1,
"g1", "rowlabel1", "mycol3", "value", 1,
"g1", "rowlabel1", "col4" , "value", 1,
"g1", "rowlabel1", "mycol5", "value", 1,
"g1", "rowlabel2", "col1" , "value", 2,
"g1", "rowlabel2", "col2" , "value", 2,
"g1", "rowlabel2", "mycol3", "value", 2,
"g1", "rowlabel2", "col4" , "value", 2,
"g1", "rowlabel2", "mycol5", "value", 2,
"g2", "rowlabel3", "col1" , "value", 3,
"g2", "rowlabel3", "col2" , "value", 3,
"g2", "rowlabel3", "mycol3", "value", 3,
"g2", "rowlabel3", "col4" , "value", 3,
"g2", "rowlabel3", "mycol5", "value", 3)
test_tfrmt <- tfrmt(
group = group,
label = label,
param = parm,
value = val,
column = my_col,
body_plan = body_plan(
frmt_structure(group_val = ".default", label_val = ".default", frmt("x"))
),
col_plan = col_plan(
group,
label,
starts_with("col"),
"test
newline" = mycol3,
-mycol5
)
) %>%
print_to_gt(mock_data)
expect_equal(lapply(test_tfrmt$`_boxhead`$column_label,attr,"class"),
as.list(rep("from_markdown",length(test_tfrmt$`_boxhead`$column_label)))
)
})
test_that("column spanners and labels are appropriately aligned", {
dat <- tibble::tribble(
~ group, ~label, ~span1, ~span2, ~lower, ~param, ~val,
"mygrp", "mylbl", "span01", "span1", "lower1_a", "prm", 1,
"mygrp", "mylbl", "span01", "span1", "lower1_b", "prm",1,
"mygrp", "mylbl", "span01", "span2", "lower2_a", "prm",1,
"mygrp", "mylbl", "span01", "span2", "lower2_b", "prm",1,
"mygrp", "mylbl", "span02", "span3", "lower2_a", "prm",1,
"mygrp", "mylbl", "span02", "span3", "lower2_b", "prm",1
)
tfrmt_spec <- tfrmt(
group = "group",
label = "label",
param = "param",
column =c("span1", "span2","lower"),
value = "val",
body_plan = body_plan(
frmt_structure(group_val = ".default", label_val = ".default", frmt("x.xx"))
)
)
gt_out <- tfrmt_spec %>%
print_to_gt(.data = dat)
# reconstruct the original columns from the gt object
# get spanner labels
spans <- gt_out$`_spanners` %>%
select(var = vars, spanner_label, spanner_level ) %>%
unnest(everything())
# get lower labels
lower <- gt_out$`_boxhead` %>%
select(var, column_label) %>%
unnest(everything())
# get tfrmt cols from spec
chr_cols <- map_chr(tfrmt_spec$column, as_name) %>% rev
# combine spanner & lower labels and rename as per tfrmt spec
gt_cols <- dplyr::full_join(lower, spans, by = "var", multiple = "all") %>%
unique %>%
dplyr::filter(!is.na(spanner_label)) %>%
tidyr::pivot_wider(names_from = spanner_level,
values_from = spanner_label) %>%
dplyr::select(-var) %>%
setNames(., chr_cols)
# original data - keep tfrmt spec cols
orig_cols <- dat %>%
dplyr::select(all_of(chr_cols)) %>%
unique
expect_equal(gt_cols,
orig_cols,
ignore_attr = TRUE)
})