r-lib / ragg
1
#' Draw to a PPM file
2
#' 
3
#' The PPM (Portable Pixel Map) format defines one of the simplest storage 
4
#' formats available for 
5
#' image data. It is basically a raw 8bit RGB stream with a few bytes of 
6
#' information in the start. It goes without saying, that this file format is
7
#' horribly inefficient and should only be used if you want to play around with
8
#' a simple file format, or need a file-based image stream.
9
#' 
10
#' @param filename The name of the file. Follows the same semantics as the file 
11
#'   naming in [grDevices::png()], meaning that you can provide a [sprintf()] 
12
#'   compliant string format to name multiple plots (such as the default value)
13
#' @param width,height The dimensions of the device
14
#' @param units The unit `width` and `height` is measured in, in either pixels 
15
#'   (`'px'`), inches (`'in'`), millimeters (`'mm'`), or centimeter (`'cm'`).
16
#' @param pointsize The default pointsize of the device in pt. This will in 
17
#'   general not have any effect on grid graphics (including ggplot2) as text 
18
#'   size is always set explicitly there.
19
#' @param background The background colour of the device
20
#' @param res The resolution of the device. This setting will govern how device
21
#'   dimensions given in inches, centimeters, or millimeters will be converted
22
#'   to pixels. Further, it will be used to scale text sizes and linewidths
23
#' @param scaling A scaling factor to apply to the rendered line width and text
24
#'   size. Useful for getting the right dimensions at the resolution that you
25
#'   need. If e.g. you need to render a plot at 4000x3000 pixels for it to fit 
26
#'   into a layout, but you find that the result appears to small, you can 
27
#'   increase the `scaling` argument to make everything appear bigger at the 
28
#'   same resolution.
29
#' @param bg Same as `background` for compatibility with old graphic device APIs
30
#'
31
#' @export
32
#' 
33
#' @examples 
34
#' file <- tempfile(fileext = '.ppm')
35
#' agg_ppm(file)
36
#' plot(sin, -pi, 2*pi)
37
#' dev.off()
38
#' 
39
agg_ppm <- function(filename = 'Rplot%03d.ppm', width = 480, height = 480, 
40
                    units = 'px', pointsize = 12, background = 'white', 
41
                    res = 72, scaling = 1, bg) {
42 1
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
43 1
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
44 0
    units <- 'in'
45
  }
46 1
  file <- validate_path(filename)
47 1
  dim <- get_dims(width, height, units, res)
48 1
  background <- if (missing(bg)) background else bg
49 1
  .Call("agg_ppm_c", file, dim[1], dim[2], as.numeric(pointsize), background, 
50 1
        as.numeric(res), as.numeric(scaling), PACKAGE = 'ragg')
51 1
  invisible()
52
}
53

54
#' Draw to a PNG file
55
#' 
56
#' The PNG (Portable Network Graphic) format is one of the most ubiquitous 
57
#' today, due to its versatiliity 
58
#' and widespread support. It supports transparency as well as both 8 and 16 bit
59
#' colour. The device uses default compression and filtering and will not use a
60
#' colour palette as this is less useful for antialiased data. This means that 
61
#' it might be possible to compress the resulting image even more if size is of
62
#' concern (though the defaults are often very good). In contrast to 
63
#' [grDevices::png()] the date and time will not be written to the file, meaning
64
#' that similar plot code will produce identical files (a good feature if used 
65
#' with version control). It will, however, write in the dimensions of the image
66
#' based on the `res` argument.
67
#' 
68
#' @inheritParams agg_ppm
69
#' @param bitsize Should the device record colour as 8 or 16bit 
70
#' 
71
#' @export
72
#' 
73
#' @examples 
74
#' file <- tempfile(fileext = '.png')
75
#' agg_png(file)
76
#' plot(sin, -pi, 2*pi)
77
#' dev.off()
78
#' 
79
agg_png <- function(filename = 'Rplot%03d.png', width = 480, height = 480, 
80
                    units = 'px', pointsize = 12, background = 'white', 
81
                    res = 72, scaling = 1, bitsize = 8, bg) {
82 1
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
83 1
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
84 0
    units <- 'in'
85
  }
