Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

file 95 lines (87 sloc) 2.535 kb
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
bolus <- function(x) UseMethod("bolus")
bolus.proto <- function(x) x$bolus()

# Create a bolus object
# A bolus is a list suitable for digesting.
#
# Most ggplot objects have components that should be hashed when creating
# a digest (especially since most ggplot objects are proto objects and
# are also self-documenting). The bolus methods ensure that only appropriate
# components are digested.
#
# @alias bolus
# @alias bolus.proto
# @alias digest.ggplot
# @alias digest.proto
# @keyword internal
#X hash_tests <- list(
#X list(
#X ggplot() + scale_x_continuous() + scale_y_continuous(),
#X ggplot() + scale_y_continuous() + scale_x_continuous()
#X ),
#X list(
#X qplot(mpg, wt, data=mtcars, na.rm = FALSE),
#X ggplot(mtcars, aes(y=wt, x=mpg)) + geom_point()
#X ),
#X list(
#X qplot(mpg, wt, data=mtcars, xlab = "blah"),
#X qplot(mpg, wt, data=mtcars) + xlab("blah")
#X )
#X )
#X
#X lapply(hash_tests, function(equal) {
#X hashes <- lapply(equal, digest.ggplot)
#X
#X if (length(unique(hashes)) != 1) {
#X lapply(equal, function(x) print(str(bolus(x))))
#X stop("Above plots not equal")
#X }
#X })
bolus.ggplot <- function(x, ...) {
  sort.by.name <- function(x) {
    if (is.null(names(x))) return(x)
    x[order(names(x))]
  }
  
  with(x, list(
    data = digest::digest(data),
    mapping = sort.by.name(mapping),
    layers = sapply(layers, function(x) x$hash()),
    scales = digest(scales),
    facet = facet$hash(),
    coord = coordinates$hash(),
    options = digest::digest(defaults(x$options, theme_get()))
  ))
}

digest.proto <- function(x, ...) x$hash(, ...)
digest.ggplot <- function(x, ...) {
  if (is.null(x)) return()
  digest::digest(bolus(x), ...)
}

TopLevel$settings <- function(.) {
  mget(setdiff(ls(., all.names=TRUE), c(".that", ".super")), .)
}

Layer$hash <- TopLevel$hash <- function(., ...) {
  digest::digest(.$bolus(), ...)
}
TopLevel$bolus <- function(.) {
  list(
    name = .$objname,
    settings = .$settings()
  )
}

Layer$bolus <- function(.) {
  params <- c(.$geom_params, .$stat_params)
  params <- params[!duplicated(params)]
  if (!is.null(params) && length(params) > 1) params <- params[order(names(params))]
  
  mapping <- .$mapping
  if (!is.null(mapping)) mapping <- mapping[order(names(mapping))]
  
  list(
    geom = .$geom$objname,
    stat = .$stat$objname,
    pos = .$position$objname,
    pos_parms = .$position$settings(),
    data = .$data,
    mapping = mapping,
    params = params,
    legend = .$legend
  )
}
Something went wrong with that request. Please try again.