test_that("surround sets border properties on target cell", { ft <- flextable(head(iris, 3)) ft <- border_remove(ft) brd <- officer::fp_border(color = "red", width = 2, style = "solid") ft <- surround(ft, i = 2, j = 2, border = brd, part = "body") props <- flextable:::information_data_cell(ft) cell <- props[props$.part == "body" & props$.row_id == 2 & props$.col_id == "Sepal.Width", ] expect_equal(cell$border.width.top, 2) expect_equal(cell$border.width.bottom, 2) expect_equal(cell$border.width.left, 2) expect_equal(cell$border.width.right, 2) expect_equal(cell$border.color.top, "red") expect_equal(cell$border.color.bottom, "red") expect_equal(cell$border.color.left, "red") expect_equal(cell$border.color.right, "red") # adjacent cells should not have red borders other <- props[props$.part == "body" & props$.row_id == 1 & props$.col_id == "Sepal.Length", ] expect_equal(other$border.width.top, 0) }) test_that("surround border shortcut sets all sides", { ft <- flextable(head(iris, 3)) ft <- border_remove(ft) brd <- officer::fp_border(color = "blue", width = 1) # use cell (2,2) to avoid header/body boundary edge case ft <- surround(ft, i = 2, j = 2, border = brd, part = "body") props <- flextable:::information_data_cell(ft) cell <- props[props$.part == "body" & props$.row_id == 2 & props$.col_id == "Sepal.Width", ] for (side in c("top", "bottom", "left", "right")) { expect_equal(cell[[paste0("border.color.", side)]], "blue") expect_equal(cell[[paste0("border.width.", side)]], 1) } }) test_that("surround selective sides", { ft <- flextable(head(iris, 3)) ft <- border_remove(ft) brd <- officer::fp_border(color = "green", width = 3) ft <- surround(ft, i = 2, j = 2, border.top = brd, border.bottom = brd, part = "body") props <- flextable:::information_data_cell(ft) cell <- props[props$.part == "body" & props$.row_id == 2 & props$.col_id == "Sepal.Width", ] expect_equal(cell$border.width.top, 3) expect_equal(cell$border.width.bottom, 3) expect_equal(cell$border.width.left, 0) expect_equal(cell$border.width.right, 0) }) test_that("surround renders in HTML", { ft <- flextable(head(iris, 2)) ft <- border_remove(ft) brd <- officer::fp_border(color = "red", width = 2, style = "solid") ft <- surround(ft, i = 1, j = 1, border = brd, part = "body") html <- flextable:::gen_raw_html(ft) expect_match(html, "border-top: 2pt solid rgba(255, 0, 0", fixed = TRUE) expect_match(html, "border-bottom: 2pt solid rgba(255, 0, 0", fixed = TRUE) expect_match(html, "border-left: 2pt solid rgba(255, 0, 0", fixed = TRUE) expect_match(html, "border-right: 2pt solid rgba(255, 0, 0", fixed = TRUE) }) test_that("surround renders in LaTeX", { ft <- flextable(head(iris, 2)) ft <- border_remove(ft) brd <- officer::fp_border(color = "red", width = 2, style = "solid") ft <- surround(ft, i = 1, j = 1, border = brd, part = "body") latex <- flextable:::gen_raw_latex(ft) # horizontal lines: ascline with red color (FF0000) expect_match(latex, "\\ascline{2pt}{FF0000}{1-1}", fixed = TRUE) # vertical lines: vrule with red color expect_match(latex, "\\color[HTML]{FF0000}\\vrule width 2pt", fixed = TRUE) }) test_that("void works as expected", { expect_error(void(12, part = "all")) ftab <- flextable(head(mtcars)) ftab <- void(ftab, part = "all") expect_true(all(information_data_chunk(ftab)$txt %in% "")) }) z <- structure( list( name = c("Matthieu Guillou-Poulain", "Noémi Pasquier d'Vaillant", "Honoré L'Delannoy", "Alice L'Bonneau", "Adrien Dupuy"), birthday = structure(c(25463, 7642, 13950, 23805, 21243), class = "Date"), n_children = c(4, 4, 4, 4, 2), weight = c(83.6459598876536, 61.8819103203714, NA, 52.6329895108938, 53.5817482229322), height = c(163.589849524116, 171.920463847195, 169.474969328653, 164.460310102575, 167.755981621553), n_peanuts = c(821107L, 774581L, 721301L, 1116933L, 1009038L), eye_color = structure(c(2L, 1L, 1L, 1L, 1L), .Label = c("dark", "green"), class = "factor") ), row.names = c(NA, -5L), class = "data.frame" ) z$timestamp <- as.POSIXct("2011-01-01 09:09:09") test_that("flextable_defaults values for cell content", { set_flextable_defaults( decimal.mark = ",", big.mark = " ", digits = 1, na_str = "NA", fmt_date = "%d %m %Y", fmt_datetime = "%d/%m/%Y %H:%M:%S" ) ft <- flextable(z) expected <- c( "name", "birthday", "n_children", "weight", "height", "n_peanuts", "eye_color", "timestamp", "Matthieu Guillou-Poulain", "19 09 2039", "4", "83,64596", "163,5898", "821 107", "green", "01/01/2011 09:09:09", "Noémi Pasquier d'Vaillant", "04 12 1990", "4", "61,88191", "171,9205", "774 581", "dark", "01/01/2011 09:09:09", "Honoré L'Delannoy", "12 03 2008", "4", "NA", "169,4750", "721 301", "dark", "01/01/2011 09:09:09", "Alice L'Bonneau", "06 03 2035", "4", "52,63299", "164,4603", "1 116 933", "dark", "01/01/2011 09:09:09", "Adrien Dupuy", "29 02 2028", "2", "53,58175", "167,7560", "1 009 038", "dark", "01/01/2011 09:09:09" ) expect_equal(object = information_data_chunk(ft)$txt, expected, ignore_attr = TRUE) init_flextable_defaults() }) test_that("colformat_* functions", { dat <- data.frame( letters1 = c("a", "b", "b", "c"), letters2 = c("d", "e", "b", "b"), number = 1:4 * pi, count = as.integer(1:4), is_something = c(TRUE, FALSE, TRUE, FALSE), dt = as.POSIXct("2011-01-01 09:09:09") - 1:4, date = as.Date("2011-02-23") + 1:4, stringsAsFactors = FALSE ) ft <- flextable(dat) ft <- colformat_char(x = ft, prefix = "-", suffix = "-") ft <- colformat_date(x = ft, fmt_date = "%d/%m/%Y", prefix = "-", suffix = "-") ft <- colformat_datetime(x = ft, fmt_date = "%d/%m/%Y %H%M%S", prefix = "-", suffix = "-") ft <- colformat_double( x = ft, big.mark = "", decimal.mark = ",", digits = 3, prefix = "-", suffix = "-" ) ft <- colformat_int(x = ft, prefix = "-", suffix = "-") ft <- colformat_lgl(x = ft, true = "OUI", false = "NON", prefix = "-", suffix = "-") expected <- c( "letters1", "letters2", "number", "count", "is_something", "dt", "date", "-a-", "-d-", "-3,142-", "-1-", "-OUI-", "-01/01/2011 090908-", "-24/02/2011-", "-b-", "-e-", "-6,283-", "-2-", "-NON-", "-01/01/2011 090907-", "-25/02/2011-", "-b-", "-b-", "-9,425-", "-3-", "-OUI-", "-01/01/2011 090906-", "-26/02/2011-", "-c-", "-b-", "-12,566-", "-4-", "-NON-", "-01/01/2011 090905-", "-27/02/2011-" ) expect_equal(object = information_data_chunk(ft)$txt, expected, ignore_attr = TRUE) ft <- colformat_num(x = ft, big.mark = "", decimal.mark = ".", prefix = "+", suffix = "+") expected <- c( "letters1", "letters2", "number", "count", "is_something", "dt", "date", "-a-", "-d-", "+3.141593+", "+1+", "-OUI-", "-01/01/2011 090908-", "-24/02/2011-", "-b-", "-e-", "+6.283185+", "+2+", "-NON-", "-01/01/2011 090907-", "-25/02/2011-", "-b-", "-b-", "+9.424778+", "+3+", "-OUI-", "-01/01/2011 090906-", "-26/02/2011-", "-c-", "-b-", "+12.566371+", "+4+", "-NON-", "-01/01/2011 090905-", "-27/02/2011-" ) expect_equal(object = information_data_chunk(ft)$txt, expected, ignore_attr = TRUE) }) test_that("append and prepend chunks structure", { expect_error(append_chunks(12)) expect_error(prepend_chunks(12)) ftab <- flextable(head(cars, n = 3)) ftab <- append_chunks(ftab, j = 1, as_chunk(" Samurai"), colorize(as_i(" Shodown"), color = "magenta") ) expect_equal(information_data_chunk(ftab)$txt, expected = c( "speed", "dist", "4", " Samurai", " Shodown", "2", "4", " Samurai", " Shodown", "10", "7", " Samurai", " Shodown", "4" ) ) ftab <- flextable(head(cars, n = 3)) ftab <- prepend_chunks(ftab, j = 1, as_chunk("Samurai"), colorize(as_i(" Shodown "), color = "magenta") ) expect_equal(information_data_chunk(ftab)$txt, expected = c( "speed", "dist", "Samurai", " Shodown ", "4", "2", "Samurai", " Shodown ", "4", "10", "Samurai", " Shodown ", "7", "4" ) ) }) test_that("delete rows and columns", { ftab <- flextable(head(iris)) ftab <- delete_columns(ftab, j = 1:3) ftab <- delete_rows(ftab, i = 1:5, part = "body") ftab <- autofit(ftab) expect_equal(information_data_chunk(ftab)$txt, expected = c("Petal.Width", "Species", "0.4", "setosa") ) expect_equal(ftab$col_keys, expected = c("Petal.Width", "Species") ) expect_equal(ftab$body$content$nrow, expected = 1L ) expect_equal(ftab$body$content$ncol, expected = 2L ) }) test_that("labelizor", { zzz <- CO2[,-c(1, 4)] zzz[1,1] <- NA zzz[47,1] <- NA z <- summarizor(x = zzz, by = "Treatment", overall_label = "Overall") ftab <- as_flextable(z, separate_with = "variable") ftab <- labelizor( x = ftab, j = c("stat", "nonchilled@blah"), labels = c(Missing = "Kouign amann", "20 (47.6%)" = "plop") ) chunk_txt <- information_data_chunk(ftab)$txt expect_equal(chunk_txt[32], expected = "Kouign amann") expect_equal(chunk_txt[18], expected = "plop") expect_equal(chunk_txt[26], expected = "plop") })