86 1
  file <- validate_path(filename)
87 1
  if (!bitsize %in% c(8, 16)) {
88 0
    stop('Only 8 and 16 bit is supported', call. = FALSE)
89
  }
90 1
  dim <- get_dims(width, height, units, res)
91 1
  background <- if (missing(bg)) background else bg
92 1
  .Call("agg_png_c", file, dim[1], dim[2], as.numeric(pointsize), background, 
93 1
        as.numeric(res), as.numeric(scaling), as.integer(bitsize), 
94 1
        PACKAGE = 'ragg')
95 1
  invisible()
96
}
97
#' Draw to a TIFF file
98
#' 
99
#' The TIFF (Tagged Image File Format) format is a very versatile raster image
100
#' storage format that supports 8 and 16bit colour mode, true transparency, as
101
#' well as a range of other features not relevant to drawing from R (e.g. 
102
#' support for different colour spaces). The storage mode of the image data is
103
#' not fixed and different compression modes are possible, in contrast to PNGs
104
#' one-approach-fits-all. The default (uncompressed) will result in much larger
105
#' files than PNG, and in general PNG is a better format for many of the graphic
106
#' types produced in R. Still, TIFF has its purposes and sometimes this file
107
#' format is explicetly requested.
108
#' 
109
#' @section Transparency:
110
#' TIFF have support for true transparency, meaning that the pixel colour is 
111
#' stored in pre-multiplied form. This is in contrast to pixels being stored in 
112
#' plain format, where the alpha values more function as a mask. The utility of
113
#' this is not always that important, but it is one of the benefits of TIFF over
114
#' PNG so it should be noted.
115
#' 
116
#' @inheritParams agg_png
117
#' @param compression The compression type to use for the image data. The 
118
#' standard options from the [grDevices::tiff()] function are available under 
119
#' the same name.
120
#' 
121
#' @note `'jpeg'` compression is only available if ragg is compiled with a 
122
#' version of `libtiff` where jpeg support has been turned on.
123
#' 
124
#' @export
125
#' 
126
#' @examples 
127
#' file <- tempfile(fileext = '.tiff')
128
#' # Use jpeg compression
129
#' agg_tiff(file, compression = 'lzw+p')
130
#' plot(sin, -pi, 2*pi)
131
#' dev.off()
132
#' 
133
agg_tiff <- function(filename = 'Rplot%03d.tiff', width = 480, height = 480, 
134
                    units = 'px', pointsize = 12, background = 'white', 
135
                    res = 72, scaling = 1, compression = 'none', bitsize = 8, bg) {
136 1
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
137 1
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
138 0
    units <- 'in'
139
  }
140 1
  file <- validate_path(filename)
141 1
  encoding <- switch(compression, 'lzw+p' = , 'zip+p' = 1L, 0L)
142 1
  compression <- switch(
143 1
    compression,
144 1
    'none' = 0L,
145 1
    'rle' = 2L,
146 1
    'lzw+p' = ,
147 1
    'lzw' = 5L,
148 1
    'jpeg' = 7L,
149 1
    'zip+p' = ,
150 1
    'zip' = 8L
151
  )
152 1
  if (!bitsize %in% c(8, 16)) {
153 0
    stop('Only 8 and 16 bit is supported', call. = FALSE)
154
  }
155 1
  dim <- get_dims(width, height, units, res)
156 1
  background <- if (missing(bg)) background else bg
157 1
  .Call("agg_tiff_c", file, dim[1], dim[2], as.numeric(pointsize), background, 
158 1
        as.numeric(res), as.numeric(scaling), as.integer(bitsize), compression, 
159 1
        encoding, PACKAGE = 'ragg')
