Skip to content

Commit 8e89e5f

Browse files
davidgoheldavidgohel
committed
tests: new tests
- add rows - few minor tests
1 parent 258183e commit 8e89e5f

File tree

3 files changed

+236
-30
lines changed

3 files changed

+236
-30
lines changed

‎tests/testthat/test-cell-content.R

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ library(rmarkdown)
77

88

99
test_that("void works as expected", {
10+
expect_error(void(12, part = "all"))
11+
1012
ftab <- flextable(head(mtcars))
1113
ftab <- void(ftab, part = "all")
1214
expect_true(all(information_data_chunk(ftab)$txt %in% ""))
@@ -101,6 +103,10 @@ test_that("colformat_* functions", {
101103

102104

103105
test_that("append and prepend chunks structure", {
106+
107+
expect_error(append_chunks(12))
108+
expect_error(prepend_chunks(12))
109+
104110
ftab <- flextable(head(cars, n = 3))
105111
ftab <- append_chunks(ftab,
106112
j = 1,

‎tests/testthat/test-merge.R

Lines changed: 0 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -56,33 +56,3 @@ test_that("merged cells can be un-merged", {
5656
expect_true(all(ft$body$spans$columns == 1))
5757
})
5858

59-
test_that("separate_header", {
60-
x <- data.frame(
61-
Species = as.factor(c("setosa", "versicolor", "virginica")),
62-
Sepal.Length_mean_zzz = c(5.006, 5.936, 6.588),
63-
Sepal.Length_sd = c(0.35249, 0.51617, 0.63588),
64-
Sepal.Width_mean = c(3.428, 2.77, 2.974),
65-
Sepal.Width_sd_sfsf_dsfsdf = c(0.37906, 0.3138, 0.3225),
66-
Petal.Length_mean = c(1.462, 4.26, 5.552),
67-
Petal.Length_sd = c(0.17366, 0.46991, 0.55189),
68-
Petal.Width_mean = c(0.246, 1.326, 2.026),
69-
Petal.Width_sd = c(0.10539, 0.19775, 0.27465)
70-
)
71-
72-
ft_1 <- flextable(x)
73-
ft_1 <- separate_header(x = ft_1,
74-
opts = c("span-top", "bottom-vspan")
75-
)
76-
header_txt <- information_data_chunk(ft_1) |>
77-
subset(.part %in% "header")
78-
expect_equal(
79-
object = header_txt$txt,
80-
expected =
81-
c("Species", "Sepal", "Sepal", "Sepal", "Sepal", "Petal", "Petal",
82-
"Petal", "Petal", "", "Length", "Length", "Width", "Width", "Length",
83-
"Length", "Width", "Width", "", "mean", "sd", "mean", "sd", "mean",
84-
"sd", "mean", "sd", "", "zzz", "", "", "sfsf", "", "", "", "",
85-
"", "", "", "", "dsfsdf", "", "", "", "")
86-
)
87-
88-
})

‎tests/testthat/test-new-rows.R

Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
context("check dim and new rows")
2+
3+
library(officer)
4+
5+
6+
test_that("nrow_part or ncol_keys checks", {
7+
expect_error(nrow_part(12))
8+
expect_error(ncol_keys(12))
9+
ft <- flextable(head(iris))
10+
expect_equal(nrow_part(ft, part = "footer"), 0)
11+
expect_equal(nrow_part(ft, part = "body"), 6)
12+
expect_equal(ncol_keys(ft), 5)
13+
})
14+
15+
test_that("add lines", {
16+
ft <- flextable(head(iris))
17+
18+
newvals <- c("A", "B", "C", "D")
19+
20+
ft <- add_header_lines(
21+
x = ft,
22+
values = newvals,
23+
top = TRUE)
24+
expect_equal(nrow_part(ft, part = "header"), 5)
25+
26+
ft <- add_footer_lines(
27+
x = ft,
28+
values = newvals,
29+
top = FALSE)
30+
expect_equal(nrow_part(ft, part = "footer"), 4)
31+
32+
x <- information_data_chunk(ft)
33+
34+
header_sel <- x[x$.part %in% "header",]
35+
expect_equal(
36+
header_sel$txt,
37+
c(
38+
rep(newvals, each = 5),
39+
colnames(iris)
40+
)
41+
)
42+
footer_sel <- x[x$.part %in% "footer",]
43+
expect_equal(
44+
footer_sel$txt,
45+
rep(newvals, each = 5)
46+
)
47+
})
48+
49+
test_that("separate_header", {
50+
x <- data.frame(
51+
Species = as.factor(c("setosa", "versicolor", "virginica")),
52+
Sepal.Length_mean_zzz = c(5.006, 5.936, 6.588),
53+
Sepal.Length_sd = c(0.35249, 0.51617, 0.63588),
54+
Sepal.Width_mean = c(3.428, 2.77, 2.974),
55+
Sepal.Width_sd_sfsf_dsfsdf = c(0.37906, 0.3138, 0.3225),
56+
Petal.Length_mean = c(1.462, 4.26, 5.552),
57+
Petal.Length_sd = c(0.17366, 0.46991, 0.55189),
58+
Petal.Width_mean = c(0.246, 1.326, 2.026),
59+
Petal.Width_sd = c(0.10539, 0.19775, 0.27465)
60+
)
61+
62+
ft_1 <- flextable(x)
63+
ft_1 <- separate_header(x = ft_1,
64+
opts = c("span-top", "bottom-vspan")
65+
)
66+
header_txt <- information_data_chunk(ft_1) |>
67+
subset(.part %in% "header")
68+
expect_equal(
69+
object = header_txt$txt,
70+
expected =
71+
c("Species", "Sepal", "Sepal", "Sepal", "Sepal", "Petal", "Petal",
72+
"Petal", "Petal", "", "Length", "Length", "Width", "Width", "Length",
73+
"Length", "Width", "Width", "", "mean", "sd", "mean", "sd", "mean",
74+
"sd", "mean", "sd", "", "zzz", "", "", "sfsf", "", "", "", "",
75+
"", "", "", "", "dsfsdf", "", "", "", "")
76+
)
77+
78+
})
79+
80+
81+
test_that("add part rows", {
82+
83+
ft01 <- fp_text_default(color = "red")
84+
ft02 <- fp_text_default(color = "orange")
85+
86+
pars <- as_paragraph(
87+
as_chunk(c("(1)", "(2)"), props = ft02), " ",
88+
as_chunk(c(
89+
"My tailor is rich",
90+
"My baker is rich"
91+
), props = ft01)
92+
)
93+
94+
ft_1 <- flextable(head(mtcars))
95+
ft_1 <- add_header_row(ft_1,
96+
values = pars,
97+
colwidths = c(5, 6), top = FALSE
98+
)
99+
ft_1 <- add_body_row(ft_1,
100+
values = pars,
101+
colwidths = c(5, 6), top = TRUE
102+
)
103+
ft_1 <- add_footer_row(ft_1,
104+
values = pars,
105+
colwidths = c(3, 8), top = FALSE
106+
)
107+
108+
x <- information_data_chunk(ft_1)
109+
110+
new_header_sel <- x[x$.part %in% "header" &
111+
x$.row_id %in% 2 &
112+
x$.col_id %in% "mpg",]
113+
expect_equal(new_header_sel$txt, c("(1)", " ", "My tailor is rich"))
114+
expect_equal(new_header_sel$color, c("orange", "black", "red"))
115+
new_header_sel <- x[x$.part %in% "header" &
116+
x$.row_id %in% 2 &
117+
x$.col_id %in% "wt",]
118+
expect_equal(new_header_sel$txt, c("(2)", " ", "My baker is rich"))
119+
expect_equal(new_header_sel$color, c("orange", "black", "red"))
120+
spans <- flextable:::fortify_span(ft_1, parts = "header")
121+
expect_equal(
122+
spans$rowspan,
123+
c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
124+
5, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0)
125+
)
126+
expect_true(all(spans$colspan %in% 1))
127+
expect_equivalent(
128+
colSums(is.na(ft_1$header$dataset)),
129+
rep(0L, ncol(mtcars))
130+
)
131+
132+
new_body_sel <- x[x$.part %in% "body" &
133+
x$.row_id %in% 1 &
134+
x$.col_id %in% "mpg",]
135+
expect_equal(new_body_sel$txt, c("(1)", " ", "My tailor is rich"))
136+
expect_equal(new_body_sel$color, c("orange", "black", "red"))
137+
new_body_sel <- x[x$.part %in% "body" &
138+
x$.row_id %in% 1 &
139+
x$.col_id %in% "wt",]
140+
expect_equal(new_body_sel$txt, c("(2)", " ", "My baker is rich"))
141+
expect_equal(new_body_sel$color, c("orange", "black", "red"))
142+
spans <- flextable:::fortify_span(ft_1, parts = "body")
143+
spans <- spans[spans$.row_id %in% 1,]
144+
expect_equal(
145+
spans$rowspan,
146+
c(5, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0)
147+
)
148+
expect_true(all(spans$colspan %in% 1))
149+
expect_equivalent(
150+
colSums(is.na(ft_1$body$dataset)),
151+
rep(1L, ncol(mtcars))
152+
)
153+
154+
new_footer_sel <- x[x$.part %in% "footer" &
155+
x$.row_id %in% 1 &
156+
x$.col_id %in% "mpg",]
157+
expect_equal(new_footer_sel$txt, c("(1)", " ", "My tailor is rich"))
158+
new_footer_sel <- x[x$.part %in% "footer" &
159+
x$.row_id %in% 1 &
160+
x$.col_id %in% "hp",]
161+
expect_equal(new_header_sel$txt, c("(2)", " ", "My baker is rich"))
162+
spans <- flextable:::fortify_span(ft_1, parts = "footer")
163+
expect_equal(
164+
spans$rowspan,
165+
c(3, 0, 0, 8, 0, 0, 0, 0, 0, 0, 0)
166+
)
167+
expect_true(all(spans$colspan %in% 1))
168+
expect_equivalent(
169+
colSums(is.na(ft_1$footer$dataset)),
170+
rep(0L, ncol(mtcars))
171+
)
172+
173+
})
174+
175+
test_that("add rows", {
176+
ft <- flextable(head(iris),
177+
col_keys = c(
178+
"Species", "Sepal.Length", "Petal.Length",
179+
"Sepal.Width", "Petal.Width"
180+
)
181+
)
182+
183+
fun <- function(x) {
184+
paste0(
185+
c("min: ", "max: "),
186+
formatC(range(x))
187+
)
188+
}
189+
new_row <- list(
190+
Sepal.Length = fun(iris$Sepal.Length),
191+
Sepal.Width = fun(iris$Sepal.Width),
192+
Petal.Width = fun(iris$Petal.Width),
193+
Petal.Length = fun(iris$Petal.Length)
194+
)
195+
196+
ft <- add_header(ft, values = new_row, top = FALSE)
197+
198+
ft <- add_body(
199+
x = ft, Sepal.Length = 1:5,
200+
Sepal.Width = 1:5 * 2, Petal.Length = 1:5 * 3,
201+
Petal.Width = 1:5 + 10, Species = "Blah", top = FALSE
202+
)
203+
204+
x <- information_data_chunk(ft)
205+
206+
new_row_sel <- x[x$.part %in% "body" &
207+
x$.row_id %in% 7:11 &
208+
x$.col_id %in% "Species",]
209+
expect_equal(new_row_sel$txt, rep("Blah", 5))
210+
211+
new_row_sel <- x[x$.part %in% "body" &
212+
x$.row_id %in% 7:11 &
213+
x$.col_id %in% "Sepal.Length",]
214+
expect_equal(new_row_sel$txt, as.character(1:5))
215+
216+
expect_true(is.factor(ft$body$dataset[7:11,]$Species))
217+
expect_equal(levels(ft$body$dataset[7:11,]$Species), c("setosa", "versicolor", "virginica", "Blah"))
218+
expect_equal(as.character(ft$body$dataset[7:11,]$Species), rep("Blah", 5))
219+
expect_equal(ft$body$dataset[7:11,]$Sepal.Length, 1:5)
220+
221+
new_header_sel <- x[x$.part %in% "header" &
222+
x$.row_id %in% 2:3 &
223+
x$.col_id %in% "Sepal.Width",]
224+
expect_equal(new_header_sel$txt, c("min: 2", "max: 4.4"))
225+
new_header_sel <- x[x$.part %in% "header" &
226+
x$.row_id %in% 2:3 &
227+
x$.col_id %in% "Species",]
228+
expect_equal(new_header_sel$txt, c("", ""))
229+
230+
})

0 commit comments

Comments
 (0)