flextable/ 0000755 0001762 0000144 00000000000 15143546032 012223 5 ustar ligges users flextable/tests/ 0000755 0001762 0000144 00000000000 15131745533 013371 5 ustar ligges users flextable/tests/testthat/ 0000755 0001762 0000144 00000000000 15143546032 015225 5 ustar ligges users flextable/tests/testthat/test-dimensions.R 0000644 0001762 0000144 00000007216 15131745533 020507 0 ustar ligges users test_that("dimensions are valid", {
dummy_df <- data.frame(my_col = rep(letters[1:3], each = 2), stringsAsFactors = FALSE)
ft <- flextable(dummy_df)
dims <- dim(ft)
expect_length(dims$widths, 1)
expect_length(dims$heights, 7)
ft <- add_header(ft, my_col = "second row header")
dims <- dim(ft)
expect_length(dims$widths, 1)
expect_length(dims$heights, 8)
ft <- height_all(ft, height = .15, part = "all")
dims <- dim(ft)
expect_true(all(is.finite(dims$widths)))
expect_true(all(is.finite(dims$heights)))
typology <- data.frame(
col_keys = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species"),
what = c("Sepal", "Sepal", "Petal", "Petal", "Species"),
measure = c("Length", "Width", "Length", "Width", "Species"),
stringsAsFactors = FALSE
)
ft <- flextable(head(iris))
ft <- set_header_df(ft, mapping = typology, key = "col_keys")
dims <- dim(ft)
expect_length(dims$widths, 5)
expect_length(dims$heights, 8)
})
test_that("autofit and dim_pretty usage", {
typology <- data.frame(
col_keys = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species"),
what = c("Sepal", "Sepal", "Petal", "Petal", "Species"),
measure = c("Length", "Width", "Length", "Width", "Species"),
stringsAsFactors = FALSE
)
ft <- flextable(head(iris))
ft <- set_header_df(ft, mapping = typology, key = "col_keys")
ft <- autofit(ft, add_w = 0.0, add_h = 0.0)
dims <- dim(ft)
expect_true(all(is.finite(dims$widths)))
expect_true(all(is.finite(dims$heights)))
dims <- dim_pretty(ft)
expect_true(all(is.finite(dims$widths)))
expect_true(all(is.finite(dims$heights)))
})
test_that("height usage", {
dummy_df <- data.frame(
my_col1 = rep(letters[1:3], each = 2),
my_col2 = rep(letters[4:6], each = 2),
stringsAsFactors = FALSE
)
ft <- flextable(dummy_df)
dims <- dim_pretty(ft)
expect_silent({
ft <- height_all(ft, height = .25, part = "all")
})
expect_error({
ft <- height(ft, height = dims$heights[-1], part = "all")
})
expect_error({
ft <- height(ft, height = 1:3, part = "body")
})
})
test_that("width usage", {
dummy_df <- data.frame(
my_col1 = rep(letters[1:3], each = 2),
my_col2 = rep(letters[4:6], each = 2),
stringsAsFactors = FALSE
)
ft <- flextable(dummy_df)
expect_silent(width(ft, j = "my_col1", width = 1))
expect_silent(width(ft, j = 1:2, width = .7))
expect_error(width(ft, j = 1:2, width = rep(.7, 3)))
})
test_that("autofit with horizontal spans", {
dat <-
data.frame(
`Header should span 2 cols` = c("Whoooo", "Whaaaat", "Whyyyyy"),
dummy_title = c("Whoooo", "Whaaaat", "Whyyyyy"),
check.names = FALSE
)
ft <- flextable(dat)
ft <- merge_at(
x = ft, i = 1, j = 1:2,
part = "header"
)
dims_divided <- dim_pretty(ft, hspans = "divided")
dims_included <- dim_pretty(ft, hspans = "included")
expect_gt(dims_included$widths[1], dims_divided$widths[1])
dims_none <- dim_pretty(ft, hspans = "none")
dims_included_no_header <- dim_pretty(ft, hspans = "included", part = "body")
expect_equal(dims_none$widths, dims_included_no_header$widths)
})
test_that("HTML table width when autofit layout", {
x <- data.frame(
x = c(
"[-0.36, -0.01]", "[0, 0]",
"000, 000", "0000 0000"
)
)
ft <- flextable(x)
ft <- set_table_properties(
x = ft, layout = "autofit"
)
str <- flextable:::gen_raw_html(ft)
expect_false(grepl("table-layout:auto;width:", str, fixed = TRUE))
ft <- set_table_properties(
x = ft, layout = "autofit", width = .1
)
str <- flextable:::gen_raw_html(x = ft)
expect_true(grepl("table-layout:auto;width:", str, fixed = TRUE))
})
flextable/tests/testthat/test-tab_settings.R 0000644 0001762 0000144 00000013412 15142466315 021020 0 ustar ligges users init_flextable_defaults()
ft <- flextable(head(iris, 2))
# --- set_table_properties validation ---
test_that("set_table_properties rejects invalid layout", {
expect_error(set_table_properties(ft, layout = "bogus"), "layout")
})
test_that("set_table_properties rejects invalid width", {
expect_error(set_table_properties(ft, width = "a"), "width")
expect_error(set_table_properties(ft, width = 1.5), "width")
})
test_that("set_table_properties validates word_title and word_description", {
expect_error(
set_table_properties(ft, word_title = 123),
"is.character"
)
expect_error(
set_table_properties(ft, word_title = "Title"),
"is.character"
)
expect_no_error(
set_table_properties(ft, word_title = "Title", word_description = "Desc")
)
})
# --- opts_ft_html validation ---
test_that("opts_ft_html rejects invalid extra_css", {
expect_error(
set_table_properties(ft, opts_html = list(extra_css = 123)),
"extra_css"
)
expect_error(
set_table_properties(ft, opts_html = list(extra_css = c("a", "b"))),
"extra_css"
)
})
test_that("opts_ft_html rejects invalid scroll", {
expect_error(
set_table_properties(ft, opts_html = list(scroll = "yes")),
"scroll"
)
expect_no_error(
set_table_properties(ft, opts_html = list(scroll = NULL))
)
expect_no_error(
set_table_properties(ft, opts_html = list(scroll = list(height = "300px")))
)
})
# --- opts_ft_word validation ---
test_that("opts_ft_word rejects invalid split", {
expect_error(
set_table_properties(ft, opts_word = list(split = "yes")),
"split"
)
expect_error(
set_table_properties(ft, opts_word = list(split = c(TRUE, FALSE))),
"split"
)
})
test_that("opts_ft_word rejects invalid keep_with_next", {
expect_error(
set_table_properties(ft, opts_word = list(keep_with_next = 1)),
"keep_with_next"
)
})
test_that("opts_ft_word rejects invalid repeat_headers", {
expect_error(
set_table_properties(ft, opts_word = list(repeat_headers = "yes")),
"repeat_headers"
)
})
test_that("opts_ft_word accepts valid values", {
ft2 <- set_table_properties(ft, opts_word = list(
split = TRUE, keep_with_next = FALSE, repeat_headers = TRUE
))
expect_true(ft2$properties$opts_word$split)
expect_false(ft2$properties$opts_word$keep_with_next)
expect_true(ft2$properties$opts_word$repeat_headers)
})
# --- opts_ft_pdf validation ---
test_that("opts_ft_pdf rejects invalid fonts_ignore", {
expect_error(
set_table_properties(ft, opts_pdf = list(fonts_ignore = "yes")),
"fonts_ignore"
)
expect_error(
set_table_properties(ft, opts_pdf = list(fonts_ignore = c(TRUE, FALSE))),
"fonts_ignore"
)
})
test_that("opts_ft_pdf rejects invalid tabcolsep", {
expect_error(
set_table_properties(ft, opts_pdf = list(tabcolsep = "big")),
"tabcolsep"
)
expect_error(
set_table_properties(ft, opts_pdf = list(tabcolsep = -1)),
"tabcolsep"
)
})
test_that("opts_ft_pdf rejects invalid arraystretch", {
expect_error(
set_table_properties(ft, opts_pdf = list(arraystretch = "big")),
"arraystretch"
)
expect_error(
set_table_properties(ft, opts_pdf = list(arraystretch = -0.5)),
"arraystretch"
)
})
test_that("opts_ft_pdf rejects invalid float", {
expect_error(
set_table_properties(ft, opts_pdf = list(float = "top")),
"float"
)
expect_error(
set_table_properties(ft, opts_pdf = list(float = 1)),
"float"
)
})
test_that("opts_ft_pdf rejects invalid caption_repeat", {
expect_error(
set_table_properties(ft, opts_pdf = list(caption_repeat = "yes")),
"logical"
)
})
test_that("opts_ft_pdf accepts all valid float values", {
for (fval in c("none", "float", "wrap-r", "wrap-l", "wrap-i", "wrap-o")) {
ft2 <- set_table_properties(ft, opts_pdf = list(float = fval))
expect_equal(ft2$properties$opts_pdf$float, fval)
}
})
test_that("opts_ft_pdf accepts valid combinations", {
ft2 <- set_table_properties(ft, opts_pdf = list(
tabcolsep = 4, arraystretch = 2, float = "float",
fonts_ignore = TRUE, caption_repeat = FALSE, footer_repeat = TRUE
))
expect_equal(ft2$properties$opts_pdf$tabcolsep, 4)
expect_equal(ft2$properties$opts_pdf$arraystretch, 2)
expect_equal(ft2$properties$opts_pdf$float, "float")
expect_true(ft2$properties$opts_pdf$fonts_ignore)
expect_false(ft2$properties$opts_pdf$caption_repeat)
expect_true(ft2$properties$opts_pdf$footer_repeat)
})
# --- tab_settings ---
test_that("tab_settings works", {
z <- data.frame(
Statistic = c("Median (Q1 ; Q3)", "Min ; Max"),
Value = c(
"\t999.99\t(99.9 ; 99.9)",
"\t9.99\t(9999.9 ; 99.9)"
)
)
ts <- fp_tabs(
fp_tab(pos = 0.4, style = "decimal"),
fp_tab(pos = 1.4, style = "decimal")
)
ft <- flextable(z)
ft <- tab_settings(ft, i = 1, j = 2, value = ts)
ft <- width(ft, width = c(1.5, 2))
docx_file <- tempfile(fileext = ".docx")
doc <- read_docx()
doc <- body_add_flextable(doc, value = ft)
doc <- print(doc, target = docx_file)
main_folder <- file.path(getwd(), "docx_folder")
unpack_folder(file = docx_file, folder = main_folder)
doc_file <- file.path(main_folder, "/word/document.xml")
doc <- read_xml(doc_file)
tabnode <- xml_find_first(doc, "w:body/w:tbl/w:tr[3]/w:tc[2]/w:p/w:pPr/w:tabs")
expect_true(inherits(tabnode, "xml_missing"))
tabnode <- xml_find_first(doc, "w:body/w:tbl/w:tr[2]/w:tc[2]/w:p/w:pPr/w:tabs")
expect_false(inherits(tabnode, "xml_missing"))
tab1 <- xml_child(tabnode, "w:tab[1]")
tab2 <- xml_child(tabnode, "w:tab[2]")
expect_equal(
xml_attr(tab1, "val"),
"decimal"
)
expect_equal(
xml_attr(tab1, "pos"),
"576"
)
expect_equal(
xml_attr(tab2, "val"),
"decimal"
)
expect_equal(
xml_attr(tab2, "pos"),
"2016"
)
unlink(main_folder, recursive = TRUE, force = TRUE)
})
flextable/tests/testthat/test-padding.R 0000644 0001762 0000144 00000001552 15131745533 017742 0 ustar ligges users test_that("padding overwrite all paddings", {
ft <- flextable(data.frame(a = c("", ""), stringsAsFactors = FALSE))
ft <- padding(ft, padding = 5)
new_paddings <- c(
ft$body$styles$pars$padding.bottom$data[, ],
ft$body$styles$pars$padding.top$data[, ],
ft$body$styles$pars$padding.left$data[, ],
ft$body$styles$pars$padding.right$data[, ]
)
new_paddings <- unique(new_paddings)
expect_equal(new_paddings, 5)
})
test_that("padding overwrite all paddings but not missing", {
ft <- flextable(iris)
ft <- padding(ft, padding = 5, padding.top = 20)
new_paddings <- c(
ft$body$styles$pars$padding.bottom$data[, ],
ft$body$styles$pars$padding.top$data[, ],
ft$body$styles$pars$padding.left$data[, ],
ft$body$styles$pars$padding.right$data[, ]
)
new_paddings <- unique(new_paddings)
expect_equal(new_paddings, c(5, 20))
})
flextable/tests/testthat/test-text.R 0000644 0001762 0000144 00000024402 15131745533 017317 0 ustar ligges users ft1 <- flextable(data.frame(a = "1 < 3", stringsAsFactors = FALSE))
get_xml_doc <- function(tab, main_folder = "docx_folder") {
docx_file <- tempfile(fileext = ".docx")
doc <- read_docx()
doc <- body_add_flextable(doc, value = tab)
print(doc, target = docx_file)
main_folder <- file.path(getwd(), main_folder)
unlink(main_folder, recursive = TRUE, force = TRUE)
unpack_folder(file = docx_file, folder = main_folder)
doc_file <- file.path(main_folder, "/word/document.xml")
read_xml(doc_file)
}
get_xml_ppt <- function(tab, main_folder = "pptx_folder") {
pptx_file <- tempfile(fileext = ".pptx")
doc <- read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc, tab, location = ph_location_type(type = "body"))
print(doc, target = pptx_file)
main_folder <- file.path(getwd(), main_folder)
unlink(main_folder, recursive = TRUE, force = TRUE)
unpack_folder(file = pptx_file, folder = main_folder)
doc_file <- file.path(main_folder, "/ppt/slides/slide1.xml")
read_xml(doc_file)
}
test_that("docx - string are html encoded", {
main_folder <- "docx_folder"
doc <- get_xml_doc(tab = ft1, main_folder = main_folder)
text_ <- xml_text(xml_find_first(doc, "w:body/w:tbl[1]/w:tr[2]/w:tc/w:p/w:r/w:t"))
expect_equal(text_, c("1 < 3"))
unlink(main_folder, recursive = TRUE, force = TRUE)
})
test_that("pptx - string are html encoded", {
main_folder <- "pptx_folder"
doc <- get_xml_ppt(tab = ft1, main_folder = main_folder)
text_ <- xml_text(xml_find_first(doc, "//a:tbl/a:tr[2]/a:tc/a:txBody/a:p/a:r/a:t"))
expect_equal(text_, c("1 < 3"))
unlink(main_folder, recursive = TRUE, force = TRUE)
})
test_that("html - string are html encoded", {
str_ <- flextable:::gen_raw_html(ft1)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("(.*)", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", "", str_)
str_ <- gsub("", str_, "")
doc <- read_xml(str_)
text_ <- xml_text(xml_find_all(doc, "//table/tbody/tr/td/p"))
expect_equal(text_, c("a", ""))
})
test_that("newlines and tabulations expand correctly", {
z <- flextable(data.frame(a = c("")))
z <- compose(
x = z, i = 1, j = 1,
value = as_paragraph(
"this\nis\nit",
"\n\t", "This", "\n",
"is", "\n", "it", "\n",
"this\tis\tit\nthatsit\n"
)
)
z <- delete_part(z, part = "header")
chunks_txt <- information_data_chunk(z)$txt
expect_equal(
chunks_txt,
c(
"this", "
", "is", "
", "it",
"
", "", "This", "
",
"is", "
", "it", "
", "this",
"", "is", "", "it", "
",
"thatsit", "
"
)
)
})
test_that("word superscript and subscript", {
ft <- flextable(data.frame(a = ""), col_keys = c("dummy"))
ft <- delete_part(ft, part = "header")
ft <- compose(ft,
i = 1, j = "dummy", part = "body",
value = as_paragraph(
as_sub("Sepal.Length")
)
)
runs <- information_data_chunk(ft)
expect_equal(runs$vertical.align[1], "subscript")
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml, "", fixed = TRUE)
ft <- compose(ft,
i = 1, j = "dummy", part = "body",
value = as_paragraph(
as_sup("Sepal.Length")
)
)
runs <- information_data_chunk(ft)
expect_equal(runs$vertical.align[1], "superscript")
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml, "", fixed = TRUE)
})
test_that("highlight", {
ft <- flextable(data.frame(test = "test"))
ft <- add_footer_lines(ft, values = "test")
ft <- mk_par(ft,
j = "test", part = "body",
value = as_paragraph(
as_highlight(test, color = "yellow")
)
)
ft <- mk_par(ft,
j = "test", part = "header",
value = as_paragraph(
as_highlight(test, color = "red")
)
)
ft <- mk_par(ft,
j = "test", part = "footer",
value = as_paragraph(
as_highlight(test, color = "purple")
)
)
runs <- information_data_chunk(ft)
expect_equal(runs$shading.color, c("red", "yellow", "purple"))
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml[1], "", fixed = TRUE)
expect_match(openxml[2], "", fixed = TRUE)
expect_match(openxml[3], "", fixed = TRUE)
openxml <- flextable:::runs_as_pml(ft)$par_nodes_str
expect_match(openxml[1], "", fixed = TRUE)
expect_match(openxml[2], "", fixed = TRUE)
expect_match(openxml[3], "", fixed = TRUE)
html_info <- flextable:::runs_as_html(ft)
css <- attr(html_info, "css")
expect_match(css, "background-color:rgba(255, 0, 0, 1.00);}", fixed = TRUE)
expect_match(css, "background-color:rgba(255, 255, 0, 1.00);}", fixed = TRUE)
expect_match(css, "background-color:rgba(160, 32, 240, 1.00);}", fixed = TRUE)
latex_str <- flextable:::runs_as_latex(ft)$txt
expect_match(latex_str[1], "\\colorbox[HTML]{FF0000}", fixed = TRUE)
expect_match(latex_str[2], "\\colorbox[HTML]{FFFF00}", fixed = TRUE)
expect_match(latex_str[3], "\\colorbox[HTML]{A020F0}", fixed = TRUE)
rtf_str <- flextable:::runs_as_rtf(ft)$txt
expect_match(rtf_str[1], "%ftshading:red%", fixed = TRUE)
expect_match(rtf_str[2], "%ftshading:yellow%", fixed = TRUE)
expect_match(rtf_str[3], "%ftshading:purple%", fixed = TRUE)
})
test_that("as_bracket", {
ft <- flextable(head(iris), col_keys = c("Species", "what"))
ft <- mk_par(ft,
j = "what", part = "body",
value = as_paragraph(
as_bracket(Sepal.Length, Sepal.Width, sep = "-")
)
)
runs <- information_data_chunk(ft)
runs <- runs[runs$.part %in% "body", ]
expect_equal(
runs$txt,
c(
"setosa", "(5.1-3.5)", "setosa", "(4.9-3)", "setosa",
"(4.7-3.2)", "setosa", "(4.6-3.1)", "setosa", "(5-3.6)",
"setosa", "(5.4-3.9)"
)
)
})
test_that("as_equation", {
skip_if_not_installed("equatags")
eqs <- c(
"(ax^2 + bx + c = 0)",
"a \\ne 0",
"x = {-b \\pm \\sqrt{b^2-4ac} \\over 2a}"
)
df <- data.frame(formula = eqs)
ft <- flextable(df)
ft <- mk_par(ft,
j = "formula", part = "body",
value = as_paragraph(as_equation(formula, width = 2, height = .5))
)
runs <- information_data_chunk(ft)
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml[2], "", fixed = TRUE)
expect_match(openxml[3], "", fixed = TRUE)
expect_match(openxml[4], "", fixed = TRUE)
openxml <- flextable:::runs_as_pml(ft)$par_nodes_str
expect_match(openxml[2], "", fixed = TRUE)
expect_match(openxml[3], "", fixed = TRUE)
expect_match(openxml[4], "", fixed = TRUE)
latex_str <- flextable:::runs_as_latex(ft)$txt
expect_match(latex_str[2], eqs[1], fixed = TRUE)
expect_match(latex_str[3], eqs[2], fixed = TRUE)
expect_match(latex_str[4], eqs[3], fixed = TRUE)
runs <- information_data_chunk(ft)
html_str <- flextable:::runs_as_html(ft)$span_tag
expect_match(html_str[2], "", fixed = TRUE)
expect_match(html_str[3], "", fixed = TRUE)
expect_match(html_str[4], "", fixed = TRUE)
})
test_that("as_word_field", {
ft <- flextable(head(cars))
ft <- add_footer_lines(ft, "temp text")
ft <- compose(
x = ft, part = "footer", i = 1, j = 1,
as_paragraph(
as_word_field(x = "Page", width = .05)
)
)
runs <- information_data_chunk(ft)
wml_str <- flextable:::runs_as_wml(ft)
wml_str <- wml_str[wml_str$.part %in% "footer",]$run_openxml[1]
expect_match(wml_str, "Page", fixed = TRUE)
})
test_that("strike", {
ft <- flextable(data.frame(test = "test"))
ft <- add_footer_lines(ft, values = "test")
ft <- mk_par(ft,
j = "test", part = "body",
value = as_paragraph(
as_strike(test)
)
)
ft <- mk_par(ft,
j = "test", part = "header",
value = as_paragraph(
as_strike(test)
)
)
ft <- mk_par(ft,
j = "test", part = "footer",
value = as_paragraph(
as_strike(test)
)
)
runs <- information_data_chunk(ft)
expect_equal(runs$strike, c(TRUE, TRUE, TRUE))
openxml <- flextable:::runs_as_wml(ft, txt_data = runs)$run_openxml
expect_match(openxml[1], "