160 1
  invisible()
161
}
162
#' Draw to a JPEG file
163
#' 
164
#' The JPEG file format is a lossy compressed file format developed in 
165
#' particular for digital photography. The format is not particularly 
166
#' well-suited for line drawings and text of the type normally associated with 
167
#' statistical plots as the compression algorithm creates noticable artefacts. 
168
#' It is, however, great for saving image data, e.g. heightmaps etc. Thus, for
169
#' standard plots, it would be better to use [agg_png()], but for plots that
170
#' includes a high degree of raster image rendering this device will result in
171
#' smaller plots with very little quality degradation.
172
#' 
173
#' @inheritParams agg_png
174
#' @param quality An integer between `0` and `100` defining the quality/size 
175
#' tradeoff. Setting this to `100` will result in no compression.
176
#' @param smoothing A smoothing factor to apply before compression, from `0` (no
177
#' smoothing) to `100` (full smoothing). Can also by `FALSE` (no smoothing) or 
178
#' `TRUE` (full smoothing).
179
#' @param method The compression algorithm to use. Either `'slow'`, `'fast'`, or
180
#' `'float'`. Default is `'slow'` which works best for most cases. `'fast'` 
181
#' should only be used when quality is below `97` as it may result in worse 
182
#' performance at high quality settings. `'float'` is a legacy options that 
183
#' calculate the compression using floating point precission instead of with 
184
#' integers. It offers no quality benefit and is often much slower.
185
#' 
186
#' @note Smoothing is only applied if ragg has been compiled against a jpeg 
187
#' library that supports smoothing.
188
#' 
189
#' @export
190
#' 
191
#' @examples 
192
#' file <- tempfile(fileext = '.jpeg')
193
#' agg_jpeg(file, quality = 50)
194
#' plot(sin, -pi, 2*pi)
195
#' dev.off()
196
#' 
197
agg_jpeg <- function(filename = 'Rplot%03d.jpeg', width = 480, height = 480, 
198
                     units = 'px', pointsize = 12, background = 'white', 
199
                     res = 72, scaling = 1, quality = 75, smoothing = FALSE, 
200
                     method = 'slow', bg) {
201 1
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
202 1
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
203 0
    units <- 'in'
204
  }
205 1
  file <- validate_path(filename)
206 1
  quality <- min(100, max(0, quality))
207 1
  if (is.logical(smoothing)) smoothing <- if (smoothing) 100 else 0
208 1
  smoothing <- min(100, max(0, smoothing))
209 1
  method <- match.arg(tolower(method), c('slow', 'fast', 'float'))
210 1
  method <- match(method, c('slow', 'fast', 'float')) - 1L
211 1
  dim <- get_dims(width, height, units, res)
212 1
  background <- if (missing(bg)) background else bg
213 1
  .Call("agg_jpeg_c", file, dim[1], dim[2], as.numeric(pointsize), background, 
214 1
        as.numeric(res), as.numeric(scaling), as.integer(quality), 
215 1
        as.integer(smoothing), method, PACKAGE = 'ragg')
216 1
  invisible()
217
}
218
#' Draw to a PNG file, modifying transparency on the fly
219
#' 
220
#' The graphic engine in R only supports 8bit colours. This is for the most part
221
#' fine, as 8bit gives all the fidelity needed for most graphing needs. However,
222
#' this may become a limitation if you need to plot thousands of very 
223
#' translucent shapes on top of each other. 8bit only afford a minimum of 1/255
224
#' alpha, which may end up accumulating to fully opaque at some point. This 
225
#' device allows you to create a 16bit device that modifies the alpha level of 
226
#' all incomming colours by a fixed multiplier, thus allowing for much more 
227
#' translucent colours. The device will only modify transparent colour, so if
228
#' you pass in an opaque colour it will be left unchanged.
229
#' 
230
#' @inheritParams agg_ppm
231
#' @param alpha_mod A numeric between 0 and 1 that will be multiplied to the 
232
#' alpha channel of all transparent colours
233
#' 
234
#' @export
235
#' @keywords internal
236
#' 
237
agg_supertransparent <- function(filename = 'Rplot%03d.png', width = 480, 
238
                                 height = 480, units = 'px', pointsize = 12, 
239
                                 background = 'white', res = 72, scaling = 1, 
240
                                 alpha_mod = 1, bg) {
241 0
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
242 0
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
243 0
    units <- 'in'
244
  }
