1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
test_that("set_header_labels", {
col_keys <- c(
"Species",
"sep1", "Sepal.Length", "Sepal.Width",
"sep2", "Petal.Length", "Petal.Width"
)
ft <- flextable(head(iris), col_keys = col_keys)
ft <- set_header_labels(ft,
Sepal.Length = "Sepal length",
Sepal.Width = "Sepal width", Petal.Length = "Petal length",
Petal.Width = "Petal width"
)
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)
colnodes <- xml_find_all(doc, "w:body/w:tbl/w:tr[w:trPr/w:tblHeader]/w:tc")
expect_equal(
xml_text(colnodes),
c("Species", "", "Sepal length", "Sepal width", "", "Petal length", "Petal width")
)
unlink(main_folder, recursive = TRUE, force = TRUE)
ft <- flextable(mtcars)
ft <- set_header_labels(ft, values = letters[1:ncol(mtcars)])
ft <- delete_part(ft, part = "body")
expect_equal(
information_data_chunk(ft)$txt,
letters[1:ncol(mtcars)]
)
})
test_that("add_header", {
data_ref <- structure(
list(
Sepal.Length = c("Sepal", "s", "(cm)"),
Sepal.Width = c("Sepal", "", "(cm)"),
Petal.Length = c("Petal", "", "(cm)"),
Petal.Width = c("Petal", "", "(cm)"),
Species = c("Species", "", "(cm)")
),
.Names = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species"),
row.names = c(NA, -3L), class = "data.frame"
)
ft <- flextable(iris[1:6, ])
ft <- set_header_labels(
ft,
Sepal.Length = "Sepal",
Sepal.Width = "Sepal", Petal.Length = "Petal",
Petal.Width = "Petal", Species = "Species"
)
ft <- add_header(ft, Sepal.Length = "s", top = FALSE)
ft <- add_header(
ft,
Sepal.Length = "(cm)",
Sepal.Width = "(cm)", Petal.Length = "(cm)",
Petal.Width = "(cm)", Species = "(cm)", top = FALSE
)
has_ <- flextable:::fortify_content(
ft$header$content,
default_chunk_fmt = ft$header$styles$text
)$txt
expect_equal(has_, as.character(unlist(data_ref)))
ft <- flextable(iris[1:6, ])
ft <- set_header_labels(
ft,
Sepal.Length = "Sepal",
Sepal.Width = "Sepal", Petal.Length = "Petal",
Petal.Width = "Petal", Species = "Species"
)
ft <- add_header(ft, Sepal.Length = "s", top = FALSE)
ft <- add_header(
ft,
Sepal.Length = "(cm)",
Sepal.Width = "(cm)", Petal.Length = "(cm)",
Petal.Width = "(cm)", Species = "(cm)", top = FALSE
)
has_ <- flextable:::fortify_content(
ft$header$content,
default_chunk_fmt = ft$header$styles$text
)$txt
expect_equal(has_, as.character(unlist(data_ref)))
})
test_that("set_header_df", {
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
)
data <- iris[c(1:3, 51:53, 101:104), ]
ft <- flextable(
data,
col_keys = c(
"Species",
"sep_1", "Sepal.Length", "Sepal.Width",
"sep_2", "Petal.Length", "Petal.Width"
)
)
ft <- set_header_df(ft, mapping = typology, key = "col_keys")
data_ref <- structure(
list(
Species = c("Species", "Species"),
sep_1 = c("", ""),
Sepal.Length = c("Sepal", "Length"),
Sepal.Width = c("Sepal", "Width"),
sep_2 = c("", ""),
Petal.Length = c("Petal", "Length"),
Petal.Width = c("Petal", "Width")
),
.Names = c("Species", "sep_1", "Sepal.Length", "Sepal.Width", "sep_2", "Petal.Length", "Petal.Width"),
row.names = c(NA, -2L), class = "data.frame"
)
expect_ <- as.character(unlist(data_ref))
has_ <- flextable:::fortify_content(
ft$header$content,
default_chunk_fmt = ft$header$styles$text
)$txt
expect_equal(has_, expect_)
})
|
