## create temporary dataset to run the testing
data1 <- iris[1:2, ]
data2 <- data1 |> rtf_body(
as_colheader = TRUE,
col_rel_width = c(5, 9, 13, 18, 9)
)
# create rtf encode table
attr(data2, "page")$page_title <- "all"
attr(data2, "page")$page_footnote <- "last"
attr(data2, "page")$page_source <- "last"
data3 <- data2 |> rtf_encode_table()
test_that("RTF page, margin encoding", {
expect_snapshot_output(data3)
})
test_that("RTF colheader", {
d1 <- iris[1:100, ]
d2 <- d1 |> rtf_body(
as_colheader = TRUE,
col_rel_width = rep(1, ncol(d1))
)
attr(d2, "page")$page_title <- "all"
attr(d2, "page")$page_footnote <- "last"
attr(d2, "page")$page_source <- "last"
encode2 <- rtf_encode_table(d2)
colheader <- attr(d2, "rtf_colheader")
if (length(colheader) > 0) {
head <- attributes(colheader[[1]])$border_top
attributes(colheader[[1]])$border_top <- matrix(attr(d2, "page")$border_first, nrow = 1, ncol = ncol(head))
colheader_rtftext_1 <- lapply(colheader, rtf_table_content,
use_border_bottom = TRUE,
col_total_width = attr(d2, "page")$col_width
)
colheader_rtftext_2 <- unlist(colheader_rtftext_1)
colheader_rtftext_3 <- paste(unlist(colheader_rtftext_2), collapse = "\n")
}
expect_true(grep(colheader_rtftext_3, encode2, fixed = TRUE) == 2)
})
test_that("RTF header, footnote and source encoding", {
# create test data
d1 <- iris[1:2, ]
d2 <- d1 |> rtf_body(
as_colheader = TRUE,
col_rel_width = rep(1, ncol(d1)),
border_width = 12,
cell_height = 0.15,
page_by = NULL,
new_page = FALSE
)
d3 <- d2 |>
rtf_footnote("Test footnote xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
border_width = 15,
cell_height = 0.15,
cell_justification = "c",
) |>
rtf_source("[Source: mk9999testing]",
text_indent_first = 1, text_indent_left = 0,
text_indent_right = 0
) |>
rtf_title("Title Testing")
attr(d3, "page")$page_title <- "last"
attr(d3, "page")$page_footnote <- "first"
attr(d3, "page")$page_source <- "last"
encode <- d3 |> rtf_encode_table()
expect_true(grep(as_rtf_footnote(d3), encode, fixed = TRUE) == 2)
expect_true(grep(as_rtf_source(d3), encode, fixed = TRUE) == 2)
expect_true(grep(as_rtf_title(d3), encode, fixed = TRUE) == 2)
})
test_that("RTF header, footnote and source encoding for different location", {
# create test data
d1 <- iris[1:2, ]
d2 <- d1 |> rtf_body(
as_colheader = TRUE,
col_rel_width = rep(1, ncol(d1)),
border_width = 12,
cell_height = 0.15,
page_by = NULL,
new_page = FALSE
)
d3 <- d2 |>
rtf_footnote("Test footnote xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
border_width = 15,
cell_height = 0.15,
cell_justification = "c",
) |>
rtf_source("[Source: mk9999testing]",
text_indent_first = 1, text_indent_left = 0,
text_indent_right = 0
) |>
rtf_title("Title Testing")
attr(d3, "page")$page_title <- "first"
attr(d3, "page")$page_footnote <- "last"
attr(d3, "page")$page_source <- "first"
encode1 <- d3 |> rtf_encode_table()
# assign defult value ..
k <- attr(d3, "rtf_footnote")
attr(k, "border_bottom") <- attr(d3, "page")$border_last
attr(d3, "rtf_footnote") <- k
footnote_rtftext_1 <- as_rtf_footnote(d3)
expect_true(grep(as_rtf_footnote(d3), encode1, fixed = TRUE) == 2)
expect_true(grep(as_rtf_source(d3), encode1, fixed = TRUE) == 2)
expect_true(grep(as_rtf_title(d3), encode1, fixed = TRUE) == 2)
})
test_that("input value test if data frame or list of data frames", {
m <- iris[1:2, ]
m1 <- m |> rtf_body(
as_colheader = TRUE,
col_rel_width = c(5, 9, 13, 18, 9)
)
attr(m1, "page")$page_title <- "all"
attr(m1, "page")$page_footnote <- "last"
attr(m1, "page")$page_source <- "last"
m1 <- rtf_encode_table(m1)
expect_snapshot_output(m1)
})
test_that("Test case when source are included as table", {
m <- iris[1:2, ]
m1 <- m |>
rtf_body(
as_colheader = TRUE,
col_rel_width = c(5, 9, 13, 18, 9)
) |>
rtf_source("source text", as_table = TRUE)
attr(m1, "page")$page_title <- "all"
attr(m1, "page")$page_footnote <- "last"
attr(m1, "page")$page_source <- "last"
m1 <- rtf_encode_table(m1)
expect_snapshot_output(m1)
})
test_that("Test case when page_by var is not NULL", {
m <- iris[1:60, ]
m1 <- m |>
dplyr::arrange(Species) |>
rtf_body(
page_by = "Species",
as_colheader = TRUE,
col_rel_width = c(5, 9, 13, 18, 9),
border_color_bottom = "black",
border_color_last = "red"
)
attr(m1, "page")$page_title <- "all"
attr(m1, "page")$page_footnote <- "last"
attr(m1, "page")$page_source <- "last"
m1 <- rtf_encode_table(m1)
expect_snapshot_output(m1)
})
test_that("Test case when footnote and source display in all pages", {
m <- iris[1:60, ]
m1 <- m |>
dplyr::arrange(Species) |>
rtf_body(
page_by = "Species",
as_colheader = TRUE,
col_rel_width = c(5, 9, 13, 18, 9),
border_color_bottom = "black",
border_color_last = "red"
)
attr(m1, "page")$page_title <- "all"
attr(m1, "page")$page_footnote <- "last"
attr(m1, "page")$page_source <- "last"
m1 <- rtf_encode_table(m1)
expect_snapshot_output(m1)
})
# add additional test to increase coverage and for new feature
test_that("Test case when page$border_color_first is not NULL", {
ir <- head(iris, 2) |>
rtf_page(border_color_first = "red") |>
rtf_body()
ir <- rtf_encode_table(ir)
expect_snapshot_output(ir)
})
test_that("Test case when pageby$border_color_last is not NULL", {
ir2 <- head(iris, 2) |>
rtf_page(border_color_last = "red") |>
rtf_body()
ir2 <- rtf_encode_table(ir2)
expect_snapshot_output(ir2)
})
test_that("Test case when subline is not NULL", {
ir3 <- iris[c(1:4, 51:54), 3:5] |>
dplyr::mutate(s2 = paste0(Species, 1:2)) |>
dplyr::arrange(Species, s2) |>
rtf_colheader("patelLength|patelWidth|s2") |>
rtf_body(subline_by = "Species")
ir3 <- rtf_encode_table(ir3)
expect_snapshot_output(ir3)
})
test_that("Test case when subline is not NULL and verbose equals to TRUE", {
ir3 <- iris[c(1:4, 51:54), 3:5] |>
dplyr::mutate(s2 = paste0(Species, 1:2)) |>
dplyr::arrange(Species, s2) |>
rtf_colheader("patelLength|patelWidth|s2") |>
rtf_body(subline_by = "Species")
ir3 <- rtf_encode_table(ir3, verbose = TRUE)
expect_true(length(ir3$info) > 0)
})
test_that("Test case when using subline_by, page_by, group_by simultaneously in rtf_body", {
data(r2rtf_adae)
ae_t1 <- r2rtf_adae[200:260, ] |>
dplyr::mutate(
SUBLINEBY = paste0(
"Trial Number: ", STUDYID,
", Site Number: ", SITEID
),
) |>
dplyr::select(USUBJID, ASTDY, AEDECOD, TRTA, SUBLINEBY) |>
dplyr::arrange(SUBLINEBY, TRTA, USUBJID, ASTDY) |>
rtf_colheader("Subject| Rel Day | Adverse |") |>
rtf_body(
subline_by = "SUBLINEBY",
page_by = c("TRTA"),
group_by = c("USUBJID", "ASTDY"),
)
ae_t1 <- rtf_encode_table(ae_t1)
expect_snapshot_output(ae_t1)
})
test_that("Test case when using subline_by, page_by, group_by simultaneously with pageby_row = 'first_row' and new_page = TRUE in rtf_body", {
data(r2rtf_adae)
ae_t2 <- r2rtf_adae[200:260, ] |>
subset(USUBJID != "01-701-1442") |>
dplyr::mutate(
SUBLINEBY = paste0(
"Trial Number: ", STUDYID,
", Site Number: ", SITEID
),
) |>
dplyr::select(USUBJID, ASTDY, AEDECOD, TRTA, SUBLINEBY) |>
dplyr::arrange(SUBLINEBY, TRTA, USUBJID, ASTDY) |>
rtf_colheader("Subject| Rel Day | Adverse |",
border_bottom = "single"
) |>
rtf_body(
subline_by = "SUBLINEBY",
page_by = c("TRTA"),
pageby_row = "first_row",
new_page = TRUE,
group_by = c("USUBJID", "ASTDY")
)
ae_t2 <- rtf_encode_table(ae_t2)
expect_snapshot_output(ae_t2)
})
test_that("Test case when using subline_by, page_by, group_by simultaneously with pageby_row = 'first_row' and new_page = TRUE in rtf_body and rtf_subline not null and page_title is 'first' or 'last'", {
data(r2rtf_adae)
ae_t3 <- r2rtf_adae[200:260, ] |>
subset(USUBJID != "01-701-1442") |>
dplyr::mutate(
SUBLINEBY = paste0(
"Trial Number: ", STUDYID,
", Site Number: ", SITEID
),
) |>
dplyr::select(USUBJID, ASTDY, AEDECOD, TRTA, SUBLINEBY) |>
dplyr::arrange(SUBLINEBY, TRTA, USUBJID, ASTDY) |>
rtf_colheader("Subject| Rel Day | Adverse |",
border_bottom = "single"
) |>
rtf_body(
subline_by = "SUBLINEBY",
page_by = c("TRTA"),
pageby_row = "first_row",
new_page = TRUE,
group_by = c("USUBJID", "ASTDY")
) |>
rtf_subline("subline")
attr(ae_t3, "page")$page_title <- "first"
ae_t3a <- rtf_encode_table(ae_t3)
tmp <- lapply(
strsplit(ae_t3a$body, "\\page", fixed = TRUE)[[1]],
function(x) grepl("subline", x)
)
expect_true(tmp[[1]])
attr(ae_t3, "page")$page_title <- "last"
ae_t3b <- rtf_encode_table(ae_t3)
tmp <- lapply(
strsplit(ae_t3b$body, "\\page", fixed = TRUE)[[1]],
function(x) grepl("subline", x)
)
expect_true(tmp[[length(tmp)]])
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.