-
Notifications
You must be signed in to change notification settings - Fork 17
/
rmarkdown_helpers.R
114 lines (100 loc) · 3.27 KB
/
rmarkdown_helpers.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
#' Submit a data file and an rmarkdown template as a file to generate a codebook.
#' Used chiefly in the webapp.
#'
#' @param file path to a file to make codebook from (sav, rds, dta, por, xpt, csv, csv2, tsv, etc.)
#' @param text codebook template
#' @param remove_file whether to remove file after rendering
#' @param ... all other arguments passed to [rmarkdown::render()]
#' @md
#'
#' @export
load_data_and_render_codebook <- function(file, text,
remove_file = FALSE, ...) {
if (!requireNamespace("rio", quietly = TRUE)) {
stop("Package \"rio\" needed for this function to work. Please install it.",
call. = FALSE)
}
if (!requireNamespace("rmarkdown", quietly = TRUE)) {
stop("Package \"rio\" needed for this function to work. Please install it.",
call. = FALSE)
}
codebook_data <- switch(tools::file_ext(file),
"rdata" = rio::import_list(file)[[1]],
"rda" = rio::import_list(file)[[1]],
rio::import(file)
)
stopifnot(!is.null(codebook_data))
if (remove_file) {
file.remove(file)
}
fileName <- rmarkdown::render(input = write_to_file(text,
name = "codebook", ext = ".Rmd"), ...)
fileName
}
write_to_file <- function(..., name = NULL, ext = ".Rmd") {
if (is.null(name)) {
filename <- paste0(tempfile(), ext)
} else {
filename <- paste0(name, ext)
}
mytext <- eval(...)
write(mytext, filename)
return(filename)
}
require_file <- function(file, package = 'codebook') {
file <- gsub("^inst/", "", file)
system.file(file, package = package, mustWork = TRUE)
}
#' Create a codebook rmarkdown document
#'
#' This function will create and open an .Rmd file in the current working
#' directory. By default, the file is named codebook.Rmd. No files will be
#' overwritten. The .Rmd file has some useful defaults set for creating codebooks.
#'
#'
#' @param filename under which file name do you want to create a template
#' @param template only "default" exists for now
#'
#' @export
#' @examples
#' \dontrun{
#' new_codebook_rmd()
#' }
#'
new_codebook_rmd <- function(filename = "codebook", template = "default") {
if (!is.null(filename)) {
stopifnot(!file.exists(filename))
}
stopifnot(template == "default")
template <- readLines(require_file("_template_codebook.Rmd"))
rmd_file <- write_to_file(template, name = filename, ext = ".Rmd")
if (requireNamespace("rstudioapi", quietly = TRUE) &&
rstudioapi::isAvailable()) {
rstudioapi::navigateToFile(rmd_file)
} else if (interactive()) {
utils::file.edit(rmd_file)
}
}
recursive_escape <- function(x, depth = 0, max_depth = 4,
escape_fun = htmltools::htmlEscape) {
if (depth < max_depth) {
# escape names for all vectors
if (!is.null(names(x))) {
names(x) <- escape_fun(names(x))
}
if (!is.null(rownames(x))) {
rownames(x) <- escape_fun(rownames(x))
}
# escape any character vectors
if (is.character(x)) {
x <- escape_fun(x)
} else if (is.list(x) && class(x) == "list") {
# turtle down into lists
x <- lapply(x, function(x) { recursive_escape(x, depth + 1) })
}
}
x
}
safe_name <- function(x) {
stringr::str_replace_all(x, "[^[:alnum:]]", "_")
}