-
Notifications
You must be signed in to change notification settings - Fork 0
/
datahandling.R
148 lines (143 loc) · 4.63 KB
/
datahandling.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
# Functions for data handling
#' Variable List, Stata-style
#'
#' @import labelled broom cowplot tibble viridis stringr
#'
#' @description This function prints an inventory of a dataset, similar to Stata's
#' \code{varlist} function.
#'
#' @param data Input data frame (tibble)
#'
#' @return Tibble with the following columns:
#' * \code{name} Variable name
#' * \code{n} Number of non-missing observations
#' * \code{class} Variable class
#' * \code{label} Variable label
#' @export
#'
#' @examples
#' # Load mtcars dataset,
#' # label it, and create missing values
#' data(mtcars)
#' df <- mtcars %>%
#' labelled::set_variable_labels(mpg = "Miles per Gallon",
#' gear = "Number of Gears") %>%
#' dplyr::mutate(qsec = dplyr::if_else(am == 1,
#' true = NA_real_,
#' false = qsec))
#'
#' # Show varlist. Note missing values in "qsec".
#' varlist(df)
varlist <- function(data) {
labels <- purrr::map(data, ~base::attr(., "label"))
tibble::tibble(name = names(labels),
n = purrr::map_dbl(.x = data, .f = ~sum(!is.na(.))),
class = purrr::map_chr(.x = data, .f = class),
label = as.character(labels))
}
#' Safely Save CSV File Without Overwriting the File
#'
#' @import readr
#'
#' @description Wraps \code{\link[readr]{write_csv}}. If the file already exists,
#' it will not be overwritten. A message will be printed indicating whether the file
#' was successfully written or if it already existed.
#'
#' @param ... Data frame and other arguments,
#' passed on to \code{\link[readr]{write_csv}}. Required.
#' @param file Path/file name to for output. Required.
#'
#' @return None.
#' @export
#'
#' @examples
#' \dontrun{
#' data(mtcars)
#' mtcars %>%
#' dplyr::select(gear, mpg, am) %>%
#' write_csv_safely(file = "mtcars.csv")
#' }
write_csv_safely <- function(..., file = stop("'file' must be specified")) {
if(!file.exists(file)) {
readr::write_csv(..., file = file)
print(paste("File written:", file))
} else
print(paste("Output CSV file", file, "already exists. Not overwritten."))
}
#' Safely Save R Objects Without Overwriting the File
#'
#' @description Wraps \code{\link[base]{save}}. If the file already exists,
#' it will not be overwritten. A message will be printed indicating whether
#' the file was successfully written or if it already existed.
#'
#' @param ... Data frame(s), other object(s), and further arguments,
#' passed on to \code{\link[base]{save}}. Required.
#' @param file Path/file name to for output. Required.
#'
#' @return None.
#' @export
#'
#' @examples
#' \dontrun{
#' data(mtcars)
#' mtcars %>%
#' save_safely(file = "dataset.RData")
#' }
save_safely <- function(..., file = stop("'file' must be specified")) {
if(!file.exists(file)) {
save(..., file = file)
print(paste("File written:", file))
} else
print(paste("Output file", file, "already exists. Not overwritten."))
}
#' Safely Save Single Object Without Overwriting the RDS File
#'
#' @description Wraps \code{\link[base]{saveRDS}}. If the file already exists,
#' it will not be overwritten. A message will be printed indicating whether
#' the file was successfully written or if it already existed.
#'
#' @param ... Data frame or other object, and further arguments,
#' passed on to \code{\link[base]{saveRDS}}. Required.
#' @param file Path/file name to for output. Required.
#'
#' @return None.
#' @export
#'
#' @examples
#' \dontrun{
#' data(mtcars)
#' mtcars %>%
#' saveRDS_safely(file = "dataset.rds")
#' }
saveRDS_safely <- function(..., file = stop("'file' must be specified")) {
if(!file.exists(file)) {
saveRDS(..., file = file)
print(paste("File written:", file))
} else
print(paste("Output file", file, "already exists. Not overwritten."))
}
#' Safely Export as PDF Without Overwriting the File
#'
#' @description Wraps \code{\link[grDevices]{pdf}}. If the file already exists,
#' it will not be overwritten. A message will be printed indicating whether the file
#' was successfully written or if it already existed.
#'
#' @param file Path/file name to for PDF file. Required.
#' @param ... Optional. Passed on to \code{\link[grDevices]{pdf}}.
#'
#' @return None.
#' @export
#'
#' @examples
#' \dontrun{
#' pdf_safely(file = "graphs.pdf")
#' # ... code that generates plots ...
#' dev.off()
#' }
pdf_safely <- function(file = stop("'file' must be specified"), ...) {
if(!file.exists(file)) {
grDevices::pdf(file = file, ...)
print(paste("PDF opened for writing:", file))
} else
print(paste("Output PDF file", file, "already exists. Not overwritten."))
}