Skip to content

Commit

Permalink
fixes to checks for packages
Browse files Browse the repository at this point in the history
  • Loading branch information
@Melkiades
Melkiades committed Sep 20, 2023
1 parent d4438f3 commit e121e4a
Show file tree
Hide file tree
Showing 2 changed files with 116 additions and 104 deletions.
53 changes: 25 additions & 28 deletions R/tt_export.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -479,12 +479,7 @@ export_as_docx <- function(tt,
template_file = NULL,
section_properties = NULL) {
# Checks
if (!requireNamespace("flextable") || !requireNamespace("officer")) {
stop(
"This function requires the flextable and officer packages. ",
"Please install them if you wish to use it"
)
}
check_required_packages(c("flextable", "officer"))
if (inherits(tt, "VTableTree")) {
flex_tbl <- tt_to_flextable(tt, titles_as_header = titles_as_header)
} else {
Expand Down Expand Up @@ -595,7 +590,7 @@ margins_landscape <- function() {
#' @export
tt_to_flextable <- function(tt,
theme = theme_docx_default(tt),
border = officer::fp_border(width = 0.5),
border = flextable::fp_border_default(width = 0.5),
indent_size = NULL,
titles_as_header = TRUE,
paginate = FALSE,
Expand All @@ -606,15 +601,7 @@ tt_to_flextable <- function(tt,
tf_wrap = !is.null(cpp),
max_width = cpp,
total_width = 10) {
if (!requireNamespace("flextable") || !requireNamespace("officer")) {
stop(
"This function requires the flextable and officer packages. ",
"Please install them if you wish to use it"
)
}
if (!requireNamespace("checkmate")) {
stop("This function uses checkmate.")
}
check_required_packages(c("flextable", "checkmate"))
if (!inherits(tt, "VTableTree")) {
stop("Input table is not an rtables' object.")
}
Expand Down Expand Up @@ -765,12 +752,12 @@ tt_to_flextable <- function(tt,
#' custom_theme <- theme_docx_default(tbl,
#' font_size = 10,
#' font = "Brush Script MT",
#' border = officer::fp_border(color = "pink", width = 2),
#' border = flextable::fp_border_default(color = "pink", width = 2),
#' bold = NULL,
#' bold_manual = special_bold
#' )
#' tt_to_flextable(tbl,
#' border = officer::fp_border(color = "pink", width = 2),
#' border = flextable::fp_border_default(color = "pink", width = 2),
#' theme = custom_theme
#' )
#'
Expand All @@ -780,17 +767,9 @@ theme_docx_default <- function(tt = NULL, # Option for more complicated stuff
font_size = 9,
bold = c("header", "content_rows", "label_rows"),
bold_manual = NULL,
border = officer::fp_border(width = 0.5)) {
border = flextable::fp_border_default(width = 0.5)) {
function(flx) {
if (!requireNamespace("flextable") || !requireNamespace("officer")) { # nocov
stop(
"This function requires the flextable and officer packages. ",
"Please install them if you wish to use it"
) # nocov
}
if (!requireNamespace("checkmate")) { # nocov
stop("This function uses checkmate.") # nocov
}
check_required_packages(c("flextable", "checkmate"))
if (!inherits(flx, "flextable")) {
stop(sprintf(
"Function `%s` supports only flextable objects.",
Expand All @@ -806,6 +785,7 @@ theme_docx_default <- function(tt = NULL, # Option for more complicated stuff
eval(formals(theme_docx_default)$bold),
empty.ok = TRUE
)

# Font setting
flx <- flextable::fontsize(flx, size = font_size, part = "all") %>%
flextable::fontsize(size = font_size - 1, part = "footer") %>%
Expand All @@ -815,6 +795,12 @@ theme_docx_default <- function(tt = NULL, # Option for more complicated stuff
flx <- flx %>%
flextable::border_outer(part = "body", border = border) %>%
flextable::border_outer(part = "header", border = border)

# Vertical alignment -> all top for now, we will set it for the future
flx <- flx %>%
flextable::valign(j = 2:(NCOL(tt) + 1), valign = "top", part = "body") %>%
flextable::valign(j = 1, valign = "top", part = "body") %>%
flextable::valign(j = 2:(NCOL(tt) + 1), valign = "top", part = "header")

# Bold settings
if (any(bold == "header")) {
Expand Down Expand Up @@ -941,3 +927,14 @@ apply_alignments <- function(flx, aligns_df, part) {
.tab_to_colpath_set(fulltab)
)
}

check_required_packages <- function(pkgs) {
for (pkgi in pkgs) {
if (!requireNamespace(pkgi)) {
stop(
"This function requires the ", pkgi, " package. ",
"Please install it if you wish to use it"
)
}
}
}
167 changes: 91 additions & 76 deletions tests/testthat/test-exporters.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -224,85 +224,100 @@ test_that("export_as_rtf works", {
expect_true(file.exists(tmpf))
})

# Flextable and docx support ---------------------------------------------------

test_that("Can create flextable object that works with different styles", {

analysisfun <- function(x, ...) {
in_rows(row1 = 5,
row2 = c(1, 2),
.row_footnotes = list(row1 = "row 1 - row footnote"),
.cell_footnotes = list(row2 = "row 2 - cell footnote"))
}

lyt <- basic_table() %>%
split_cols_by("ARM") %>%
split_cols_by("SEX", split_fun = keep_split_levels(c("M", "F"))) %>%
split_rows_by("STRATA1") %>%
summarize_row_groups() %>%
split_rows_by("RACE", split_fun = keep_split_levels(c("WHITE", "ASIAN"))) %>%
analyze("AGE", afun = analysisfun)


tbl <- build_table(lyt, ex_adsl)
ft <- tt_to_flextable(tbl, total_width = 20)
expect_equal(sum(unlist(nrow(ft))), 20)

ft2 <- tt_to_flextable(tbl, paginate = TRUE, lpp = 20, verbose = TRUE)
expect_equal(length(ft2), 6)

expect_silent(ft3 <- tt_to_flextable(tbl, theme = NULL))

# Custom theme
special_bold <- list("header" = list("i" = c(1, 2), "j" = c(1, 3)),
"body" = list("i" = c(1, 2), "j" = 1))
custom_theme <- theme_docx_default(tbl,
font_size = 10,
font = "Brush Script MT",
border = officer::fp_border(color = "pink", width = 2),
bold = NULL,
bold_manual = special_bold)
expect_silent(tt_to_flextable(tbl, theme = custom_theme))

# Custom theme error
special_bold <- list("header" = list("asdai" = c(1, 2), "j" = c(1, 3)),
"body" = list("i" = c(1, 2), "j" = 1))
custom_theme <- theme_docx_default(tbl,
font_size = 10,
font = "Brush Script MT",
bold = NULL,
bold_manual = special_bold)
expect_error(tt_to_flextable(tbl, theme = custom_theme), regexp = "header")
analysisfun <- function(x, ...) {
in_rows(
row1 = 5,
row2 = c(1, 2),
.row_footnotes = list(row1 = "row 1 - row footnote"),
.cell_footnotes = list(row2 = "row 2 - cell footnote")
)
}

lyt <- basic_table() %>%
split_cols_by("ARM") %>%
split_cols_by("SEX", split_fun = keep_split_levels(c("M", "F"))) %>%
split_rows_by("STRATA1") %>%
summarize_row_groups() %>%
split_rows_by("RACE", split_fun = keep_split_levels(c("WHITE", "ASIAN"))) %>%
analyze("AGE", afun = analysisfun)


tbl <- build_table(lyt, ex_adsl)
ft <- tt_to_flextable(tbl, total_width = 20)
expect_equal(sum(unlist(nrow(ft))), 20)

ft2 <- tt_to_flextable(tbl, paginate = TRUE, lpp = 20, verbose = TRUE)
expect_equal(length(ft2), 6)

expect_silent(ft3 <- tt_to_flextable(tbl, theme = NULL))

# Custom theme
special_bold <- list(
"header" = list("i" = c(1, 2), "j" = c(1, 3)),
"body" = list("i" = c(1, 2), "j" = 1)
)
custom_theme <- theme_docx_default(tbl,
font_size = 10,
font = "Brush Script MT",
border = officer::fp_border(color = "pink", width = 2),
bold = NULL,
bold_manual = special_bold
)
expect_silent(tt_to_flextable(tbl, theme = custom_theme))

# Custom theme error
special_bold <- list(
"header" = list("asdai" = c(1, 2), "j" = c(1, 3)),
"body" = list("i" = c(1, 2), "j" = 1)
)
custom_theme <- theme_docx_default(tbl,
font_size = 10,
font = "Brush Script MT",
bold = NULL,
bold_manual = special_bold
)
expect_error(tt_to_flextable(tbl, theme = custom_theme), regexp = "header")

# internal package check
not_a_pkg <- "bwrereloakdosirabttjtaeerr"
expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg)
})

test_that("export_as_doc works thanks to tt_to_flextable", {
lyt <- make_big_lyt()
tbl <- build_table(lyt, rawdat)
top_left(tbl) <- "Ethnicity"
main_title(tbl) <- "Main title"
subtitles(tbl) <- c("Some Many", "Subtitles")
main_footer(tbl) <- c("Some Footer", "Mehr")
prov_footer(tbl) <- "Some prov Footer"
fnotes_at_path(tbl, rowpath = c("RACE", "BLACK")) <- "factor 2"
fnotes_at_path(tbl, rowpath = c("RACE", "BLACK"),
colpath = c("ARM", "ARM1", "SEX", "F")) <- "factor 3"

# Get the flextable
flex_tbl <- tt_to_flextable(tbl)

# Add section properties if necessary
section_properties <- officer::prop_section(
page_size = officer::page_size(
orient = "portrait",
width = 8.5, height = 11
),
type = "continuous",
page_margins = margins_potrait()
)

doc_file <- tempfile(fileext = ".docx")

export_as_docx(tbl, file = doc_file, template_file = doc_file,
section_properties = section_properties)

expect_true(file.exists(doc_file))
lyt <- make_big_lyt()
tbl <- build_table(lyt, rawdat)
top_left(tbl) <- "Ethnicity"
main_title(tbl) <- "Main title"
subtitles(tbl) <- c("Some Many", "Subtitles")
main_footer(tbl) <- c("Some Footer", "Mehr")
prov_footer(tbl) <- "Some prov Footer"
fnotes_at_path(tbl, rowpath = c("RACE", "BLACK")) <- "factor 2"
fnotes_at_path(tbl,
rowpath = c("RACE", "BLACK"),
colpath = c("ARM", "ARM1", "SEX", "F")
) <- "factor 3"

# Get the flextable
flex_tbl <- tt_to_flextable(tbl)

# Add section properties if necessary
section_properties <- officer::prop_section(
page_size = officer::page_size(
orient = "portrait",
width = 8.5, height = 11
),
type = "continuous",
page_margins = margins_potrait()
)
doc_file <- tempfile(fileext = ".docx")

expect_silent(export_as_docx(tbl,
file = doc_file, template_file = doc_file,
section_properties = section_properties
))

expect_true(file.exists(doc_file))
})

0 comments on commit e121e4a

Please sign in to comment.