-
Notifications
You must be signed in to change notification settings - Fork 3
/
a11ytable.R
333 lines (298 loc) · 10.7 KB
/
a11ytable.R
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
#' Create An 'a11ytable' Object
#'
#' Create a new a11ytable-class object, which is a special data.frame that
#' contains all the information needed in your output spreadsheet. In turn, the
#' object created by this function can be used to populate an 'openxlsx'
#' Workbook-class object with the function \code{\link{generate_workbook}}.
#'
#' @param tab_titles Required character vector, one value per sheet. Each title
#' will appear literally on each tab of the final spreadsheet output. Keep
#' brief. Letters and numbers only; do not start with a number; use
#' underscores for spaces. For example: 'Cover', 'Contents', 'Notes',
#' 'Table_1'. Will be corrected automatically unless there's an error.
#' @param sheet_types Required character vector, one value per sheet. Sheets
#' that don't contain publication tables ('meta' sheets) should be of type
#' 'contents', 'cover' or 'notes'. Sheets that contain statistical tables of
#' data are type 'tables'.
#' @param sheet_titles Required character vector, one value per sheet. The main
#' title for each sheet, which will appear in cell A1 (top-left corner).
#' @param blank_cells Optional character vector, one value per sheet. A short
#' sentence to explain the reason for any blank cells in the sheet. Supply
#' as \code{NA_character_} if empty. Most likely to be used with sheet type
#' 'tables'.
#' @param custom_rows Optional list of character vectors. One list element per
#' sheet, one character vector element per row of pre-table metadata. Supply
#' a list element as \code{NA_character_} if empty. To be used with sheet
#' type 'tables', but can also be used for sheet types 'contents' and
#' 'notes'.
#' @param sources Optional character vector, one value per sheet. The origin of
#' the data for a given sheet. Supply as \code{NA_character_} if empty. To
#' be used with sheet type 'tables'.
#' @param tables Required list of data.frames (though the cover sheet may be
#' supplied as a list), one per sheet. See details.
#'
#' @details
#'
#' ## How to supply data to the 'tables' argument
#'
#' Formats for the elements collected as a list and passed to the 'tables'
#' argument, depending on the sheet type.
#'
#' \itemize{
#' \item Sheet type 'cover': either (a) a list where each element name is a
#' section header and each element's content is a character vector
#' whose elements will make up separate rows of that section
#' (recommended), or (b) a data.frame with one row per subsection, with
#' one column for section titles and one column for corresponding for
#' that section's body text. For example, you may have a section with
#' the title 'Contact details' that contains an email address and
#' telephone number. You can use linebreaks (i.e. '\\n') to separate
#' text into paragraphs.
#' \item Sheet type 'contents': one row per sheet, two columns suggested at
#' least (named 'Tab title' and 'Worksheet title').
#' \item Sheet type 'notes': one row per note, two columns suggested (named
#' 'Note number', 'Note text'), where notes are in the form
#' '\[note 1\]'.
#' \item Sheet type 'tables': a tidy, rectangular data.frame containing the
#' data to be published. It's the user's responsibility to add notes in
#' the form '\[note 1\]' to column headers, or in a special 'Notes' row.
#' }
#'
#' ## How to supply hyperlinks
#'
#' You can provide text in Markdown link syntax (e.g.
#' '\[GOV.UK\](https://www.gov.uk)', adding 'mailto:' before an
#' email address) and the containing cell will be rendered as a hyperlink in the
#' output spreadsheet. Note that whole cells will become hyperlinks; there is no
#' support for selected words in a sentence to be rendered as a hyperlink.
#'
#' Hyperlinks can be supplied in the character strings to three arguments:
#'
#' \itemize{
#' \item To the 'tables' argument for sheet type 'cover' only. It's
#' recommended to supply the cover information as a list rather than a
#' data.frame, which will allow you to make specific rows within a
#' section (e.g. 'contact us') into hyperlinks.
#' \item To the 'custom_rows' argument for sheets of type 'contents, 'notes'
#' and 'tables'.
#' \item To the 'source' argument for sheets of type 'table' only.
#' }
#'
#' @return An object with classes 'a11ytable', 'tbl' and 'data.frame'.
#'
#' @examples
#' # Prepare some demo tables of information
#'
#' set.seed(1066)
#'
#' cover_list <- list(
#' "Section 1" = c("First row of Section 1.", "Second row of Section 1."),
#' "Section 2" = "The only row of Section 2.",
#' "Section 3" = c(
#' "[Website](https://co-analysis.github.io/a11ytables/)",
#' "[Email address](mailto:fake.address@a11ytables.com)"
#' )
#' )
#'
#' contents_df <- data.frame(
#' "Sheet name" = c("Notes", "Table_1", "Table_2"),
#' "Sheet title" = c(
#' "Notes used in this workbook",
#' "First Example Sheet",
#' "Second Example Sheet"
#' ),
#' check.names = FALSE
#' )
#'
#' notes_df <- data.frame(
#' "Note number" = paste0("[note ", 1:3, "]"),
#' "Note text" = c("First note.", "Second note.", "Third note."),
#' check.names = FALSE
#' )
#'
#' table_1_df <- data.frame(
#' Category = LETTERS[1:10],
#' "Numeric [note 1]" = 1:10,
#' "Numeric suppressed" = c(1:4, "[c]", 6:9, "[x]"),
#' "Numeric thousands" = abs(round(rnorm(10), 4) * 1e5),
#' "Numeric decimal" = abs(round(rnorm(10), 5)),
#' "This column has a very long name that means that the column width needs to be widened" = 1:10,
#' Notes = c("[note 1]", rep(NA_character_, 4), "[note 2]", rep(NA_character_, 4)),
#' check.names = FALSE
#' )
#'
#' table_2_df <- data.frame(Category = LETTERS[1:10], Numeric = 1:10)
#'
#' # Create 'a11ytables' object
#'
#' x <-
#' a11ytables::create_a11ytable(
#' tab_titles = c("Cover", "Contents", "Notes", "Table_1", "Table_2"),
#' sheet_types = c("cover", "contents", "notes", "tables", "tables"),
#' sheet_titles = c(
#' "The 'a11ytables' Demo Workbook",
#' "Table of contents",
#' "Notes",
#' "Table 1: First Example Sheet",
#' "Table 2: Second Example Sheet"
#' ),
#' blank_cells = c(
#' rep(NA_character_, 3),
#' "Blank cells indicate that there's no note in that row.",
#' NA_character_
#' ),
#' custom_rows = list(
#' NA_character_,
#' NA_character_,
#' "A custom row.",
#' c(
#' "First custom row [with a hyperlink.](https://co-analysis.github.io/a11ytables/)",
#' "Second custom row."
#' ),
#' "A custom row."
#' ),
#' sources = c(
#' rep(NA_character_, 3),
#' "[The Source Material, 2024.](https://co-analysis.github.io/a11ytables/)",
#' "The Source Material, 2024."
#' ),
#' tables = list(cover_list, contents_df, notes_df, table_1_df, table_2_df)
#' )
#'
#' # Test that 'a11ytable' is one of the object's classes
#' is_a11ytable(x)
#'
#' # Look at the structure of the object
#' str(x, max.level = 2)
#'
#' @export
create_a11ytable <- function(
tab_titles,
sheet_types = c("cover", "contents", "notes", "tables"),
sheet_titles,
blank_cells = NA_character_,
sources = NA_character_,
custom_rows = list(NA_character_),
tables
) {
x <- data.frame(
tab_title = unlist(tab_titles),
sheet_type = unlist(sheet_types),
sheet_title = unlist(sheet_titles),
blank_cells = unlist(blank_cells),
source = unlist(sources),
stringsAsFactors = FALSE # because default is TRUE prior to R v4
)
x[["custom_rows"]] <- custom_rows
x[["table"]] <- tables
as_a11ytable(x)
}
#' Coerce To An 'a11ytable' Object
#'
#' Functions to check if an object is an a11ytable, or coerce it if possible.
#'
#' @param x A data.frame object to coerce.
#'
#' @return \code{as_a11ytable} returns an object of class a11ytable if possible.
#' \code{is_a11ytable} returns \code{TRUE} if the object has class
#' a11ytable, otherwise \code{FALSE}.
#'
#' @examples
#' is_a11ytable(demo_a11ytable)
#'
#' @export
as_a11ytable <- function(x) {
if (any(names(x) %in% "tab_title")) {
.check_tab_titles(x[["tab_title"]])
x[["tab_title"]] <- .clean_tab_titles(x[["tab_title"]])
}
if (any(names(x) %in% "blank_cells")) {
x[["blank_cells"]] <- .append_period(x[["blank_cells"]])
}
# if (any(names(x) %in% "source")) {
# x[["source"]] <- .append_period(x[["source"]])
# }
class(x) <- c("a11ytable", "tbl", "data.frame")
.validate_a11ytable(x)
.warn_a11ytable(x)
x
}
#' @rdname as_a11ytable
#' @export
is_a11ytable <- function(x) {
inherits(x, "a11ytable")
}
#' Summarise An 'a11ytable' Object
#'
#' A concise result summary of an a11ytable-class object to see information
#' about the sheet content. Shows a numbered list of sheets with each tab title,
#' sheet type and table dimensions.
#'
#' @param object An a11ytable-class object for which to get a summary.
#' @param ... Other arguments to pass.
#'
#' @examples
#' # Print a concise summary of the a11ytable-class object
#' summary(demo_a11ytable)
#'
#' # Alternatively, look at the structure
#' str(demo_a11ytable, max.level = 2)
#'
#' @export
summary.a11ytable <- function(object, ...) {
tables <- object[["table"]]
table_dims <- vector("list", length = length(tables))
for (i in seq_along(tables)) {
if (inherits(tables[[i]], "list")) {
list_length <- length(tables[[i]])
list_lengths <- lengths(tables[[i]])
table_dims[[i]] <- paste0(
"list of length ", list_length,
" (element lengths ", .vector_to_sentence(list_lengths), ")"
)
}
if (is.data.frame(tables[[i]])) {
table_dims[[i]] <-
paste(paste(dim(tables[[i]]), collapse = " x "), "dataframe")
}
}
summary_string <- paste0(
"\n",
paste0(
paste0(" ", seq_along(tables), ") Tab '"),
object[["tab_title"]],
"' (sheet type '", object[["sheet_type"]], "') contains a ",
unlist(table_dims),
collapse = "\n"
)
)
cat("# An a11ytable with", nrow(object), "sheets:", summary_string)
invisible(object)
}
#' @importFrom pillar tbl_sum
NULL
#' Provide A Succinct Summary Of An 'a11ytable' Object
#'
#' A brief text description of an a11ytable-class object.
#'
#' @param x An a11ytable-class object to summarise.
#' @param ... Other arguments to pass.
#'
#' @return Named character vector.
#'
#' @examples
#' # Print with description
#' print(demo_a11ytable)
#'
#' # Print description only (package 'tibble' must be installed)
#' tibble::tbl_sum(demo_a11ytable)
#'
#' @export
tbl_sum.a11ytable <- function(x, ...) {
header <- sprintf(
"%s x %s",
formatC(nrow(x), big.mark = ","),
formatC(ncol(x), big.mark = ",")
)
c("a11ytable" = header)
}