blob: e1c65d368d156a34e6bb249ccb2ac5254b9016ce [file] [log] [blame]
Hao Zhu5fe235c2020-08-26 00:26:49 -04001#' Helper functions to generate inline sparklines
2#'
3#' @description These functions helps you quickly generate sets of sparkline
Bill Evans5a383e52020-08-30 20:09:52 -07004#' style plots using base R plotting system. Currently, we support histogram,
Bill Evanscebc9712020-08-30 19:55:24 -07005#' boxplot, and line. You can use them together with `column_spec` to
Hao Zhu5fe235c2020-08-26 00:26:49 -04006#' generate inline plot in tables. By default, this function will save images
7#' in a folder called "kableExtra" and return the address of the file.
8#'
9#' @param x Vector of values or List of vectors of values.
10#' @param width The width of the plot in pixel
11#' @param height The height of the plot in pixel
12#' @param res The resolution of the plot. Default is 300.
13#' @param same_lim T/F. If x is a list of vectors, should all the plots be
14#' plotted in the same range? Default is True.
Hao Zhudefd1892020-09-09 00:08:09 -040015#' @param lim Manually specify plotting range in the form of
16#' `c(0, 10)`.
Hao Zhu5fe235c2020-08-26 00:26:49 -040017#' @param xaxt On/Off for xaxis text
18#' @param yaxt On/Off for yaxis text
19#' @param ann On/Off for annotations (titles and axis titles)
20#' @param col Color for the fill of the histogram bar/boxplot box.
21#' @param border Color for the border.
22#' @param dir Directory of where the images will be saved.
23#' @param file File name. If not provided, a random name will be used
24#' @param file_type Graphic device. Support `png` or `svg`. SVG is recommended
25#' for HTML output
Hao Zhudefd1892020-09-09 00:08:09 -040026#' @param ... extra parameters sending to `hist()`
Hao Zhu5fe235c2020-08-26 00:26:49 -040027#'
Hao Zhu5fe235c2020-08-26 00:26:49 -040028#' @export
29spec_hist <- function(x, width = 200, height = 50, res = 300,
30 breaks = "Sturges",
31 same_lim = TRUE, lim = NULL,
32 xaxt = 'n', yaxt = 'n', ann = FALSE,
33 col = "lightgray", border = NULL,
34 dir = if (is_latex()) rmd_files_dir() else tempdir(),
35 file = NULL,
36 file_type = if (is_latex()) "png" else "svg", ...) {
37 if (is.list(x)) {
38 if (same_lim & is.null(lim)) {
39 lim <- base::range(unlist(x))
40 }
41 return(lapply(x, function(x_) {spec_hist(
42 x = x_, width = width, height = height,
43 breaks = breaks, same_lim = same_lim, lim = lim,
44 xaxt = xaxt, yaxt = yaxt, ann = ann, col = col, border = border,
45 dir = dir, file = file, file_type = file_type, ...
46 )}))
47 }
48
49 if (is.null(lim)) {
50 lim <- base::range(x)
51 }
52
53 file_type <- match.arg(file_type, c("svg", "png"))
54
55 if (!dir.exists(dir)) {
56 dir.create(dir)
57 }
58
59 if (is.null(file)) {
Hao Zhucd9a5812020-08-26 15:35:30 -040060 file <- file.path(dir, paste0(
61 "hist_", round(as.numeric(Sys.time()) * 1000), ".", file_type))
Hao Zhu5fe235c2020-08-26 00:26:49 -040062 }
63
64 if (file_type == "svg") {
65 grDevices::svg(filename = file, width = width / res, height = height / res,
66 bg = 'transparent')
67 } else {
68 grDevices::png(filename = file, width = width, height = height, res = res,
69 bg = 'transparent')
70 }
71
72 graphics::par(mar = c(0, 0, 0.2, 0), lwd=0.5)
73 graphics::hist(x, breaks = breaks, xlim = lim, border = border,
74 xaxt = xaxt, yaxt = yaxt, ann = ann, col = col, ...)
75 grDevices::dev.off()
76
77 if (file_type == "svg") {
78 svg_xml <- xml2::read_xml(file)
79 svg_text <- as.character(svg_xml)
80 unlink(file)
81 } else {
82 svg_text <- NULL
83 }
84 out <- list(path = file, dev = file_type, type = "hist",
85 width = width, height = height, res = res,
86 svg_text = svg_text)
87
88 class(out) <- "kableExtraInlinePlots"
89 return(out)
90}
91
Hao Zhudefd1892020-09-09 00:08:09 -040092#' Helper functions to generate inline sparklines
93#'
94#' @description These functions helps you quickly generate sets of sparkline
95#' style plots using base R plotting system. Currently, we support histogram,
96#' boxplot, and line. You can use them together with `column_spec` to
97#' generate inline plot in tables. By default, this function will save images
98#' in a folder called "kableExtra" and return the address of the file.
99#'
100#' @param x Vector of values or List of vectors of values.
101#' @param width The width of the plot in pixel
102#' @param height The height of the plot in pixel
103#' @param res The resolution of the plot. Default is 300.
104#' @param add_label For boxplot. T/F to add labels for min, mean and max.
105#' @param label_digits If T for add_label, rounding digits for the label.
106#' Default is 2.
107#' @param same_lim T/F. If x is a list of vectors, should all the plots be
108#' plotted in the same range? Default is True.
109#' @param lim,xlim,ylim Manually specify plotting range in the form of
110#' `c(0, 10)`. `lim` is used in `spec_hist` and `spec_boxplot`; `xlim`
111#' and `ylim` are used in `spec_line`.
112#' @param xaxt On/Off for xaxis text
113#' @param yaxt On/Off for yaxis text
114#' @param ann On/Off for annotations (titles and axis titles)
115#' @param col Color for the fill of the histogram bar/boxplot box.
116#' @param border Color for the border.
117#' @param boxlty Boxplot - box boarder type
118#' @param medcol Boxplot - median line color
119#' @param medlwd Boxplot - median line width
120#' @param dir Directory of where the images will be saved.
121#' @param file File name. If not provided, a random name will be used
122#' @param file_type Graphic device. Support `png` or `svg`. SVG is recommended
123#' for HTML output
124#' @param ... extraparameters passing to boxplot
125#'
Hao Zhu5fe235c2020-08-26 00:26:49 -0400126#' @export
127spec_boxplot <- function(x, width = 200, height = 50, res = 300,
128 add_label = FALSE, label_digits = 2,
129 same_lim = TRUE, lim = NULL,
130 xaxt = 'n', yaxt = 'n', ann = FALSE,
131 col = "lightgray", border = NULL,
132 boxlty = 0, medcol = "red", medlwd = 1,
133 dir = if (is_latex()) rmd_files_dir() else tempdir(),
134 file = NULL,
135 file_type = if (is_latex()) "png" else "svg", ...) {
136 if (is.list(x)) {
137 if (same_lim & is.null(lim)) {
138 lim <- base::range(unlist(x))
139 }
140 return(lapply(x, function(x_) {spec_boxplot(
141 x = x_, width = width, height = height,
142 add_label = add_label, same_lim = same_lim, lim = lim,
143 xaxt = xaxt, yaxt = yaxt, ann = ann,
144 col = col, border = border,
145 boxlty = boxlty, medcol = medcol, medlwd = medlwd,
146 dir = dir, file = file, file_type = file_type, ...
147 )}))
148 }
149
150 if (is.null(lim)) {
151 lim <- base::range(x)
152 lim[1] <- lim[1] - (lim[2] - lim[1]) / 10
153 lim[2] <- (lim[2] - lim[1]) / 10 + lim[2]
154 }
155
156 file_type <- match.arg(file_type, c("svg", "png"))
157
158 if (!dir.exists(dir)) {
159 dir.create(dir)
160 }
161
162 if (is.null(file)) {
Hao Zhucd9a5812020-08-26 15:35:30 -0400163 file <- file.path(dir, paste0(
164 "hist_", round(as.numeric(Sys.time()) * 1000), ".", file_type))
Hao Zhu5fe235c2020-08-26 00:26:49 -0400165 }
166
167 if (file_type == "svg") {
168 grDevices::svg(filename = file, width = width / res, height = height / res,
169 bg = 'transparent')
170 } else {
171 grDevices::png(filename = file, width = width, height = height, res = res,
172 bg = 'transparent')
173 }
174
175 graphics::par(mar = c(0, 0, 0, 0))
176
177 graphics::boxplot(x, horizontal = TRUE, ann = ann, frame = FALSE, bty = 'n', ylim = lim,
178 col = col, border = border,
179 boxlty = boxlty, medcol = medcol, medlwd = medlwd,
180 axes = FALSE, outcex = 0.2, whisklty = 1,
181 ...)
182 if (add_label) {
183 x_median <- round(median(x, na.rm = T), label_digits)
184 x_min <- round(min(x, na.rm = T), label_digits)
185 x_max <- round(max(x, na.rm = T), label_digits)
186 graphics::text(x_median, y = 1.4, labels = x_median, cex = 0.5)
187 graphics::text(x_min, y = 0.6, labels = x_min, cex = 0.5)
188 graphics::text(x_max, y = 0.6, labels = x_max, cex = 0.5)
189 }
190 grDevices::dev.off()
191
192 if (file_type == "svg") {
193 svg_xml <- xml2::read_xml(file)
194 svg_text <- as.character(svg_xml)
195 unlink(file)
196 } else {
197 svg_text <- NULL
198 }
199 out <- list(path = file, dev = file_type, type = "boxplot",
200 width = width, height = height, res = res,
201 svg_text = svg_text)
202 class(out) <- "kableExtraInlinePlots"
203 return(out)
204}
205
206is_latex <- knitr::is_latex_output
207
208rmd_files_dir <- function(create = TRUE) {
209 curr_file_name <- sub("\\.[^\\.]*$", "", knitr::current_input())
210 dir_name <- paste0(curr_file_name, "_files")
211 if (!dir.exists(dir_name) & create) dir.create(dir_name)
Hao Zhu7f3fa852020-08-26 13:55:38 -0400212 fig_dir_name <- file.path(dir_name, "figure-latex/")
Hao Zhu5fe235c2020-08-26 00:26:49 -0400213 if (!dir.exists(fig_dir_name) & create) dir.create(fig_dir_name)
214 return(fig_dir_name)
215}
216
Hao Zhudefd1892020-09-09 00:08:09 -0400217#' Helper functions to generate inline sparklines
218#'
219#' @description These functions helps you quickly generate sets of sparkline
220#' style plots using base R plotting system. Currently, we support histogram,
221#' boxplot, and line. You can use them together with `column_spec` to
222#' generate inline plot in tables. By default, this function will save images
223#' in a folder called "kableExtra" and return the address of the file.
224#'
225#' @param x,y Vector of values or List of vectors of values. y is optional.
226#' @param width The width of the plot in pixel
227#' @param height The height of the plot in pixel
228#' @param res The resolution of the plot. Default is 300.
229#' @param same_lim T/F. If x is a list of vectors, should all the plots be
230#' plotted in the same range? Default is True.
231#' @param xlim,ylim Manually specify plotting range in the form of
232#' `c(0, 10)`.
233#' @param xaxt On/Off for xaxis text
234#' @param yaxt On/Off for yaxis text
235#' @param ann On/Off for annotations (titles and axis titles)
236#' @param col Color for the fill of the histogram bar/boxplot box.
237#' @param border Color for the border.
238#' @param frame.plot On/Off for surrounding box (`spec_line` only). Default
239#' is False.
240#' @param lwd Line width for `spec_line`; within `spec_line`, the `minmax`
241#' argument defaults to use this value for `cex` for points. Default is 2.
242#' @param minmax,min,max Arguments passed to `points` to highlight minimum
243#' and maximum values in `spec_line`. If `min` or `max` are `NULL`, they
244#' default to the value of `minmax`. Set to an empty `list()` to disable.
245#' @param dir Directory of where the images will be saved.
246#' @param file File name. If not provided, a random name will be used
247#' @param file_type Graphic device. Support `png` or `svg`. SVG is recommended
248#' for HTML output.
249#' @param ... extra parameters passing to `plot`
250#'
Bill Evanscebc9712020-08-30 19:55:24 -0700251#' @export
252spec_line <- function(x, y = NULL, width = 200, height = 50, res = 300,
253 same_lim = TRUE, xlim = NULL, ylim = NULL,
254 xaxt = 'n', yaxt = 'n', ann = FALSE,
255 col = "lightgray", border = NULL,
256 frame.plot = FALSE, lwd = 2,
257 minmax = list(pch = ".", cex = lwd, col = "red"),
258 min = minmax, max = minmax,
259 dir = if (is_latex()) rmd_files_dir() else tempdir(),
260 file = NULL,
261 file_type = if (is_latex()) "png" else "svg", ...) {
262 if (is.list(x)) {
263 if (same_lim) {
264 if (is.null(xlim)) {
265 xlim <- base::range(unlist(x))
266 }
267 if (is.null(ylim) && !is.null(y)) {
268 ylim <- base::range(unlist(y))
269 }
270 }
271 if (is.null(y)) {
272 y <- replicate(length(x), NULL, simplify = FALSE)
273 } else if (!is.list(y) || length(x) != length(y)) {
274 stop("'x' and 'y' are not the same length")
275 }
276 return(Map(function(x_, y_) {
277 spec_line(x = x_, y = y_,
278 width = width, height = height,
279 same_lim = same_lim, xlim = xlim, ylim = ylim,
280 xaxt = xaxt, yaxt = yaxt, ann = ann, col = col, border = border,
281 frame.plot = frame.plot, lwd = lwd,
282 minmax = minmax, min = min, max = max,
283 dir = dir, file = file, file_type = file_type, ...)
284 }, x, y))
285 }
286
287 if (is.null(y) || !length(y)) {
288 y <- x
289 x <- seq(0, 1, length.out = length(y))
290 tmp <- ylim
291 ylim <- xlim
292 xlim <- tmp
293 }
294
295 if (is.null(xlim)) {
296 xlim <- base::range(x)
297 }
298
299 if (is.null(ylim) && !is.null(y)) {
300 ylim <- base::range(y)
301 }
302
303 if (is.null(min)) min <- minmax
304 if (is.null(max)) max <- minmax
305
306 expand <- c(
307 if (!is.null(min) && length(min)) 0.96 else 1,
308 if (!is.null(max) && length(max)) 1.04 else 1)
309 xlim <- xlim * expand
310 ylim <- ylim * expand
311
312 file_type <- match.arg(file_type, c("svg", "png"))
313
314 if (!dir.exists(dir)) {
315 dir.create(dir)
316 }
317
318 if (is.null(file)) {
319 file <- file.path(dir, paste0(
320 "hist_", round(as.numeric(Sys.time()) * 1000), ".", file_type))
321 }
322
323 if (file_type == "svg") {
324 grDevices::svg(filename = file, width = width / res, height = height / res,
325 bg = 'transparent')
326 } else {
327 grDevices::png(filename = file, width = width, height = height, res = res,
328 bg = 'transparent')
329 }
330 curdev <- grDevices::dev.cur()
331 on.exit(grDevices::dev.off(curdev), add = TRUE)
332
333 graphics::par(mar = c(0, 0, 0.2, 0), lwd = lwd)
334 graphics::plot(x, y, type = "l", xlim = xlim, ylim = ylim, border = border,
335 xaxt = xaxt, yaxt = yaxt, ann = ann, col = col,
336 frame.plot = frame.plot, ...)
337
338 if (!is.null(min) && length(min)) {
339 ind <- which.min(y)
340 do.call(graphics::points, c(list(x[ind], y[ind]), min))
341 }
342
343 if (!is.null(max) && length(max)) {
344 ind <- which.max(y)
345 do.call(graphics::points, c(list(x[ind], y[ind]), max))
346 }
347
348 grDevices::dev.off(curdev)
349
350 if (file_type == "svg") {
351 svg_xml <- xml2::read_xml(file)
352 svg_text <- as.character(svg_xml)
353 unlink(file)
354 } else {
355 svg_text <- NULL
356 }
357 out <- list(path = file, dev = file_type, type = "line",
358 width = width, height = height, res = res,
359 svg_text = svg_text)
360
361 class(out) <- "kableExtraInlinePlots"
362 return(out)
363}