diff --git a/tests/testthat/test-cell-content.R b/tests/testthat/test-cell-content.R index f2385bc8..2bd89664 100644 --- a/tests/testthat/test-cell-content.R +++ b/tests/testthat/test-cell-content.R @@ -7,6 +7,8 @@ library(rmarkdown) 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% "")) @@ -101,6 +103,10 @@ test_that("colformat_* functions", { 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, diff --git a/tests/testthat/test-merge.R b/tests/testthat/test-merge.R index 590b12d5..d34db67a 100644 --- a/tests/testthat/test-merge.R +++ b/tests/testthat/test-merge.R @@ -56,33 +56,3 @@ test_that("merged cells can be un-merged", { expect_true(all(ft$body$spans$columns == 1)) }) -test_that("separate_header", { - x <- data.frame( - Species = as.factor(c("setosa", "versicolor", "virginica")), - Sepal.Length_mean_zzz = c(5.006, 5.936, 6.588), - Sepal.Length_sd = c(0.35249, 0.51617, 0.63588), - Sepal.Width_mean = c(3.428, 2.77, 2.974), - Sepal.Width_sd_sfsf_dsfsdf = c(0.37906, 0.3138, 0.3225), - Petal.Length_mean = c(1.462, 4.26, 5.552), - Petal.Length_sd = c(0.17366, 0.46991, 0.55189), - Petal.Width_mean = c(0.246, 1.326, 2.026), - Petal.Width_sd = c(0.10539, 0.19775, 0.27465) - ) - - ft_1 <- flextable(x) - ft_1 <- separate_header(x = ft_1, - opts = c("span-top", "bottom-vspan") - ) - header_txt <- information_data_chunk(ft_1) |> - subset(.part %in% "header") - expect_equal( - object = header_txt$txt, - expected = - c("Species", "Sepal", "Sepal", "Sepal", "Sepal", "Petal", "Petal", - "Petal", "Petal", "", "Length", "Length", "Width", "Width", "Length", - "Length", "Width", "Width", "", "mean", "sd", "mean", "sd", "mean", - "sd", "mean", "sd", "", "zzz", "", "", "sfsf", "", "", "", "", - "", "", "", "", "dsfsdf", "", "", "", "") - ) - -}) diff --git a/tests/testthat/test-new-rows.R b/tests/testthat/test-new-rows.R new file mode 100644 index 00000000..472577c3 --- /dev/null +++ b/tests/testthat/test-new-rows.R @@ -0,0 +1,230 @@ +context("check dim and new rows") + +library(officer) + + +test_that("nrow_part or ncol_keys checks", { + expect_error(nrow_part(12)) + expect_error(ncol_keys(12)) + ft <- flextable(head(iris)) + expect_equal(nrow_part(ft, part = "footer"), 0) + expect_equal(nrow_part(ft, part = "body"), 6) + expect_equal(ncol_keys(ft), 5) +}) + +test_that("add lines", { + ft <- flextable(head(iris)) + + newvals <- c("A", "B", "C", "D") + + ft <- add_header_lines( + x = ft, + values = newvals, + top = TRUE) + expect_equal(nrow_part(ft, part = "header"), 5) + + ft <- add_footer_lines( + x = ft, + values = newvals, + top = FALSE) + expect_equal(nrow_part(ft, part = "footer"), 4) + + x <- information_data_chunk(ft) + + header_sel <- x[x$.part %in% "header",] + expect_equal( + header_sel$txt, + c( + rep(newvals, each = 5), + colnames(iris) + ) + ) + footer_sel <- x[x$.part %in% "footer",] + expect_equal( + footer_sel$txt, + rep(newvals, each = 5) + ) +}) + +test_that("separate_header", { + x <- data.frame( + Species = as.factor(c("setosa", "versicolor", "virginica")), + Sepal.Length_mean_zzz = c(5.006, 5.936, 6.588), + Sepal.Length_sd = c(0.35249, 0.51617, 0.63588), + Sepal.Width_mean = c(3.428, 2.77, 2.974), + Sepal.Width_sd_sfsf_dsfsdf = c(0.37906, 0.3138, 0.3225), + Petal.Length_mean = c(1.462, 4.26, 5.552), + Petal.Length_sd = c(0.17366, 0.46991, 0.55189), + Petal.Width_mean = c(0.246, 1.326, 2.026), + Petal.Width_sd = c(0.10539, 0.19775, 0.27465) + ) + + ft_1 <- flextable(x) + ft_1 <- separate_header(x = ft_1, + opts = c("span-top", "bottom-vspan") + ) + header_txt <- information_data_chunk(ft_1) |> + subset(.part %in% "header") + expect_equal( + object = header_txt$txt, + expected = + c("Species", "Sepal", "Sepal", "Sepal", "Sepal", "Petal", "Petal", + "Petal", "Petal", "", "Length", "Length", "Width", "Width", "Length", + "Length", "Width", "Width", "", "mean", "sd", "mean", "sd", "mean", + "sd", "mean", "sd", "", "zzz", "", "", "sfsf", "", "", "", "", + "", "", "", "", "dsfsdf", "", "", "", "") + ) + +}) + + +test_that("add part rows", { + + ft01 <- fp_text_default(color = "red") + ft02 <- fp_text_default(color = "orange") + + pars <- as_paragraph( + as_chunk(c("(1)", "(2)"), props = ft02), " ", + as_chunk(c( + "My tailor is rich", + "My baker is rich" + ), props = ft01) + ) + + ft_1 <- flextable(head(mtcars)) + ft_1 <- add_header_row(ft_1, + values = pars, + colwidths = c(5, 6), top = FALSE + ) + ft_1 <- add_body_row(ft_1, + values = pars, + colwidths = c(5, 6), top = TRUE + ) + ft_1 <- add_footer_row(ft_1, + values = pars, + colwidths = c(3, 8), top = FALSE + ) + + x <- information_data_chunk(ft_1) + + new_header_sel <- x[x$.part %in% "header" & + x$.row_id %in% 2 & + x$.col_id %in% "mpg",] + expect_equal(new_header_sel$txt, c("(1)", " ", "My tailor is rich")) + expect_equal(new_header_sel$color, c("orange", "black", "red")) + new_header_sel <- x[x$.part %in% "header" & + x$.row_id %in% 2 & + x$.col_id %in% "wt",] + expect_equal(new_header_sel$txt, c("(2)", " ", "My baker is rich")) + expect_equal(new_header_sel$color, c("orange", "black", "red")) + spans <- flextable:::fortify_span(ft_1, parts = "header") + expect_equal( + spans$rowspan, + c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 5, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0) + ) + expect_true(all(spans$colspan %in% 1)) + expect_equivalent( + colSums(is.na(ft_1$header$dataset)), + rep(0L, ncol(mtcars)) + ) + + new_body_sel <- x[x$.part %in% "body" & + x$.row_id %in% 1 & + x$.col_id %in% "mpg",] + expect_equal(new_body_sel$txt, c("(1)", " ", "My tailor is rich")) + expect_equal(new_body_sel$color, c("orange", "black", "red")) + new_body_sel <- x[x$.part %in% "body" & + x$.row_id %in% 1 & + x$.col_id %in% "wt",] + expect_equal(new_body_sel$txt, c("(2)", " ", "My baker is rich")) + expect_equal(new_body_sel$color, c("orange", "black", "red")) + spans <- flextable:::fortify_span(ft_1, parts = "body") + spans <- spans[spans$.row_id %in% 1,] + expect_equal( + spans$rowspan, + c(5, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0) + ) + expect_true(all(spans$colspan %in% 1)) + expect_equivalent( + colSums(is.na(ft_1$body$dataset)), + rep(1L, ncol(mtcars)) + ) + + new_footer_sel <- x[x$.part %in% "footer" & + x$.row_id %in% 1 & + x$.col_id %in% "mpg",] + expect_equal(new_footer_sel$txt, c("(1)", " ", "My tailor is rich")) + new_footer_sel <- x[x$.part %in% "footer" & + x$.row_id %in% 1 & + x$.col_id %in% "hp",] + expect_equal(new_header_sel$txt, c("(2)", " ", "My baker is rich")) + spans <- flextable:::fortify_span(ft_1, parts = "footer") + expect_equal( + spans$rowspan, + c(3, 0, 0, 8, 0, 0, 0, 0, 0, 0, 0) + ) + expect_true(all(spans$colspan %in% 1)) + expect_equivalent( + colSums(is.na(ft_1$footer$dataset)), + rep(0L, ncol(mtcars)) + ) + +}) + +test_that("add rows", { + ft <- flextable(head(iris), + col_keys = c( + "Species", "Sepal.Length", "Petal.Length", + "Sepal.Width", "Petal.Width" + ) + ) + + fun <- function(x) { + paste0( + c("min: ", "max: "), + formatC(range(x)) + ) + } + new_row <- list( + Sepal.Length = fun(iris$Sepal.Length), + Sepal.Width = fun(iris$Sepal.Width), + Petal.Width = fun(iris$Petal.Width), + Petal.Length = fun(iris$Petal.Length) + ) + + ft <- add_header(ft, values = new_row, top = FALSE) + + ft <- add_body( + x = ft, Sepal.Length = 1:5, + Sepal.Width = 1:5 * 2, Petal.Length = 1:5 * 3, + Petal.Width = 1:5 + 10, Species = "Blah", top = FALSE + ) + + x <- information_data_chunk(ft) + + new_row_sel <- x[x$.part %in% "body" & + x$.row_id %in% 7:11 & + x$.col_id %in% "Species",] + expect_equal(new_row_sel$txt, rep("Blah", 5)) + + new_row_sel <- x[x$.part %in% "body" & + x$.row_id %in% 7:11 & + x$.col_id %in% "Sepal.Length",] + expect_equal(new_row_sel$txt, as.character(1:5)) + + expect_true(is.factor(ft$body$dataset[7:11,]$Species)) + expect_equal(levels(ft$body$dataset[7:11,]$Species), c("setosa", "versicolor", "virginica", "Blah")) + expect_equal(as.character(ft$body$dataset[7:11,]$Species), rep("Blah", 5)) + expect_equal(ft$body$dataset[7:11,]$Sepal.Length, 1:5) + + new_header_sel <- x[x$.part %in% "header" & + x$.row_id %in% 2:3 & + x$.col_id %in% "Sepal.Width",] + expect_equal(new_header_sel$txt, c("min: 2", "max: 4.4")) + new_header_sel <- x[x$.part %in% "header" & + x$.row_id %in% 2:3 & + x$.col_id %in% "Species",] + expect_equal(new_header_sel$txt, c("", "")) + +})