245 0
  file <- validate_path(filename)
246 0
  dim <- get_dims(width, height, units, res)
247 0
  background <- if (missing(bg)) background else bg
248 0
  .Call("agg_supertransparent_c", file, dim[1], dim[2], as.numeric(pointsize), 
249 0
        background, as.numeric(res), as.numeric(scaling), as.double(alpha_mod), 
250 0
        PACKAGE = 'ragg')
251 0
  invisible()
252
}
253

254
#' Draw to a buffer that can be accessed directly
255
#' 
256
#' Usually the point of using a graphic device is to create a file or show the 
257
#' graphic on the screen. A few times we need the image data for further 
258
#' processing in R, and instead of writing it to a file and then reading it back
259
#' into R the `agg_capture()` device lets you get the image data directly from 
260
#' the buffer. In contrast to the other devices this device returns a function,
261
#' that when called will return the current state of the buffer.
262
#' 
263
#' @inheritParams agg_ppm
264
#' 
265
#' @return A function that when called returns the current state of the buffer.
266
#' The return value of the function depends on the `native` argument. If `FALSE`
267
#' (default) the return value is a `matrix` of colour values and if `TRUE` the 
268
#' return value is a `nativeRaster` object.
269
#' 
270
#' @importFrom grDevices dev.list dev.off dev.cur dev.capture dev.set
271
#' @export
272
#' 
273
#' @examples 
274
#' cap <- agg_capture()
275
#' plot(1:10, 1:10)
276
#' 
277
#' # Get the plot as a matrix
278
#' raster <- cap()
279
#' 
280
#' # Get the plot as a nativeRaster
281
#' raster_n <- cap(native = TRUE)
282
#' 
283
#' dev.off()
284
#' 
285
#' # Look at the output
286
#' plot(as.raster(raster))
287
#' 
288
agg_capture <- function(width = 480, height = 480, units = 'px', pointsize = 12, 
289
                        background = 'white', res = 72, scaling = 1, bg) {
290 1
  if (environmentName(parent.env(parent.frame())) == "knitr" && 
291 1
      deparse(sys.call(), nlines = 1, width.cutoff = 500) == 'dev(filename = filename, width = dim[1], height = dim[2], ...)') {
292 0
    units <- 'in'
293
  }
294 1
  dim <- get_dims(width, height, units, res)
295 1
  background <- if (missing(bg)) background else bg
296 1
  name <- paste0('agg_capture_', sample(.Machine$integer.max, 1))
297 1
  .Call("agg_capture_c", name, dim[1], dim[2], as.numeric(pointsize), 
298 1
        background, as.numeric(res), as.numeric(scaling), PACKAGE = 'ragg')
299 1
  cap <- function(native = FALSE) {
300 1
    current_dev = dev.cur()
301 1
    if (names(current_dev)[1] == name) {
302 1
      return(dev.capture(native = native))
303
    }
304 0
    all_dev <- dev.list()
305 0
    if (!name %in% names(all_dev)) {
306 0
      stop('The device (', name, ') is no longer open', call. = FALSE)
307
    }
308 0
    dev.set(all_dev[name])
309 0
    on.exit(dev.set(current_dev))
310 0
    dev.capture(native = native)
311
  }
312 1
  invisible(cap)
313
}

Read our documentation on viewing source code .

Loading