tests: new tests

- add rows
- few minor tests

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,

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", "", "", "", "")
-  )
-
-})

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("", ""))
+
+})