scales/0000755000176000001440000000000012057634772011571 5ustar ripleyusersscales/MD50000644000176000001440000001243112057634772012102 0ustar ripleyusers1aea131840b30d24859a2bad5029f2ab *DESCRIPTION 3f383eadeed5616092c7a4583870f7eb *NAMESPACE 0b05d80f99c82d12612ec28f211c0bdb *NEWS 8f5993ce0966e0ddc628de948c294aae *R/bounds.r 62c96073a6818d6f57bc4a3b1371389f *R/breaks.r 35747daa6ccb3410e9cf156b066f0e37 *R/colour-manip.r 2f8186364bc82ff1aad0b095bebefaca *R/date-time.r f714a10017d93b693f1f6a05250891be *R/documentation.r 430dd9e4af572dd5bdae1f1673cb8a11 *R/formatter.r 356f976bfc736122d399a8fe996c56ea *R/full-seq.r 932da2aa512e9fefe925ade14e87e30c *R/pal-area.r 50f86b77b210f3fee4d5ba040bd58f4a *R/pal-brewer.r 58b53da932f57fd36736c2ad3040206f *R/pal-dichromat.r 59192407795030694ff12bc1e31a2993 *R/pal-gradient.r 71512f007a23dc9d24abcfed6361dad1 *R/pal-grey.r 1b11ab9ca6fda8fd14b3826454a5fa9c *R/pal-hue.r 732494f5f4054ca39a7da7731d023add *R/pal-identity.r a4c1f8acacabe7943df7173df7fe0633 *R/pal-linetype.r 716233051ba6990a7f9df54b51227294 *R/pal-manual.r 8cf6ec1effbef4498ee7d88ce0cbe9e2 *R/pal-rescale.r bff20c9fef8cae96c082ca8e216f662f *R/pal-shape.r 8fab297eb9213481f1a881d7f6f23d83 *R/range.r 15e5251a1e5775a3b081728ac24cd207 *R/scale-continuous.r 56da7559ee91befb22cc28f0c8fa4f55 *R/scale-discrete.r 5d7e59ffa1523d833bc5a6466eb7e5b4 *R/scales.r 5726ee3b0cb6c6636338c04d2bb96b39 *R/trans-date.r 459070db25729d2b6625e1490dfda745 *R/trans-numeric.r f0602ad594e96a3b72f1014e9c386e70 *R/trans.r bacab3cc444f392056885d3fc7005b74 *README.md 7308dd715e99af5ff0e58978d57b668c *build/partial.rdb 41879206aab0f820a4262399a9357faf *inst/tests/test-alpha.r 210d4b72f91809cb8c82a36d60eff279 *inst/tests/test-bounds.r b5bb7a6051319394602be12701d8b845 *inst/tests/test-breaks-log.r ebcef8414ebe4ccb27a31661e9430a7c *inst/tests/test-formatter.r 306be4c95033a6b3d1446644165026eb *inst/tests/test-range.r 1f4791748d113fc5cf34c84c7325348c *inst/tests/test-scale.r cf896ab44315aa38f0b00484b3e3c624 *inst/tests/test-trans-date.r 13c44729a8f80c2a38ed1be41a85b42c *inst/tests/test-trans.r d3d90179f2c34194952dda5dd4d021d7 *inst/tests/test-zero-range.r 0e5c76149bae28c7bcc36c9a2390eb1a *man/Range.Rd 1036827aaceb8b7df20a977b48fcdce0 *man/abs_area.Rd ebe57519b518b3084df49c0e0dbcf6e6 *man/alpha.Rd 3fefd22be76243b1aee9716aa40ef1ca *man/area_pal.Rd 38c932026821c1acd9427bedf1be584c *man/as.trans.Rd 9af5cbbb9e178a1b8cda6258bf9deb7e *man/asn_trans.Rd f97de82d42d7d46df0f2106c1674ff18 *man/atanh_trans.Rd 59218d2fec0b0e3d8a31bf7affa94d28 *man/boxcox_trans.Rd 98db8f584532a396f5c011cdc257b474 *man/brewer_pal.Rd 2bf217b8c33e230c37f1327c02ff5a7b *man/cbreaks.Rd 920bf92e964a8f6e40df122ce5a9f4a1 *man/censor.Rd 8b3c4c904e2955eca7d759139afe4c2b *man/col2hcl.Rd 7129b1ffbe0d76b90ed0a510739c753b *man/comma_format.Rd 14cd0c6893489c91f0736c5f284f565d *man/cscale.Rd bd24361453d4c07b129cc558ebb06d81 *man/date_breaks.Rd 11c264213343dba37baadd766bf48f36 *man/date_format.Rd 2cccee0123c32f073c8ed50387d77c53 *man/date_trans.Rd 2204c7e1522d5902c9708200efee6563 *man/dichromat_pal.Rd 866e790f5306984fdf9b68e917f730f6 *man/discard.Rd 1b9b782ff588f04738e3b929589dc778 *man/div_gradient_pal.Rd 7893c44c1e9838b4f43d648618dc4714 *man/dollar_format.Rd 5981eb05aa5cf0c24692628bc8687916 *man/dscale.Rd 46a86db0b8062b90204fc5aaa6c43353 *man/exp_trans.Rd 710e698e39512458070cc5f022577fff *man/expand_range.Rd 7143b0112414236cf3acb4a57c8c005a *man/extended_breaks.Rd 0caa4f7b72c646a66aec8a91ddfc1f34 *man/format_format.Rd 57e302a8b46136b105e0715e91afea21 *man/fullseq.Rd 77f9253937e726c610492821b676a263 *man/gradient_n_pal.Rd b29c7d4ecc32488b2de1cba3f8db9b0a *man/grey_pal.Rd a6422468af2ad2428638c6712d240433 *man/hue_pal.Rd c56a6ce7f8357b8164ac6491185bed35 *man/identity_pal.Rd 4358ad7db9a31ceaecc5aa0e505b96e0 *man/identity_trans.Rd f99da345b67d4bffaee9ad786f223979 *man/linetype_pal.Rd 243415cf0f2a2893685859489a68cb70 *man/log1p_trans.Rd 69e990c58925e51d970f0db6e1de3234 *man/log_breaks.Rd f33bd1fc0e13dadf5236d13a32d05e6f *man/log_trans.Rd 840d155d2ec4aa901d8394aada77def6 *man/manual_pal.Rd 6f3b9605bfa09f5b329bd0c859c5c28b *man/math_format.Rd 410f1304784c551d6985548488e31569 *man/muted.Rd a8d2a0739b784a2f5f446e0389cf2b08 *man/package-scales.Rd 47d8166da895e7c9386cf2d2d80e487a *man/parse_format.Rd 257040cabd946421bc3f7f1f9ba3f724 *man/percent_format.Rd 95d3449b550d20af909873d3e1369be4 *man/pretty_breaks.Rd 4eb3b48c216984ef76bc5b104695e217 *man/probability_trans.Rd bf120e809b168c98c7ff6a998f1f84e5 *man/reciprocal_trans.Rd b9133c8f477f91fbf1079baf778d53b5 *man/rescale.Rd a2d2fc64cd2df7f743faa9c3b79a1871 *man/rescale_max.Rd 9dd56312a3a12328cd27021de57de94f *man/rescale_mid.Rd 4011e7c644a5921de8f7894ec0bcb652 *man/rescale_none.Rd 5d60618f36e09e3fc2f0252c26f240b0 *man/rescale_pal.Rd 9f6b3320d629cc0af960cd932fbce999 *man/reverse_trans.Rd f4682c265ebbc0499de09b3e75a0373f *man/scientific_format.Rd cfa46f96e40c0d037c771a39cc6bf3f2 *man/seq_gradient_pal.Rd ce35c473bdc021b7675a3ec8a48d35f4 *man/shape_pal.Rd 9d653aaa7fbc441244c25ed071be188f *man/show_col.Rd a8b12322a91cc065488b0946bbe84ce8 *man/sqrt_trans.Rd 12582d58e0bc7c56c41ec49fa7d2a071 *man/squish.Rd 89bef1ec3f16653529e1ffe0aea9a0f7 *man/squish_infinite.Rd 247ab9a1abd955f9c2e21c2b567e3b77 *man/time_trans.Rd 0fc4a85d4d194654807e086c77292ac8 *man/trans_breaks.Rd d4f49c598401a639a23999c5dd83dfcc *man/trans_format.Rd 6d753fa2ea47ed2dda7b4a47b9e97e16 *man/trans_new.Rd 05aa4d798731b6c829474a45757f49d0 *man/trans_range.Rd 723f007e2eddc1470cf0ab2617dc62b4 *man/zero_range.Rd 8595449c3df146c58b6f4250f2d49ad7 *tests/test-all.R scales/tests/0000755000176000001440000000000011507203335012715 5ustar ripleyusersscales/tests/test-all.R0000644000176000001440000000007111507203351014561 0ustar ripleyuserslibrary(testthat) library(scales) test_package("scales")scales/README.md0000644000176000001440000000265711523570111013041 0ustar ripleyusers# Scales One of the most difficult parts of any graphics package is scaling, converting from data values to perceptual properties. The inverse of scaling, making guides (legends and axes) that can be used to read the graph, is often even harder! The idea of the `scales` package is to implement scales in a way that is graphics system agnostic, so that everyone can benefit by pooling knowledge and resources about this tricky topic. # Components The `scales` package is made up of the following interdependent components * Palettes, __pal__ for short, describe the useful palettes of aesthetics. * Transformations, __trans__ for short, describe common scale transformations, their inverses, and ways of generating breaks and labels. * Bounds: various ways of rescaling the data * Scaling functions: pull together palettes, bounding functions and transformations to provide a complete pathway from raw data to perceptual properties * Mutable ranges: in many graphics pathways, scale ranges can not be computed in a single pass, but must be computed over multiple groups or multiple panels. The mutable ranges (implemented with R's new reference based class) provide a thin layer of mutability to make this task easier. Guide-related: * Breaks and formats: ways of computing how tick marks/legend keys should be distributed across the data range, as well as how to convert those numeric positions into reader-friendly labels scales/R/0000755000176000001440000000000012057501623011756 5ustar ripleyusersscales/R/trans.r0000644000176000001440000000436511775331366013313 0ustar ripleyusers#' Create a new transformation object. #' #' A transformation encapsulates a transformation and its inverse, as well #' as the information needed to create pleasing breaks and labels. The breaks #' function is applied on the transformed range of the range, and it's #' expected that the labels function will perform some kind of inverse #' tranformation on these breaks to give them labels that are meaningful on #' the original scale. #' #' @param name transformation name #' @param transform function, or name of function, that performs the #' transformation #' @param inverse function, or name of function, that performs the #' inverse of the transformation #' @param breaks default breaks function for this transformation. The breaks #' function is applied to the raw data. #' @param format default format for this transformation. The format is applied #' to breaks generated to the raw data. #' @param domain domain, as numeric vector of length 2, over which #' transformation is valued #' @seealso \Sexpr[results=rd,stage=build]{scales:::seealso_trans()} #' @export trans_new is.trans #' @aliases trans_new trans is.trans #' @S3method print trans trans_new <- function(name, transform, inverse, breaks = extended_breaks(), format = format_format(), domain = c(-Inf, Inf)) { if (is.character(transform)) transform <- match.fun(transform) if (is.character(inverse)) inverse <- match.fun(inverse) structure(list(name = name, transform = transform, inverse = inverse, breaks = breaks, format = format, domain = domain), class = "trans") } is.trans <- function(x) inherits(x, "trans") print.trans <- function(x, ...) cat("Transformer: ", x$name, "\n") #' Convert character string to transformer. #' #' @param x name of transformer #' @export as.trans <- function(x) { if (is.trans(x)) return(x) f <- str_c(x, "_trans") match.fun(f)() } #' Compute range of transformed values. #' #' Silently drops any ranges outside of the domain of \code{trans}. #' #' @param trans a transformation object, or the name of a transformation object #' given as a string. #' @param x a numeric vector to compute the rande of #' @export trans_range <- function(trans, x) { trans <- as.trans(trans) range(trans$trans(range(squish(x, trans$domain), na.rm = TRUE))) } scales/R/trans-numeric.r0000644000176000001440000000555411564510212014735 0ustar ripleyusers#' Arc-sin square root transformation. #' #' @export asn_trans <- function() { trans_new( "asn", function(x) 2 * asin(sqrt(x)), function(x) sin(x / 2) ^ 2) } #' Arc-tangent transformation. #' #' @export atanh_trans <- function() { trans_new("atanh", "atanh", "tanh") } #' Box-Cox power transformation. #' #' @param p Exponent of boxcox transformation. #' @references See \url{http://en.wikipedia.org/wiki/Power_transform} for # more details on method. #' @export boxcox_trans <- function(p) { if (abs(p) < 1e-07) return(log_trans) trans <- function(x) (x ^ p - 1) / p * sign(x - 1) inv <- function(x) (abs(x) * p + 1 * sign(x)) ^ (1 / p) trans_new( str_c("pow-", format(p)), trans, inv) } #' Exponential transformation (inverse of log transformation). #' #' @param base Base of logarithm #' @export exp_trans <- function(base = exp(1)) { trans_new( str_c("power-", format(base)), function(x) base ^ x, function(x) log(x, base = base)) } #' Identity transformation (do nothing). #' #' @export identity_trans <- function() { trans_new("identity", "force", "force") } #' Log transformation. #' #' @param base base of logarithm #' @aliases log_trans log10_trans log2_trans #' @export log_trans log10_trans log2_trans log_trans <- function(base = exp(1)) { trans <- function(x) log(x, base) inv <- function(x) base ^ x trans_new(str_c("log-", format(base)), trans, inv, log_breaks(base = base), domain = c(1e-100, Inf)) } log10_trans <- function() { log_trans(10) } log2_trans <- function() { log_trans(2) } #' Log plus one transformation. #' #' @export log1p_trans <- function() { trans_new("log1p", "log1p", "expm1") } #' Probability transformation. #' #' @param distribution probability distribution. Should be standard R #' abbreviation so that "p" + distribution is a valid probability density #' function, and "q" + distribution is a valid quantile function. #' @param ... other arguments passed on to distribution and quantile functions #' @aliases probability_trans logit_trans probit_trans #' @export probability_trans logit_trans probit_trans probability_trans <- function(distribution, ...) { qfun <- match.fun(str_c("q", distribution)) pfun <- match.fun(str_c("p", distribution)) trans_new( str_c("prob-", distribution), function(x) qfun(x, ...), function(x) pfun(x, ...)) } logit_trans <- function() probability_trans("logis") probit_trans <- function() probability_trans("norm") #' Reciprocal transformation. #' #' @export reciprocal_trans <- function() { trans_new("reciprocal", function(x) 1 / x, function(x) 1 / x) } #' Reverse transformation. #' #' @export reverse_trans <- function() { trans_new("reverse", function(x) -x, function(x) -x) } #' Square-root transformation. #' #' @export sqrt_trans <- function() { trans_new("sqrt", "sqrt", function(x) x ^ 2, domain = c(0, Inf)) } scales/R/trans-date.r0000644000176000001440000000400111777360254014211 0ustar ripleyusers#' Transformation for dates (class Date). #' #' @export #' @examples #' years <- seq(as.Date("1910/1/1"), as.Date("1999/1/1"), "years") #' t <- date_trans() #' t$trans(years) #' t$inv(t$trans(years)) #' t$format(t$breaks(range(years))) date_trans <- function() { trans_new("date", "from_date", "to_date", breaks = pretty_breaks()) } to_date <- function(x) structure(x, class = "Date") from_date <- function(x) { if (!inherits(x, "Date")) { stop("Invalid input: date_trans works with objects of class Date only", call. = FALSE) } structure(as.numeric(x), names = names(x)) } #' Transformation for times (class POSIXt). #' #' @param tz Optionally supply the time zone. If \code{NULL}, the default, #' the time zone will be extracted from first input with a non-null tz. #' @export #' @examples #' hours <- seq(ISOdate(2000,3,20, tz = ""), by = "hour", length.out = 10) #' t <- time_trans() #' t$trans(hours) #' t$inv(t$trans(hours)) #' t$format(t$breaks(range(hours))) time_trans <- function(tz = NULL) { to_time <- function(x) { force(x) structure(x, class = c("POSIXt", "POSIXct"), tzone = tz) } from_time <- function(x) { if (!inherits(x, "POSIXct")) { stop("Invalid input: time_trans works with objects of class ", "POSIXct only", call. = FALSE) } if (is.null(tz)) { tz <<- attr(as.POSIXlt(x), "tzone")[[1]] } structure(as.numeric(x), names = names(x)) } trans_new("time", "from_time", "to_time", breaks = pretty_breaks()) } #' Regularly spaced dates. #' #' @param width an interval specification, one of "sec", "min", "hour", #' "day", "week", "month", "year". Can be by an integer and a space, or #' followed by "s". #' @export date_breaks <- function(width = "1 month") { function(x) fullseq(x, width) } #' Formatted dates. #' #' @param format Date format using standard POSIX specification. See #' \code{\link{strptime}} for possible formats. #' @export date_format <- function(format = "%Y-%m-%d") { function(x) format(x, format) } scales/R/scales.r0000644000176000001440000000024411506705643013421 0ustar ripleyusers#' Generic plot scaling methods #' #' @docType package #' @name package-scales #' @aliases scales package-scales #' @import RColorBrewer stringr munsell plyr NULL scales/R/scale-discrete.r0000644000176000001440000000266211673734476015057 0ustar ripleyusers#' Discrete scale. #' #' @param x vector of discrete values to scale #' @param palette aesthetic palette to use #' @param na.value aesthetic to use for missing values #' @export #' @examples #' with(mtcars, plot(disp, mpg, pch = 20, cex = 3, #' col = dscale(factor(cyl), brewer_pal()))) dscale <- function(x, palette, na.value = NA) { limits <- train_discrete(x) map_discrete(palette, x, limits, na.value) } train_discrete <- function(new, existing = NULL, drop = FALSE) { if (is.null(new)) return(existing) if (!is.discrete(new)) { stop("Continuous value supplied to discrete scale", call. = FALSE) } discrete_range(existing, new, drop = drop) } discrete_range <- function(old, new, drop = FALSE) { new <- clevels(new, drop = drop) if (is.null(old)) return(new) if (!is.character(old)) old <- clevels(old) new_levels <- setdiff(new, as.character(old)) # Keep as a factor if we don't have any new levels if (length(new_levels) == 0) { return(old) } sort(c(old, new_levels)) } clevels <- function(x, drop = FALSE) { if (is.null(x)) { character() } else if (is.factor(x)) { if (drop) x <- factor(x) values <- levels(x) if (any(is.na(x))) values <- c(values, NA) values } else { sort(unique(x)) } } map_discrete <- function(palette, x, limits, na.value = NA) { n <- length(limits) pal <- palette(n)[match(as.character(x), limits)] ifelse(!is.na(x), pal, na.value) } scales/R/scale-continuous.r0000644000176000001440000000326112055506613015440 0ustar ripleyusers#' Continuous scale. #' #' @param x vector of continuous values to scale #' @param palette palette to use. #' #' Built in palettes: #' \Sexpr[results=rd,stage=build]{scales:::seealso_pal()} #' @param na.value value to use for missing values #' @param trans transformation object describing the how to transform the #' raw data prior to scaling. Defaults to the identity transformation which #' leaves the data unchanged. #' #' Built in transformations: #' \Sexpr[results=rd,stage=build]{scales:::seealso_trans()}. #' @export #' @examples #' with(mtcars, plot(disp, mpg, cex = cscale(hp, rescale_pal()))) #' with(mtcars, plot(disp, mpg, cex = cscale(hp, rescale_pal(), #' trans = sqrt_trans()))) #' with(mtcars, plot(disp, mpg, cex = cscale(hp, area_pal()))) #' with(mtcars, plot(disp, mpg, pch = 20, cex = 5, #' col = cscale(hp, seq_gradient_pal("grey80", "black")))) cscale <- function(x, palette, na.value = NA_real_, trans = identity_trans()) { stopifnot(is.trans(trans)) x <- trans$trans(x) limits <- train_continuous(x) map_continuous(palette, x, limits, na.value) } train_continuous <- function(new, existing = NULL) { if (is.null(new)) return(existing) if (!is.numeric(new)) { stop("Discrete value supplied to continuous scale", call. = FALSE) } suppressWarnings(range(existing, new, na.rm = TRUE, finite = TRUE)) } # Map values for a continuous palette. # # @param oob out of bounds behaviour. Defaults to \code{\link{censor}} # which turns oob values into missing values. map_continuous <- function(palette, x, limits, na.value = NA_real_, oob = censor) { x <- oob(rescale(x, from = limits)) pal <- palette(x) ifelse(!is.na(x), pal, na.value) } scales/R/range.r0000644000176000001440000000144111673731210013235 0ustar ripleyusers#' Mutable ranges. #' #' Mutable ranges have a two methods (\code{train} and \code{reset}), and #' make it possible to build up complete ranges with multiple passes. #' #' @aliases DiscreteRange ContinuousRange #' @export DiscreteRange ContinuousRange Range <- setRefClass("Range", fields = "range", methods = list( initialize = function() { initFields(range = NULL) }) ) DiscreteRange <- setRefClass( "DiscreteRange", contains = "Range", methods = list( train = function(x, drop = FALSE) { range <<- train_discrete(x, range, drop) }, reset = function() range <<- NULL ) ) ContinuousRange <- setRefClass( "Continuous", contains = "Range", methods = list( train = function(x) range <<- train_continuous(x, range), reset = function() range <<- NULL ) ) scales/R/pal-shape.r0000644000176000001440000000116511775340002014014 0ustar ripleyusers#' Shape palette (discrete). #' #' @param solid should shapes be solid or not? #' @export shape_pal <- function(solid = TRUE) { function(n) { if (n > 6) { msg <- paste("The shape palette can deal with a maximum of 6 discrete ", "values because more than 6 becomes difficult to discriminate; ", "you have ", n, ". Consider specifying shapes manually. if you ", "must have them.", sep = "") warning(paste(strwrap(msg), collapse = "\n"), call. = FALSE) } if (solid) { c(16, 17, 15, 3, 7, 8)[seq_len(n)] } else { c(1, 2, 0, 3, 7, 8)[seq_len(n)] } } } scales/R/pal-rescale.r0000644000176000001440000000056211505124532014331 0ustar ripleyusers#' Rescale palette (continuous). #' #' Just rescales the input to the specific output range. Useful for #' alpha, size, and continuous position. #' #' @param range Numeric vector of length two, giving range of possible #' values. Should be between 0 and 1. #' @export rescale_pal <- function(range = c(0.1, 1)) { function(x) { rescale(x, range, c(0, 1)) } } scales/R/pal-manual.r0000644000176000001440000000025111473036515014172 0ustar ripleyusers#' Manual palette (manual). #' #' @param values vector of values to be used as a palette. #' @export manual_pal <- function(values) { function(n) values[seq_len(n)] } scales/R/pal-linetype.r0000644000176000001440000000050411506146136014545 0ustar ripleyusers#' Line type palette (discrete). #' #' Based on a set supplied by Richard Pearson, University of Manchester #' #' @export linetype_pal <- function() { types <- c("solid", "22", "42", "44", "13", "1343", "73", "2262", "12223242", "F282", "F4448444", "224282F2", "F1") function(n) { types[seq_len(n)] } } scales/R/pal-identity.r0000644000176000001440000000023311666153542014552 0ustar ripleyusers#' Identity palette. #' #' Leaves values unchanged - useful when the data is already scaled. #' #' @export identity_pal <- function() { function(x) x } scales/R/pal-hue.r0000644000176000001440000000214211466540507013502 0ustar ripleyusers#' Hue palette (discrete). #' #' @param h range of hues to use, in [0, 360] #' @param l luminance (lightness), in [0, 100] #' @param c chroma (intensity of colour), maximum value varies depending on # combination of hue and luminance. #' @param h.start hue to start at #' @param direction direction to travel around the colour wheel, #' 1 = clockwise, -1 = counter-clockwise #' @importFrom grDevices hcl #' @export #' @examples #' show_col(hue_pal()(4)) #' show_col(hue_pal()(9)) #' show_col(hue_pal(l = 90)(9)) #' show_col(hue_pal(l = 30)(9)) #' #' show_col(hue_pal()(9)) #' show_col(hue_pal(direction = -1)(9)) #' #' show_col(hue_pal()(9)) #' show_col(hue_pal(h = c(0, 90))(9)) #' show_col(hue_pal(h = c(90, 180))(9)) #' show_col(hue_pal(h = c(180, 270))(9)) #' show_col(hue_pal(h = c(270, 360))(9)) hue_pal <- function(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1) { function(n) { if ((diff(h) %% 360) < 1) { h[2] <- h[2] - 360 / n } rotate <- function(x) (x + h.start) %% 360 * direction hues <- rotate(seq(h[1], h[2], length = n)) hcl(hues, c, l) } } scales/R/pal-grey.r0000644000176000001440000000060411466540101013656 0ustar ripleyusers#' Grey scale palette (discrete). #' #' @param start gray value at low end of palette #' @param end gray value at high end of palette #' @seealso \code{\link{seq_gradient_pal}} for continuous version #' @export #' @examples #' show_col(grey_pal()(25)) #' show_col(grey_pal(0, 1)(25)) grey_pal <- function(start = 0.2, end = 0.8) { function(n) grey.colors(n, start = start, end = end) } scales/R/pal-gradient.r0000644000176000001440000000473311775341167014532 0ustar ripleyusers#' Arbitrary colour gradient palette (continous). #' #' @param colours vector of colours #' @param values if colours should not be evenly positioned along the gradient #' this vector gives the position (between 0 and 1) for each colour in the #' \code{colours} vector. See \code{\link{rescale}} for a convience function #' to map an arbitrary range to between 0 and 1. #' @param space colour space in which to calculate gradient. "Lab" usually #' best unless gradient goes through white. #' @export gradient_n_pal <- function(colours, values = NULL, space = "Lab") { ramp <- colorRamp(colours, space = space) function(x) { if (length(x) == 0) return(character()) if (!is.null(values)) { xs <- seq(0, 1, length = length(values)) f <- approxfun(values, xs) x <- f(x) } nice_rgb(ramp(x)) } } nice_rgb <- function(x) { missing <- !complete.cases(x) x[missing, ] <- 0 col <- rgb(x, maxColorValue = 255) col[missing] <- NA col } #' Diverging colour gradient (continous). #' #' @param low colour for low end of gradient. #' @param mid colour for mid point #' @param high colour for high end of gradient. #' @param space colour space in which to calculate gradient. "Lab" usually #' best unless gradient goes through white. #' @export #' @examples #' x <- seq(-1, 1, length = 100) #' r <- sqrt(outer(x^2, x^2, "+")) #' image(r, col = div_gradient_pal()(seq(0, 1, length = 12))) #' image(r, col = div_gradient_pal()(seq(0, 1, length = 30))) #' image(r, col = div_gradient_pal()(seq(0, 1, length = 100))) #' #' library(munsell) #' image(r, col = div_gradient_pal(low = #' mnsl(complement("10R 4/6", fix = TRUE)))(seq(0, 1, length = 100))) div_gradient_pal <- function(low = mnsl("10B 4/6"), mid = mnsl("N 8/0"), high = mnsl("10R 4/6"), space = "Lab") { gradient_n_pal(c(low, mid, high), space = space) } #' Sequential colour gradient palette (continous). #' #' @param low colour for low end of gradient. #' @param high colour for high end of gradient. #' @param space colour space in which to calculate gradient. "Lab" usually #' best unless gradient goes through white. #' @export #' @examples #' x <- seq(0, 1, length = 25) #' show_col(seq_gradient_pal()(x)) #' show_col(seq_gradient_pal("white", "black")(x)) #' #' library(munsell) #' show_col(seq_gradient_pal("white", mnsl("10R 4/6"))(x)) seq_gradient_pal <- function(low = mnsl("10B 4/6"), high = mnsl("10R 4/6"), space = "Lab") { gradient_n_pal(c(low, high), space = space) } scales/R/pal-dichromat.r0000644000176000001440000000151311666153534014676 0ustar ripleyusers#' Dichromat (colour-blind) palette (discrete). #' #' @param name Name of colour palette. One of: #' \Sexpr[results=rd,stage=build]{scales:::dichromat_schemes()} #' @importFrom dichromat colorschemes #' @export #' @examples #' show_col(dichromat_pal("BluetoOrange.10")(10)) #' show_col(dichromat_pal("BluetoOrange.10")(5)) #' #' # Can use with gradient_n to create a continous gradient #' cols <- dichromat_pal("DarkRedtoBlue.12")(12) #' show_col(gradient_n_pal(cols)(seq(0, 1, length = 30))) dichromat_pal <- function(name) { if (!any(name == names(colorschemes))) { stop("Palette name must be one of ", str_c(names(colorschemes), collapse = ", "), call. = FALSE) } pal <- colorschemes[[name]] function(n) pal[seq_len(n)] } dichromat_schemes <- function() { str_c("\\code{", names(colorschemes), "}", collapse = ", ") } scales/R/pal-brewer.r0000644000176000001440000000327712055506613014214 0ustar ripleyusers#' Color Brewer palette (discrete). #' #' @param type One of seq (sequential), div (diverging) or qual (qualitative) #' @param palette If a string, will use that named palette. If a number, will #' index into the list of palettes of appropriate \code{type} #' @references \url{http://colorbrewer2.org} #' @export #' @examples #' show_col(brewer_pal()(10)) #' show_col(brewer_pal("div")(5)) #' show_col(brewer_pal(pal = "Greens")(5)) #' #' # Can use with gradient_n to create a continous gradient #' cols <- brewer_pal("div")(5) #' show_col(gradient_n_pal(cols)(seq(0, 1, length = 30))) brewer_pal <- function(type = "seq", palette = 1) { pal <- pal_name(palette, type) # If <3 colors are requested, brewer.pal will return a 3-color palette and # give a warning. This warning isn't useful, so suppress it. # If the palette has k colors and >k colors are requested, brewer.pal will # return a k-color palette and give a warning. This warning is useful, so # don't suppress it. In both cases, the seq_len(n) is there to make sure # that the n items are returned, even if brewer.pal returns a different # number of items. function(n) { if (n < 3) suppressWarnings(brewer.pal(n, pal))[seq_len(n)] else brewer.pal(n, pal)[seq_len(n)] } } pal_name <- function(palette, type) { if (is.character(palette)) { if (!palette %in% RColorBrewer:::namelist) { warning("Unknown palette ", palette) palette <- "Greens" } return(palette) } switch(type, div = RColorBrewer:::divlist, qual = RColorBrewer:::quallist, seq = RColorBrewer:::seqlist, stop("Unknown palette type. Should be 'div', 'qual' or 'seq'", call. = FALSE) )[palette] } scales/R/pal-area.r0000644000176000001440000000073212055506613013627 0ustar ripleyusers#' Point area palette (continuous). #' #' @param range Numeric vector of length two, giving range of possible sizes. #' Should be greater than 0. #' @export area_pal <- function(range = c(1, 6)) { function(x) rescale(sqrt(x), range, c(0, 1)) } #' Point area palette (continuous), with area proportional to value. #' #' @param max A number representing the maxmimum size. #' @export abs_area <- function(max) { function(x) rescale(sqrt(abs(x)), c(0, max), c(0, 1)) } scales/R/full-seq.r0000644000176000001440000000205311757752227013707 0ustar ripleyusers#' Generate sequence of fixed size intervals covering range. #' #' @param range range #' @param size interval size #' @param ... other arguments passed on to methods #' @keywords internal #' @export #' @seealso \code{\link[plyr]{round_any}} fullseq <- function(range, size, ...) UseMethod("fullseq") #' @S3method fullseq numeric fullseq.numeric <- function(range, size, ..., pad = FALSE) { if (zero_range(range)) return(range + size * c(-1, 1) / 2) x <- seq( round_any(range[1], size, floor), round_any(range[2], size, ceiling), by = size ) if (pad) { # Add extra bin on bottom and on top, to guarantee that we cover complete # range of data, whether right = T or F c(min(x) - size, x, max(x) + size) } else { x } } #' @S3method fullseq Date fullseq.Date <- function(range, size, ...) { seq(floor_date(range[1], size), ceiling_date(range[2], size), by = size) } #' @S3method fullseq POSIXt fullseq.POSIXt <- function(range, size, ...) { seq(floor_time(range[1], size), ceiling_time(range[2], size), by = size) } scales/R/formatter.r0000644000176000001440000001273011744305721014152 0ustar ripleyusers#' Comma formatter: format number with commas separating thousands. #' #' @param ... other arguments passed on to \code{\link{format}} #' @param x a numeric vector to format #' @return a function with single paramater x, a numeric vector, that #' returns a character vector #' @export #' @examples #' comma_format()(c(1, 1e3, 2000, 1e6)) #' comma_format(digits = 9)(c(1, 1e3, 2000, 1e6)) #' comma(c(1, 1e3, 2000, 1e6)) comma_format <- function(...) { function(x) comma(x, ...) } #' @export #' @rdname comma_format comma <- function(x, ...) { format(x, ..., big.mark = ",", scientific = FALSE, trim = TRUE) } #' Currency formatter: round to nearest cent and display dollar sign. #' #' The returned function will format a vector of values as currency. #' Values are rounded to the nearest cent, and cents are displayed if #' any of the values has a non-zero cents and the largest value is less #' than \code{largest_with_cents} which by default is 100000. #' #' @return a function with single paramater x, a numeric vector, that #' returns a character vector #' @param largest_with_cents the value that all values of \code{x} must #' be less than in order for the cents to be displayed #' @param x a numeric vector to format #' @export #' @examples #' dollar_format()(c(100, 0.23, 1.456565, 2e3)) #' dollar_format()(c(1:10 * 10)) #' dollar(c(100, 0.23, 1.456565, 2e3)) #' dollar(c(1:10 * 10)) #' dollar(10^(1:8)) dollar_format <- function(largest_with_cents = 100000) { function(x) { x <- round_any(x, 0.01) if (max(x, na.rm = TRUE) < largest_with_cents & !all(x == floor(x), na.rm = TRUE)) { nsmall <- 2L } else { x <- round_any(x, 1) nsmall <- 0L } str_c("$", format(x, nsmall = nsmall, trim = TRUE, big.mark = ",", scientific = FALSE, digits=1L)) } } #' @export #' @rdname dollar_format dollar <- dollar_format() #' Percent formatter: multiply by one hundred and display percent sign. #' #' @return a function with single paramater x, a numeric vector, that #' returns a character vector #' @param x a numeric vector to format #' @export #' @examples #' percent_format()(runif(10)) #' percent(runif(10)) #' percent(runif(10, 1, 10)) percent_format <- function() { function(x) { x <- round_any(x, precision(x) / 100) str_c(comma(x * 100), "%") } } #' @export #' @rdname percent_format percent <- percent_format() #' Scientific formatter. #' #' @return a function with single paramater x, a numeric vector, that #' returns a character vector #' @param digits number of significant digits to show #' @param ... other arguments passed on to \code{\link{format}} #' @param x a numeric vector to format #' @export #' @examples #' scientific_format()(1:10) #' scientific_format()(runif(10)) #' scientific_format(digits = 2)(runif(10)) #' scientific(1:10) #' scientific(runif(10)) #' scientific(runif(10), digits = 2) scientific_format <- function(digits = 3, ...) { function(x) scientific(x, digits, ...) } #' @export #' @rdname scientific_format scientific <- function(x, digits = 3, ...) { x <- signif(x, digits) format(x, trim = TRUE, scientific = TRUE, ...) } #' Parse a text label to produce expressions for plotmath. #' #' @seealso \code{\link{plotmath}} #' @return a function with single paramater x, a character vector, that #' returns a list of expressions #' @export #' @examples #' parse_format()(c("alpha", "beta", "gamma")) parse_format <- function() { function(x) { llply(as.character(x), function(x) parse(text = x, srcfile = NULL)) } } #' Add arbitrary expression to a label. #' The symbol that will be replace by the label value is \code{.x}. #' #' @param expr expression to use #' @param format another format function to apply prior to mathematical #' transformation - this makes it easier to use floating point numbers in #' mathematical expressions. #' @return a function with single paramater x, a numeric vector, that #' returns a list of expressions #' @export #' @seealso \code{\link{plotmath}} #' @examples #' math_format()(1:10) #' math_format(alpha + frac(1, .x))(1:10) #' math_format()(runif(10)) #' math_format(format = percent)(runif(10)) math_format <- function(expr = 10 ^ .x, format = force) { quoted <- substitute(expr) subs <- function(x) { do.call("substitute", list(quoted, list(.x = as.name(x)))) } function(x) { x <- format(x) llply(x, subs) } } #' Format labels after transformation. #' #' @param trans transformation to apply #' @param format additional formatter to apply after transformation #' @return a function with single paramater x, a numeric vector, that #' returns a character vector of list of expressions #' @export #' @examples #' tf <- trans_format("log10", scientific_format()) #' tf(10 ^ 1:6) trans_format <- function(trans, format = scientific_format()) { if (is.character(trans)) trans <- match.fun(trans) function(x) { x <- trans(x) format(x) } } #' Format with using any arguments to \code{\link{format}}. #' #' If the breaks have names, they will be used in preference to formatting #' the breaks. #' #' @param ... other arguments passed on to \code{\link{format}}. #' @seealso \code{\link{format}}, \code{\link{format.Date}}, #' \code{\link{format.POSIXct}} #' @export format_format <- function(...) { function(x) { if (!is.null(names(x))) return(names(x)) format(x, ..., trim = TRUE, justify = "left") } } precision <- function(x) { rng <- range(x, na.rm = TRUE) span <- if (zero_range(rng)) rng[1] else diff(rng) 10 ^ floor(log10(span)) } scales/R/documentation.r0000644000176000001440000000052111634203511015003 0ustar ripleyusers# Functions used for producing Rd chunks to reduce duplication in # documentation seealso <- function(pattern) { require("scales") names <- ls("package:scales", pattern = pattern) str_c("\\code{\\link{", names, "}}", collapse = ", ") } seealso_trans <- function() seealso("_trans$") seealso_pal <- function() seealso("_pal$") scales/R/date-time.r0000644000176000001440000000327412055506613014022 0ustar ripleyusers# Minimal date time code so no external dependencies needed, and # we can do the date operations we need. Need to look at this again once we # switch to S4 for lubridate. "%||%" <- function(a, b) if (!is.null(a)) a else b floor_date <- function(date, time) { prec <- parse_unit_spec(time) if (prec$unit == "day") { structure(round_any(as.numeric(date), prec$mult), class="Date") } else { as.Date(cut(date, time, right = TRUE, include.lowest = TRUE)) } } floor_time <- function(date, time) { to_time <- function(x) { force(x) structure(x, class = c("POSIXt", "POSIXct")) } prec <- parse_unit_spec(time) if (prec$unit == "sec") { to_time(round_any(as.numeric(date), prec$mult)) } else if (prec$unit == "min") { to_time(round_any(as.numeric(date), prec$mult * 60)) } else { as.POSIXct( cut(date, time, right = TRUE, include.lowest = TRUE), tz = attr(date, "tz") %||% "" ) } } ceiling_date <- function(date, time) { prec <- parse_unit_spec(time) up <- c("day" = 1, "week" = 7, "month" = 31, "year" = 365) date <- date + prec$mult * up[prec$unit] floor_date(date, time) } ceiling_time <- function(date, time) { prec <- parse_unit_spec(time) up <- c( "sec" = 1, "min" = 60, "hour" = 3600, c("day" = 1, "week" = 7, "month" = 31, "year" = 365) * 3600 * 24 ) date <- date + prec$mult * up[prec$unit] floor_time(date, time) } parse_unit_spec <- function(unitspec) { parts <- strsplit(unitspec, " ")[[1]] if (length(parts) == 1) { mult <- 1 unit <- unitspec } else { mult <- as.numeric(parts[[1]]) unit <- parts[[2]] } unit <- gsub("s$", "", unit) list(unit = unit, mult = mult) } scales/R/colour-manip.r0000644000176000001440000000531311744307151014552 0ustar ripleyusers#' Modify standard R colour in hcl colour space. #' #' Transforms rgb to hcl, sets non-missing arguments and then backtransforms #' to rgb. #' #' @param colour character vector of colours to be modified #' @param h new hue #' @param l new luminance #' @param c new chroma #' @param alpha alpha value. Defaults to 1. #' @export #' @examples #' col2hcl(colors()) col2hcl <- function(colour, h, c, l, alpha = 1) { rgb <- t(col2rgb(colour)) / 256 coords <- convertColor(rgb, "sRGB", "Luv") # Check for correctness # colorspace::coords(as(RGB(rgb), "polarLUV")) if (missing(h)) h <- atan2(coords[, "v"], coords[, "u"]) * 180 / pi if (missing(c)) c <- sqrt(coords[, "u"]^ 2 + coords[, "v"]^2) if (missing(l)) l <- coords[, "L"] hcl_colours <- hcl(h, c, l, alpha = alpha) names(hcl_colours) <- names(colour) hcl_colours } #' Mute standard colour. #' #' @param colour character vector of colours to modify #' @param l new luminance #' @param c new chroma #' @export #' @examples #' muted("red") #' muted("blue") #' show_col(c("red", "blue", muted("red"), muted("blue"))) muted <- function(colour, l=30, c=70) col2hcl(colour, l=l, c=c) #' Modify colour transparency. #' Vectorised in both colour and alpha. #' #' @param colour colour #' @param alpha new alpha level in [0,1]. If alpha is \code{NA}, #' existing alpha values are preserved. #' @export #' @examples #' alpha("red", 0.1) #' alpha(colours(), 0.5) #' alpha("red", seq(0, 1, length = 10)) alpha <- function(colour, alpha = NA) { col <- col2rgb(colour, TRUE) / 255 if (length(colour) != length(alpha)) { if (length(colour) > 1 && length(alpha) > 1) { stop("Only one of colour and alpha can be vectorised") } if (length(colour) > 1) { alpha <- rep(alpha, length.out = length(colour)) } else if (length(alpha) > 1) { col <- col[, rep(1, length(alpha)), drop = FALSE] } } alpha[is.na(alpha)] <- col[4, ][is.na(alpha)] new_col <- rgb(col[1,], col[2,], col[3,], alpha) new_col[is.na(colour)] <- NA new_col } #' Show colours. #' #' A quick and dirty way to show colours in a plot. #' #' @param colours a character vector of colours #' @export show_col <- function(colours) { n <- length(colours) ncol <- ceiling(sqrt(n)) nrow <- ceiling(n / ncol) colours <- c(colours, rep(NA, nrow * ncol - length(colours))) colours <- matrix(colours, ncol = ncol, byrow = TRUE) old <- par(pty = "s", mar = c(0, 0, 0, 0)) on.exit(par(old)) size <- max(dim(colours)) plot(c(0, size), c(0, -size), type = "n", xlab="", ylab="", axes = FALSE) rect(col(colours) - 1, -row(colours) + 1, col(colours), -row(colours), col = colours) text(col(colours) - 0.5, -row(colours) + 0.5, colours) } scales/R/breaks.r0000644000176000001440000001105111775331366013421 0ustar ripleyusers#' Pretty breaks. #' Uses default R break algorithm as implemented in \code{\link{pretty}}. #' #' @param n desired number of breaks #' @param ... other arguments passed on to \code{\link{pretty}} #' @export #' @examples #' pretty_breaks()(1:10) #' pretty_breaks()(1:100) #' pretty_breaks()(as.Date(c("2008-01-01", "2009-01-01"))) #' pretty_breaks()(as.Date(c("2008-01-01", "2090-01-01"))) pretty_breaks <- function(n = 5, ...) { function(x) { breaks <- pretty(x, n, ...) names(breaks) <- attr(breaks, "labels") breaks } } #' Extended breaks. #' Uses Wilkinson's extended breaks algorithm as implemented in the #' \pkg{labeling} package. #' #' @param n desired number of breaks #' @param ... other arguments passed on to \code{\link[labeling]{extended}} #' @references Talbot, J., Lin, S., Hanrahan, P. (2010) An Extension of #' Wilkinson's Algorithm for Positioning Tick Labels on Axes, InfoVis #' 2010. #' @importFrom labeling extended #' @export #' @examples #' extended_breaks()(1:10) #' extended_breaks()(1:100) extended_breaks <- function(n = 5, ...) { function(x) { extended(min(x), max(x), n, only.loose = FALSE, ...) } } #' Log breaks (integer breaks on log-transformed scales). #' #' @param n desired number of breaks #' @param base base of logarithm to use #' @export #' @examples #' log_breaks()(c(1, 1e6)) #' log_breaks()(c(1, 1e5)) log_breaks <- function(n = 5, base = 10) { function(x) { rng <- log(range(x, na.rm = TRUE), base = base) min <- floor(rng[1]) max <- ceiling(rng[2]) if (max == min) return(base ^ min) by <- floor((max - min) / n) + 1 base ^ seq(min, max, by = by) } } #' Pretty breaks on transformed scale. #' #' These often do not produce very attractive breaks. #' #' @param trans function of single variable, \code{x}, that given a numeric #' vector returns the transformed values #' @param inv inverse of the transformation function #' @param n desired number of ticks #' @param ... other arguments passed on to pretty #' @export #' @examples #' trans_breaks("log10", function(x) 10 ^ x)(c(1, 1e6)) #' trans_breaks("sqrt", function(x) x ^ 2)(c(1, 100)) #' trans_breaks(function(x) 1 / x, function(x) 1 / x)(c(1, 100)) #' trans_breaks(function(x) -x, function(x) -x)(c(1, 100)) trans_breaks <- function(trans, inv, n = 5, ...) { trans <- match.fun(trans) inv <- match.fun(inv) function(x) { inv(pretty(trans(x), n, ...)) } } #' Compute breaks for continuous scale. #' #' This function wraps up the components needed to go from a continuous range #' to a set of breaks and labels suitable for display on axes or legends. #' #' @param range numeric vector of length 2 giving the range of the underlying #' data #' @param breaks either a vector of break values, or a break function that #' will make a vector of breaks when given the range of the data #' @param labels either a vector of labels (character vector or list of #' expression) or a format function that will make a vector of labels when #' called with a vector of breaks. Labels can only be specified manually if #' breaks are - it is extremely dangerous to supply labels if you don't know #' what the breaks will be. #' @export #' @examples #' cbreaks(c(0, 100)) #' cbreaks(c(0, 100), pretty_breaks(3)) #' cbreaks(c(0, 100), pretty_breaks(10)) #' cbreaks(c(1, 100), log_breaks()) #' cbreaks(c(1, 1e4), log_breaks()) #' #' cbreaks(c(0, 100), labels = math_format()) #' cbreaks(c(0, 1), labels = percent_format()) #' cbreaks(c(0, 1e6), labels = comma_format()) #' cbreaks(c(0, 1e6), labels = dollar_format()) #' cbreaks(c(0, 30), labels = dollar_format()) #' #' # You can also specify them manually: #' cbreaks(c(0, 100), breaks = c(15, 20, 80)) #' cbreaks(c(0, 100), breaks = c(15, 20, 80), labels = c(1.5, 2.0, 8.0)) #' cbreaks(c(0, 100), breaks = c(15, 20, 80), #' labels = expression(alpha, beta, gamma)) cbreaks <- function(range, breaks = extended_breaks(), labels = scientific_format()) { if (zero_range(range)) { return(list(breaks = range[1], labels = format(range[1]))) } if (is.function(breaks)) { breaks <- breaks(range) if (!is.function(labels)) { stop("Labels can only be manually specified in conjunction with breaks", call. = FALSE) } } if (is.function(labels)) { labels <- labels(breaks) } else { if (length(labels) != length(breaks)) { stop("Labels and breaks must be same length") } if (is.expression(labels)) { labels <- as.list(labels) } else { labels <- as.character(labels) } } list(breaks = breaks, labels = labels) } scales/R/bounds.r0000644000176000001440000001446412055506613013446 0ustar ripleyusers#' Rescale numeric vector to have specified minimum and maximum. #' #' @param x numeric vector of values to manipulate. #' @param to output range (numeric vector of length two) #' @param from input range (numeric vector of length two). If not given, is #' calculated from the range of \code{x} #' @keywords manip #' @export #' @examples #' rescale(1:100) #' rescale(runif(50)) #' rescale(1) rescale <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) { if (zero_range(from) || zero_range(to)) return(rep(mean(to), length(x))) (x - from[1]) / diff(from) * diff(to) + to[1] } #' Rescale numeric vector to have specified minimum, midpoint, and maximum. #' #' @export #' @param x numeric vector of values to manipulate. #' @param to output range (numeric vector of length two) #' @param from input range (numeric vector of length two). If not given, is #' calculated from the range of \code{x} #' @param mid mid-point of input range #' @examples #' rescale_mid(1:100, mid = 50.5) #' rescale_mid(runif(50), mid = 0.5) #' rescale_mid(1) rescale_mid <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) { if (zero_range(from) || zero_range(to)) return(rep(mean(to), length(x))) extent <- 2 * max(abs(from - mid)) (x - mid) / extent * diff(to) + mean(to) } #' Rescale numeric vector to have specified maximum. #' #' @export #' @param x numeric vector of values to manipulate. #' @param to output range (numeric vector of length two) #' @param from input range (numeric vector of length two). If not given, is #' calculated from the range of \code{x} #' @examples #' rescale_max(1:100) #' rescale_max(runif(50)) #' rescale_max(1) rescale_max <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) { x / from[2] * to[2] } #' Don't peform rescaling #' #' @param x numeric vector of values to manipulate. #' @param ... all other arguments ignored #' @export #' @examples #' rescale_none(1:100) rescale_none <- function(x, ...) { x } #' Censor any values outside of range. #' #' @export #' @param x numeric vector of values to manipulate. #' @param range numeric vector of length two giving desired output range. #' @param only.finite if \code{TRUE} (the default), will only modify #' finite values. #' @export #' @examples #' censor(c(-1, 0.5, 1, 2, NA)) censor <- function(x, range = c(0, 1), only.finite = TRUE) { force(range) finite <- if (only.finite) is.finite(x) else TRUE # Assign NA - this makes sure that, even if all elements are # replaced with NA, it stays numeric (and isn't changed to logical) x[finite & x < range[1]] <- NA_real_ x[finite & x > range[2]] <- NA_real_ x } #' Discard any values outside of range. #' #' @inheritParams censor #' @export #' @examples #' discard(c(-1, 0.5, 1, 2, NA)) discard <- function(x, range = c(0, 1)) { force(range) x[x >= range[1] & x <= range[2]] } #' Squish values into range. #' #' @author Homer Strong #' @inheritParams censor #' @export #' @examples #' squish(c(-1, 0.5, 1, 2, NA)) #' squish(c(-1, 0, 0.5, 1, 2)) squish <- function(x, range = c(0, 1), only.finite = TRUE) { force(range) finite <- if (only.finite) is.finite(x) else TRUE x[finite & x < range[1]] <- range[1] x[finite & x > range[2]] <- range[2] x } #' Squish infinite values to range. #' #' @param x numeric vector of values to manipulate. #' @param range numeric vector of length two giving desired output range. #' @export #' @examples #' squish_infinite(c(-Inf, -1, 0, 1, 2, Inf)) squish_infinite <- function(x, range = c(0, 1)) { force(range) x[x == -Inf] <- range[1] x[x == Inf] <- range[2] x } #' Expand a range with a multiplicative or additive constant. #' #' @param range range of data, numeric vector of length 2 #' @param mul multiplicative constract #' @param add additive constant #' @param zero_width distance to use if range has zero width #' @export expand_range <- function(range, mul = 0, add = 0, zero_width = 1) { if (is.null(range)) return() if (zero_range(range)) { c(range[1] - zero_width / 2, range[1] + zero_width / 2) } else { range + c(-1, 1) * (diff(range) * mul + add) } } #' Determine if range of vector is close to zero, with a specified tolerance #' #' The machine epsilon is the difference between 1.0 and the next number #' that can be represented by the machine. By default, this function #' uses epsilon * 100 as the tolerance. First it scales the values so that #' they have a mean of 1, and then it checks if the difference between #' them is larger than the tolerance. #' #' @examples #' eps <- .Machine$double.eps #' zero_range(c(1, 1 + eps)) # TRUE #' zero_range(c(1, 1 + 99 * eps)) # TRUE #' zero_range(c(1, 1 + 101 * eps)) # FALSE - Crossed the tol threshold #' zero_range(c(1, 1 + 2 * eps), tol = eps) # FALSE - Changed tol #' #' # Scaling up or down all the values has no effect since the values #' # are rescaled to 1 before checking against tol #' zero_range(100000 * c(1, 1 + eps)) # TRUE #' zero_range(100000 * c(1, 1 + 200 * eps)) # FALSE #' zero_range(.00001 * c(1, 1 + eps)) # TRUE #' zero_range(.00001 * c(1, 1 + 200 * eps)) # FALSE #' #' # NA values #' zero_range(c(1, NA)) # NA #' zero_range(c(1, NaN)) # NA #' #' # Infinite values #' zero_range(c(1, Inf)) # FALSE #' zero_range(c(-Inf, Inf)) # FALSE #' zero_range(c(Inf, Inf)) # TRUE #' #' @export #' @param x numeric range: vector of length 2 #' @param tol A value specifying the tolerance. Defaults to #' \code{.Machine$double.eps * 100}. #' @return logical \code{TRUE} if the relative difference of the endpoints of #' the range are not distinguishable from 0. zero_range <- function(x, tol = .Machine$double.eps * 100) { if (length(x) == 1) return(TRUE) if (length(x) != 2) stop("x must be length 1 or 2") if (any(is.na(x))) return(NA) # Special case: if they are equal as determined by ==, then there # is zero range. Also handles (Inf, Inf) and (-Inf, -Inf) if (x[1] == x[2]) return(TRUE) # If we reach this, then x must be (-Inf, Inf) or (Inf, -Inf) if (all(is.infinite(x))) return(FALSE) # Take the smaller (in magnitude) value of x, and use it as the scaling # factor. m <- min(abs(x)) # If we get here, then exactly one of the x's is 0. Return FALSE if (m == 0) return(FALSE) # If x[1] - x[2] (scaled to 1) is smaller than tol, then return # TRUE; otherwise return FALSE abs((x[1] - x[2])/m) < tol } scales/NEWS0000644000176000001440000000645712057501575012276 0ustar ripleyusersVersion 0.2.3 ------------------------------------------------------------------------------ * `floor_time` calls `to_time`, but that function was moved into a function so it was no longer available in the scales namespace. Now `floor_time` has its own copy of that function. (Thanks to Stefan Novak) * Color palettes generated by `brewer_pal` no longer give warnings when fewer than 3 colors are requested. (Winston Chang) * `abs_area and `rescale_max` functions have been added, for scaling the area of points to be proportional to their value. These are used by `scale_size_area` in ggplot2. Version 0.2.2 ------------------------------------------------------------------------------ * `zero_range` has improved behaviour thanks to Brian Diggs. * `brewer_pal` complains if you give it an incorrect palette type. (Fixes #15, thanks to Jean-Olivier Irisson) * `shape_pal` warns if asked for more than 6 values. (Fixes #16, thanks to Jean-Olivier Irisson) * `time_trans` gains an optional argument `tz` to specify the time zone to use for the times. If not specified, it will be guess from the first input with a non-null time zone. * `date_trans` and `time_trans` now check that their inputs are of the correct type. This prevents ggplot2 scales from silently giving incorrect outputs when given incorrect inputs. * Change the default breaks algorithm for `cbreaks()` and `trans_new()`. Previously it was `pretty_breaks()`, and now it's `extended_breaks()`, which uses the `extended()` algorithm from the labeling package. * fixed namespace problem with `fullseq` Version 0.2.1 ------------------------------------------------------------------------------ * `suppressWarnings` from `train_continuous` so zero-row or all infinite data frames don't potentially cause problems. * check for zero-length colour in `gradient_n_pal` * added `extended_breaks` which implements an extension to Wilkinson's labelling approach, as implemented in the `labeling` package. This should generally produce nicer breaks than `pretty_breaks`. * `alpha` can now preserve existing alpha values if `alpha` is missing. * `log_breaks` always gives breaks evenly spaced on the log scale, never evenly spaced on the data scale. This will result in really bad breaks for some ranges (e.g 0.5-0.6), but you probably shouldn't be using log scales in that situation anyway. Version 0.2.0 ------------------------------------------------------------------------------ * `censor` and `squish` gain `only.finite` argument and default to operating only on finite values. This is needed for ggplot2, and reflects the use of Inf and -Inf as special values. * `bounds` functions now `force` evaluation of range to avoid bug with S3 method dispatch inside primitive functions (e.g. `[`) * Simplified algorithm for `discrete_range` that is robust to `stringsAsFactors` global option. Now, the order of a factor will only be preserved if the full factor is the first object seen, and all subsequent inputs are subsets of the levels of the original factor. * `scientific` ensures output is always in scientific format and off the specified number of significant digits. `comma` ensures output is never in scientific format. (Fixes #7) * Another tweak to `zero_range` to better detect when a range has zero length. (Fixes #6) scales/NAMESPACE0000644000176000001440000000321312055506613012775 0ustar ripleyusersS3method(fullseq,Date) S3method(fullseq,POSIXt) S3method(fullseq,numeric) S3method(print,trans) export(ContinuousRange) export(DiscreteRange) export(abs_area) export(alpha) export(area_pal) export(as.trans) export(asn_trans) export(atanh_trans) export(boxcox_trans) export(brewer_pal) export(cbreaks) export(censor) export(col2hcl) export(comma) export(comma_format) export(cscale) export(date_breaks) export(date_format) export(date_trans) export(dichromat_pal) export(discard) export(div_gradient_pal) export(dollar) export(dollar_format) export(dscale) export(exp_trans) export(expand_range) export(extended_breaks) export(format_format) export(fullseq) export(gradient_n_pal) export(grey_pal) export(hue_pal) export(identity_pal) export(identity_trans) export(is.trans) export(linetype_pal) export(log10_trans) export(log1p_trans) export(log2_trans) export(log_breaks) export(log_trans) export(logit_trans) export(manual_pal) export(math_format) export(muted) export(parse_format) export(percent) export(percent_format) export(pretty_breaks) export(probability_trans) export(probit_trans) export(reciprocal_trans) export(rescale) export(rescale_max) export(rescale_mid) export(rescale_none) export(rescale_pal) export(reverse_trans) export(scientific) export(scientific_format) export(seq_gradient_pal) export(shape_pal) export(show_col) export(sqrt_trans) export(squish) export(squish_infinite) export(time_trans) export(trans_breaks) export(trans_format) export(trans_new) export(trans_range) export(zero_range) import(RColorBrewer) import(munsell) import(plyr) import(stringr) importFrom(dichromat,colorschemes) importFrom(grDevices,hcl) importFrom(labeling,extended) scales/man/0000755000176000001440000000000012057501623012330 5ustar ripleyusersscales/man/zero_range.Rd0000644000176000001440000000301612055506613014754 0ustar ripleyusers\name{zero_range} \alias{zero_range} \title{Determine if range of vector is close to zero, with a specified tolerance} \usage{ zero_range(x, tol = .Machine$double.eps * 100) } \arguments{ \item{x}{numeric range: vector of length 2} \item{tol}{A value specifying the tolerance. Defaults to \code{.Machine$double.eps * 100}.} } \value{ logical \code{TRUE} if the relative difference of the endpoints of the range are not distinguishable from 0. } \description{ The machine epsilon is the difference between 1.0 and the next number that can be represented by the machine. By default, this function uses epsilon * 100 as the tolerance. First it scales the values so that they have a mean of 1, and then it checks if the difference between them is larger than the tolerance. } \examples{ eps <- .Machine$double.eps zero_range(c(1, 1 + eps)) # TRUE zero_range(c(1, 1 + 99 * eps)) # TRUE zero_range(c(1, 1 + 101 * eps)) # FALSE - Crossed the tol threshold zero_range(c(1, 1 + 2 * eps), tol = eps) # FALSE - Changed tol # Scaling up or down all the values has no effect since the values # are rescaled to 1 before checking against tol zero_range(100000 * c(1, 1 + eps)) # TRUE zero_range(100000 * c(1, 1 + 200 * eps)) # FALSE zero_range(.00001 * c(1, 1 + eps)) # TRUE zero_range(.00001 * c(1, 1 + 200 * eps)) # FALSE # NA values zero_range(c(1, NA)) # NA zero_range(c(1, NaN)) # NA # Infinite values zero_range(c(1, Inf)) # FALSE zero_range(c(-Inf, Inf)) # FALSE zero_range(c(Inf, Inf)) # TRUE } scales/man/trans_range.Rd0000644000176000001440000000056512004052403015115 0ustar ripleyusers\name{trans_range} \alias{trans_range} \title{Compute range of transformed values.} \usage{ trans_range(trans, x) } \arguments{ \item{trans}{a transformation object, or the name of a transformation object given as a string.} \item{x}{a numeric vector to compute the rande of} } \description{ Silently drops any ranges outside of the domain of \code{trans}. } scales/man/trans_new.Rd0000644000176000001440000000241212004052403014603 0ustar ripleyusers\name{trans_new} \alias{is.trans} \alias{trans} \alias{trans_new} \title{Create a new transformation object.} \usage{ trans_new(name, transform, inverse, breaks = extended_breaks(), format = format_format(), domain = c(-Inf, Inf)) } \arguments{ \item{name}{transformation name} \item{transform}{function, or name of function, that performs the transformation} \item{inverse}{function, or name of function, that performs the inverse of the transformation} \item{breaks}{default breaks function for this transformation. The breaks function is applied to the raw data.} \item{format}{default format for this transformation. The format is applied to breaks generated to the raw data.} \item{domain}{domain, as numeric vector of length 2, over which transformation is valued} } \description{ A transformation encapsulates a transformation and its inverse, as well as the information needed to create pleasing breaks and labels. The breaks function is applied on the transformed range of the range, and it's expected that the labels function will perform some kind of inverse tranformation on these breaks to give them labels that are meaningful on the original scale. } \seealso{ \Sexpr[results=rd,stage=build]{scales:::seealso_trans()} } scales/man/trans_format.Rd0000644000176000001440000000101512004052402015277 0ustar ripleyusers\name{trans_format} \alias{trans_format} \title{Format labels after transformation.} \usage{ trans_format(trans, format = scientific_format()) } \arguments{ \item{trans}{transformation to apply} \item{format}{additional formatter to apply after transformation} } \value{ a function with single paramater x, a numeric vector, that returns a character vector of list of expressions } \description{ Format labels after transformation. } \examples{ tf <- trans_format("log10", scientific_format()) tf(10 ^ 1:6) } scales/man/trans_breaks.Rd0000644000176000001440000000130712004052402015262 0ustar ripleyusers\name{trans_breaks} \alias{trans_breaks} \title{Pretty breaks on transformed scale.} \usage{ trans_breaks(trans, inv, n = 5, ...) } \arguments{ \item{trans}{function of single variable, \code{x}, that given a numeric vector returns the transformed values} \item{inv}{inverse of the transformation function} \item{n}{desired number of ticks} \item{...}{other arguments passed on to pretty} } \description{ These often do not produce very attractive breaks. } \examples{ trans_breaks("log10", function(x) 10 ^ x)(c(1, 1e6)) trans_breaks("sqrt", function(x) x ^ 2)(c(1, 100)) trans_breaks(function(x) 1 / x, function(x) 1 / x)(c(1, 100)) trans_breaks(function(x) -x, function(x) -x)(c(1, 100)) } scales/man/time_trans.Rd0000644000176000001440000000100412004052403014744 0ustar ripleyusers\name{time_trans} \alias{time_trans} \title{Transformation for times (class POSIXt).} \usage{ time_trans(tz = NULL) } \arguments{ \item{tz}{Optionally supply the time zone. If \code{NULL}, the default, the time zone will be extracted from first input with a non-null tz.} } \description{ Transformation for times (class POSIXt). } \examples{ hours <- seq(ISOdate(2000,3,20, tz = ""), by = "hour", length.out = 10) t <- time_trans() t$trans(hours) t$inv(t$trans(hours)) t$format(t$breaks(range(hours))) } scales/man/squish_infinite.Rd0000644000176000001440000000060312004052402016003 0ustar ripleyusers\name{squish_infinite} \alias{squish_infinite} \title{Squish infinite values to range.} \usage{ squish_infinite(x, range = c(0, 1)) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{range}{numeric vector of length two giving desired output range.} } \description{ Squish infinite values to range. } \examples{ squish_infinite(c(-Inf, -1, 0, 1, 2, Inf)) } scales/man/squish.Rd0000644000176000001440000000100612004052402014114 0ustar ripleyusers\name{squish} \alias{squish} \title{Squish values into range.} \usage{ squish(x, range = c(0, 1), only.finite = TRUE) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{range}{numeric vector of length two giving desired output range.} \item{only.finite}{if \code{TRUE} (the default), will only modify finite values.} } \description{ Squish values into range. } \examples{ squish(c(-1, 0.5, 1, 2, NA)) squish(c(-1, 0, 0.5, 1, 2)) } \author{ Homer Strong } scales/man/sqrt_trans.Rd0000644000176000001440000000022112004052403014777 0ustar ripleyusers\name{sqrt_trans} \alias{sqrt_trans} \title{Square-root transformation.} \usage{ sqrt_trans() } \description{ Square-root transformation. } scales/man/show_col.Rd0000644000176000001440000000032712004052402014422 0ustar ripleyusers\name{show_col} \alias{show_col} \title{Show colours.} \usage{ show_col(colours) } \arguments{ \item{colours}{a character vector of colours} } \description{ A quick and dirty way to show colours in a plot. } scales/man/shape_pal.Rd0000644000176000001440000000032312004052403014536 0ustar ripleyusers\name{shape_pal} \alias{shape_pal} \title{Shape palette (discrete).} \usage{ shape_pal(solid = TRUE) } \arguments{ \item{solid}{should shapes be solid or not?} } \description{ Shape palette (discrete). } scales/man/seq_gradient_pal.Rd0000644000176000001440000000126212004052402016105 0ustar ripleyusers\name{seq_gradient_pal} \alias{seq_gradient_pal} \title{Sequential colour gradient palette (continous).} \usage{ seq_gradient_pal(low = mnsl("10B 4/6"), high = mnsl("10R 4/6"), space = "Lab") } \arguments{ \item{low}{colour for low end of gradient.} \item{high}{colour for high end of gradient.} \item{space}{colour space in which to calculate gradient. "Lab" usually best unless gradient goes through white.} } \description{ Sequential colour gradient palette (continous). } \examples{ x <- seq(0, 1, length = 25) show_col(seq_gradient_pal()(x)) show_col(seq_gradient_pal("white", "black")(x)) library(munsell) show_col(seq_gradient_pal("white", mnsl("10R 4/6"))(x)) } scales/man/scientific_format.Rd0000644000176000001440000000125112004052402016272 0ustar ripleyusers\name{scientific_format} \alias{scientific} \alias{scientific_format} \title{Scientific formatter.} \usage{ scientific_format(digits = 3, ...) scientific(x, digits = 3, ...) } \arguments{ \item{digits}{number of significant digits to show} \item{...}{other arguments passed on to \code{\link{format}}} \item{x}{a numeric vector to format} } \value{ a function with single paramater x, a numeric vector, that returns a character vector } \description{ Scientific formatter. } \examples{ scientific_format()(1:10) scientific_format()(runif(10)) scientific_format(digits = 2)(runif(10)) scientific(1:10) scientific(runif(10)) scientific(runif(10), digits = 2) } scales/man/reverse_trans.Rd0000644000176000001440000000022212004052403015462 0ustar ripleyusers\name{reverse_trans} \alias{reverse_trans} \title{Reverse transformation.} \usage{ reverse_trans() } \description{ Reverse transformation. } scales/man/rescale_pal.Rd0000644000176000001440000000055712004052403015065 0ustar ripleyusers\name{rescale_pal} \alias{rescale_pal} \title{Rescale palette (continuous).} \usage{ rescale_pal(range = c(0.1, 1)) } \arguments{ \item{range}{Numeric vector of length two, giving range of possible values. Should be between 0 and 1.} } \description{ Just rescales the input to the specific output range. Useful for alpha, size, and continuous position. } scales/man/rescale_none.Rd0000644000176000001440000000044112004052402015237 0ustar ripleyusers\name{rescale_none} \alias{rescale_none} \title{Don't peform rescaling} \usage{ rescale_none(x, ...) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{...}{all other arguments ignored} } \description{ Don't peform rescaling } \examples{ rescale_none(1:100) } scales/man/rescale_mid.Rd0000644000176000001440000000124112004052402015050 0ustar ripleyusers\name{rescale_mid} \alias{rescale_mid} \title{Rescale numeric vector to have specified minimum, midpoint, and maximum.} \usage{ rescale_mid(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{to}{output range (numeric vector of length two)} \item{from}{input range (numeric vector of length two). If not given, is calculated from the range of \code{x}} \item{mid}{mid-point of input range} } \description{ Rescale numeric vector to have specified minimum, midpoint, and maximum. } \examples{ rescale_mid(1:100, mid = 50.5) rescale_mid(runif(50), mid = 0.5) rescale_mid(1) } scales/man/rescale_max.Rd0000644000176000001440000000105112055506613015101 0ustar ripleyusers\name{rescale_max} \alias{rescale_max} \title{Rescale numeric vector to have specified maximum.} \usage{ rescale_max(x, to = c(0, 1), from = range(x, na.rm = TRUE)) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{to}{output range (numeric vector of length two)} \item{from}{input range (numeric vector of length two). If not given, is calculated from the range of \code{x}} } \description{ Rescale numeric vector to have specified maximum. } \examples{ rescale_max(1:100) rescale_max(runif(50)) rescale_max(1) } scales/man/rescale.Rd0000644000176000001440000000106712004052402014225 0ustar ripleyusers\name{rescale} \alias{rescale} \title{Rescale numeric vector to have specified minimum and maximum.} \usage{ rescale(x, to = c(0, 1), from = range(x, na.rm = TRUE)) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{to}{output range (numeric vector of length two)} \item{from}{input range (numeric vector of length two). If not given, is calculated from the range of \code{x}} } \description{ Rescale numeric vector to have specified minimum and maximum. } \examples{ rescale(1:100) rescale(runif(50)) rescale(1) } \keyword{manip} scales/man/reciprocal_trans.Rd0000644000176000001440000000024112004052403016133 0ustar ripleyusers\name{reciprocal_trans} \alias{reciprocal_trans} \title{Reciprocal transformation.} \usage{ reciprocal_trans() } \description{ Reciprocal transformation. } scales/man/Range.Rd0000644000176000001440000000040212004052403013634 0ustar ripleyusers\name{Range} \alias{ContinuousRange} \alias{DiscreteRange} \alias{Range} \title{Mutable ranges.} \description{ Mutable ranges have a two methods (\code{train} and \code{reset}), and make it possible to build up complete ranges with multiple passes. } scales/man/probability_trans.Rd0000644000176000001440000000102312004052403016327 0ustar ripleyusers\name{probability_trans} \alias{logit_trans} \alias{probability_trans} \alias{probit_trans} \title{Probability transformation.} \usage{ probability_trans(distribution, ...) } \arguments{ \item{distribution}{probability distribution. Should be standard R abbreviation so that "p" + distribution is a valid probability density function, and "q" + distribution is a valid quantile function.} \item{...}{other arguments passed on to distribution and quantile functions} } \description{ Probability transformation. } scales/man/pretty_breaks.Rd0000644000176000001440000000107212004052402015461 0ustar ripleyusers\name{pretty_breaks} \alias{pretty_breaks} \title{Pretty breaks. Uses default R break algorithm as implemented in \code{\link{pretty}}.} \usage{ pretty_breaks(n = 5, ...) } \arguments{ \item{n}{desired number of breaks} \item{...}{other arguments passed on to \code{\link{pretty}}} } \description{ Pretty breaks. Uses default R break algorithm as implemented in \code{\link{pretty}}. } \examples{ pretty_breaks()(1:10) pretty_breaks()(1:100) pretty_breaks()(as.Date(c("2008-01-01", "2009-01-01"))) pretty_breaks()(as.Date(c("2008-01-01", "2090-01-01"))) } scales/man/percent_format.Rd0000644000176000001440000000077612004052402015625 0ustar ripleyusers\name{percent_format} \alias{percent} \alias{percent_format} \title{Percent formatter: multiply by one hundred and display percent sign.} \usage{ percent_format() percent(x) } \arguments{ \item{x}{a numeric vector to format} } \value{ a function with single paramater x, a numeric vector, that returns a character vector } \description{ Percent formatter: multiply by one hundred and display percent sign. } \examples{ percent_format()(runif(10)) percent(runif(10)) percent(runif(10, 1, 10)) } scales/man/parse_format.Rd0000644000176000001440000000062612004052402015271 0ustar ripleyusers\name{parse_format} \alias{parse_format} \title{Parse a text label to produce expressions for plotmath.} \usage{ parse_format() } \value{ a function with single paramater x, a character vector, that returns a list of expressions } \description{ Parse a text label to produce expressions for plotmath. } \examples{ parse_format()(c("alpha", "beta", "gamma")) } \seealso{ \code{\link{plotmath}} } scales/man/package-scales.Rd0000644000176000001440000000030212004052403015442 0ustar ripleyusers\docType{package} \name{package-scales} \alias{package-scales} \alias{package-scales-package} \alias{scales} \title{Generic plot scaling methods} \description{ Generic plot scaling methods } scales/man/muted.Rd0000644000176000001440000000054412004052402013724 0ustar ripleyusers\name{muted} \alias{muted} \title{Mute standard colour.} \usage{ muted(colour, l = 30, c = 70) } \arguments{ \item{colour}{character vector of colours to modify} \item{l}{new luminance} \item{c}{new chroma} } \description{ Mute standard colour. } \examples{ muted("red") muted("blue") show_col(c("red", "blue", muted("red"), muted("blue"))) } scales/man/math_format.Rd0000644000176000001440000000147112004052402015107 0ustar ripleyusers\name{math_format} \alias{math_format} \title{Add arbitrary expression to a label. The symbol that will be replace by the label value is \code{.x}.} \usage{ math_format(expr = 10^.x, format = force) } \arguments{ \item{expr}{expression to use} \item{format}{another format function to apply prior to mathematical transformation - this makes it easier to use floating point numbers in mathematical expressions.} } \value{ a function with single paramater x, a numeric vector, that returns a list of expressions } \description{ Add arbitrary expression to a label. The symbol that will be replace by the label value is \code{.x}. } \examples{ math_format()(1:10) math_format(alpha + frac(1, .x))(1:10) math_format()(runif(10)) math_format(format = percent)(runif(10)) } \seealso{ \code{\link{plotmath}} } scales/man/manual_pal.Rd0000644000176000001440000000033212004052402014712 0ustar ripleyusers\name{manual_pal} \alias{manual_pal} \title{Manual palette (manual).} \usage{ manual_pal(values) } \arguments{ \item{values}{vector of values to be used as a palette.} } \description{ Manual palette (manual). } scales/man/log_trans.Rd0000644000176000001440000000034112004052403014572 0ustar ripleyusers\name{log_trans} \alias{log10_trans} \alias{log2_trans} \alias{log_trans} \title{Log transformation.} \usage{ log_trans(base = exp(1)) } \arguments{ \item{base}{base of logarithm} } \description{ Log transformation. } scales/man/log_breaks.Rd0000644000176000001440000000056012004052402014714 0ustar ripleyusers\name{log_breaks} \alias{log_breaks} \title{Log breaks (integer breaks on log-transformed scales).} \usage{ log_breaks(n = 5, base = 10) } \arguments{ \item{n}{desired number of breaks} \item{base}{base of logarithm to use} } \description{ Log breaks (integer breaks on log-transformed scales). } \examples{ log_breaks()(c(1, 1e6)) log_breaks()(c(1, 1e5)) } scales/man/log1p_trans.Rd0000644000176000001440000000022612004052403015035 0ustar ripleyusers\name{log1p_trans} \alias{log1p_trans} \title{Log plus one transformation.} \usage{ log1p_trans() } \description{ Log plus one transformation. } scales/man/linetype_pal.Rd0000644000176000001440000000030412004052402015265 0ustar ripleyusers\name{linetype_pal} \alias{linetype_pal} \title{Line type palette (discrete).} \usage{ linetype_pal() } \description{ Based on a set supplied by Richard Pearson, University of Manchester } scales/man/identity_trans.Rd0000644000176000001440000000026112004052403015643 0ustar ripleyusers\name{identity_trans} \alias{identity_trans} \title{Identity transformation (do nothing).} \usage{ identity_trans() } \description{ Identity transformation (do nothing). } scales/man/identity_pal.Rd0000644000176000001440000000026512004052402015273 0ustar ripleyusers\name{identity_pal} \alias{identity_pal} \title{Identity palette.} \usage{ identity_pal() } \description{ Leaves values unchanged - useful when the data is already scaled. } scales/man/hue_pal.Rd0000644000176000001440000000155112004052402014222 0ustar ripleyusers\name{hue_pal} \alias{hue_pal} \title{Hue palette (discrete).} \usage{ hue_pal(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1) } \arguments{ \item{h}{range of hues to use, in [0, 360]} \item{l}{luminance (lightness), in [0, 100]} \item{c}{chroma (intensity of colour), maximum value varies depending on} \item{h.start}{hue to start at} \item{direction}{direction to travel around the colour wheel, 1 = clockwise, -1 = counter-clockwise} } \description{ Hue palette (discrete). } \examples{ show_col(hue_pal()(4)) show_col(hue_pal()(9)) show_col(hue_pal(l = 90)(9)) show_col(hue_pal(l = 30)(9)) show_col(hue_pal()(9)) show_col(hue_pal(direction = -1)(9)) show_col(hue_pal()(9)) show_col(hue_pal(h = c(0, 90))(9)) show_col(hue_pal(h = c(90, 180))(9)) show_col(hue_pal(h = c(180, 270))(9)) show_col(hue_pal(h = c(270, 360))(9)) } scales/man/grey_pal.Rd0000644000176000001440000000063612004052402014412 0ustar ripleyusers\name{grey_pal} \alias{grey_pal} \title{Grey scale palette (discrete).} \usage{ grey_pal(start = 0.2, end = 0.8) } \arguments{ \item{start}{gray value at low end of palette} \item{end}{gray value at high end of palette} } \description{ Grey scale palette (discrete). } \examples{ show_col(grey_pal()(25)) show_col(grey_pal(0, 1)(25)) } \seealso{ \code{\link{seq_gradient_pal}} for continuous version } scales/man/gradient_n_pal.Rd0000644000176000001440000000125112004052402015550 0ustar ripleyusers\name{gradient_n_pal} \alias{gradient_n_pal} \title{Arbitrary colour gradient palette (continous).} \usage{ gradient_n_pal(colours, values = NULL, space = "Lab") } \arguments{ \item{colours}{vector of colours} \item{values}{if colours should not be evenly positioned along the gradient this vector gives the position (between 0 and 1) for each colour in the \code{colours} vector. See \code{\link{rescale}} for a convience function to map an arbitrary range to between 0 and 1.} \item{space}{colour space in which to calculate gradient. "Lab" usually best unless gradient goes through white.} } \description{ Arbitrary colour gradient palette (continous). } scales/man/fullseq.Rd0000644000176000001440000000061112004052402014254 0ustar ripleyusers\name{fullseq} \alias{fullseq} \title{Generate sequence of fixed size intervals covering range.} \usage{ fullseq(range, size, ...) } \arguments{ \item{range}{range} \item{size}{interval size} \item{...}{other arguments passed on to methods} } \description{ Generate sequence of fixed size intervals covering range. } \seealso{ \code{\link[plyr]{round_any}} } \keyword{internal} scales/man/format_format.Rd0000644000176000001440000000064312004052402015446 0ustar ripleyusers\name{format_format} \alias{format_format} \title{Format with using any arguments to \code{\link{format}}.} \usage{ format_format(...) } \arguments{ \item{...}{other arguments passed on to \code{\link{format}}.} } \description{ If the breaks have names, they will be used in preference to formatting the breaks. } \seealso{ \code{\link{format}}, \code{\link{format.Date}}, \code{\link{format.POSIXct}} } scales/man/extended_breaks.Rd0000644000176000001440000000123712004052402015735 0ustar ripleyusers\name{extended_breaks} \alias{extended_breaks} \title{Extended breaks. Uses Wilkinson's extended breaks algorithm as implemented in the \pkg{labeling} package.} \usage{ extended_breaks(n = 5, ...) } \arguments{ \item{n}{desired number of breaks} \item{...}{other arguments passed on to \code{\link[labeling]{extended}}} } \description{ Extended breaks. Uses Wilkinson's extended breaks algorithm as implemented in the \pkg{labeling} package. } \examples{ extended_breaks()(1:10) extended_breaks()(1:100) } \references{ Talbot, J., Lin, S., Hanrahan, P. (2010) An Extension of Wilkinson's Algorithm for Positioning Tick Labels on Axes, InfoVis 2010. } scales/man/expand_range.Rd0000644000176000001440000000071712004052402015243 0ustar ripleyusers\name{expand_range} \alias{expand_range} \title{Expand a range with a multiplicative or additive constant.} \usage{ expand_range(range, mul = 0, add = 0, zero_width = 1) } \arguments{ \item{range}{range of data, numeric vector of length 2} \item{mul}{multiplicative constract} \item{add}{additive constant} \item{zero_width}{distance to use if range has zero width} } \description{ Expand a range with a multiplicative or additive constant. } scales/man/exp_trans.Rd0000644000176000001440000000041412004052403014606 0ustar ripleyusers\name{exp_trans} \alias{exp_trans} \title{Exponential transformation (inverse of log transformation).} \usage{ exp_trans(base = exp(1)) } \arguments{ \item{base}{Base of logarithm} } \description{ Exponential transformation (inverse of log transformation). } scales/man/dscale.Rd0000644000176000001440000000062012004052403014035 0ustar ripleyusers\name{dscale} \alias{dscale} \title{Discrete scale.} \usage{ dscale(x, palette, na.value = NA) } \arguments{ \item{x}{vector of discrete values to scale} \item{palette}{aesthetic palette to use} \item{na.value}{aesthetic to use for missing values} } \description{ Discrete scale. } \examples{ with(mtcars, plot(disp, mpg, pch = 20, cex = 3, col = dscale(factor(cyl), brewer_pal()))) } scales/man/dollar_format.Rd0000644000176000001440000000164412004052402015435 0ustar ripleyusers\name{dollar_format} \alias{dollar} \alias{dollar_format} \title{Currency formatter: round to nearest cent and display dollar sign.} \usage{ dollar_format(largest_with_cents = 1e+05) dollar(x) } \arguments{ \item{largest_with_cents}{the value that all values of \code{x} must be less than in order for the cents to be displayed} \item{x}{a numeric vector to format} } \value{ a function with single paramater x, a numeric vector, that returns a character vector } \description{ The returned function will format a vector of values as currency. Values are rounded to the nearest cent, and cents are displayed if any of the values has a non-zero cents and the largest value is less than \code{largest_with_cents} which by default is 100000. } \examples{ dollar_format()(c(100, 0.23, 1.456565, 2e3)) dollar_format()(c(1:10 * 10)) dollar(c(100, 0.23, 1.456565, 2e3)) dollar(c(1:10 * 10)) dollar(10^(1:8)) } scales/man/div_gradient_pal.Rd0000644000176000001440000000162512004052402016102 0ustar ripleyusers\name{div_gradient_pal} \alias{div_gradient_pal} \title{Diverging colour gradient (continous).} \usage{ div_gradient_pal(low = mnsl("10B 4/6"), mid = mnsl("N 8/0"), high = mnsl("10R 4/6"), space = "Lab") } \arguments{ \item{low}{colour for low end of gradient.} \item{mid}{colour for mid point} \item{high}{colour for high end of gradient.} \item{space}{colour space in which to calculate gradient. "Lab" usually best unless gradient goes through white.} } \description{ Diverging colour gradient (continous). } \examples{ x <- seq(-1, 1, length = 100) r <- sqrt(outer(x^2, x^2, "+")) image(r, col = div_gradient_pal()(seq(0, 1, length = 12))) image(r, col = div_gradient_pal()(seq(0, 1, length = 30))) image(r, col = div_gradient_pal()(seq(0, 1, length = 100))) library(munsell) image(r, col = div_gradient_pal(low = mnsl(complement("10R 4/6", fix = TRUE)))(seq(0, 1, length = 100))) } scales/man/discard.Rd0000644000176000001440000000054612004052402014221 0ustar ripleyusers\name{discard} \alias{discard} \title{Discard any values outside of range.} \usage{ discard(x, range = c(0, 1)) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{range}{numeric vector of length two giving desired output range.} } \description{ Discard any values outside of range. } \examples{ discard(c(-1, 0.5, 1, 2, NA)) } scales/man/dichromat_pal.Rd0000644000176000001440000000110612004052402015407 0ustar ripleyusers\name{dichromat_pal} \alias{dichromat_pal} \title{Dichromat (colour-blind) palette (discrete).} \usage{ dichromat_pal(name) } \arguments{ \item{name}{Name of colour palette. One of: \Sexpr[results=rd,stage=build]{scales:::dichromat_schemes()}} } \description{ Dichromat (colour-blind) palette (discrete). } \examples{ show_col(dichromat_pal("BluetoOrange.10")(10)) show_col(dichromat_pal("BluetoOrange.10")(5)) # Can use with gradient_n to create a continous gradient cols <- dichromat_pal("DarkRedtoBlue.12")(12) show_col(gradient_n_pal(cols)(seq(0, 1, length = 30))) } scales/man/date_trans.Rd0000644000176000001440000000051412004052403014730 0ustar ripleyusers\name{date_trans} \alias{date_trans} \title{Transformation for dates (class Date).} \usage{ date_trans() } \description{ Transformation for dates (class Date). } \examples{ years <- seq(as.Date("1910/1/1"), as.Date("1999/1/1"), "years") t <- date_trans() t$trans(years) t$inv(t$trans(years)) t$format(t$breaks(range(years))) } scales/man/date_format.Rd0000644000176000001440000000043112004052403015067 0ustar ripleyusers\name{date_format} \alias{date_format} \title{Formatted dates.} \usage{ date_format(format = "\%Y-\%m-\%d") } \arguments{ \item{format}{Date format using standard POSIX specification. See \code{\link{strptime}} for possible formats.} } \description{ Formatted dates. } scales/man/date_breaks.Rd0000644000176000001440000000051512004052403015051 0ustar ripleyusers\name{date_breaks} \alias{date_breaks} \title{Regularly spaced dates.} \usage{ date_breaks(width = "1 month") } \arguments{ \item{width}{an interval specification, one of "sec", "min", "hour", "day", "week", "month", "year". Can be by an integer and a space, or followed by "s".} } \description{ Regularly spaced dates. } scales/man/cscale.Rd0000644000176000001440000000175112055506613014057 0ustar ripleyusers\name{cscale} \alias{cscale} \title{Continuous scale.} \usage{ cscale(x, palette, na.value = NA_real_, trans = identity_trans()) } \arguments{ \item{x}{vector of continuous values to scale} \item{palette}{palette to use. Built in palettes: \Sexpr[results=rd,stage=build]{scales:::seealso_pal()}} \item{na.value}{value to use for missing values} \item{trans}{transformation object describing the how to transform the raw data prior to scaling. Defaults to the identity transformation which leaves the data unchanged. Built in transformations: \Sexpr[results=rd,stage=build]{scales:::seealso_trans()}.} } \description{ Continuous scale. } \examples{ with(mtcars, plot(disp, mpg, cex = cscale(hp, rescale_pal()))) with(mtcars, plot(disp, mpg, cex = cscale(hp, rescale_pal(), trans = sqrt_trans()))) with(mtcars, plot(disp, mpg, cex = cscale(hp, area_pal()))) with(mtcars, plot(disp, mpg, pch = 20, cex = 5, col = cscale(hp, seq_gradient_pal("grey80", "black")))) } scales/man/comma_format.Rd0000644000176000001440000000113612004052402015250 0ustar ripleyusers\name{comma_format} \alias{comma} \alias{comma_format} \title{Comma formatter: format number with commas separating thousands.} \usage{ comma_format(...) comma(x, ...) } \arguments{ \item{...}{other arguments passed on to \code{\link{format}}} \item{x}{a numeric vector to format} } \value{ a function with single paramater x, a numeric vector, that returns a character vector } \description{ Comma formatter: format number with commas separating thousands. } \examples{ comma_format()(c(1, 1e3, 2000, 1e6)) comma_format(digits = 9)(c(1, 1e3, 2000, 1e6)) comma(c(1, 1e3, 2000, 1e6)) } scales/man/col2hcl.Rd0000644000176000001440000000071312004052402014132 0ustar ripleyusers\name{col2hcl} \alias{col2hcl} \title{Modify standard R colour in hcl colour space.} \usage{ col2hcl(colour, h, c, l, alpha = 1) } \arguments{ \item{colour}{character vector of colours to be modified} \item{h}{new hue} \item{l}{new luminance} \item{c}{new chroma} \item{alpha}{alpha value. Defaults to 1.} } \description{ Transforms rgb to hcl, sets non-missing arguments and then backtransforms to rgb. } \examples{ col2hcl(colors()) } scales/man/censor.Rd0000644000176000001440000000071312004052402014075 0ustar ripleyusers\name{censor} \alias{censor} \title{Censor any values outside of range.} \usage{ censor(x, range = c(0, 1), only.finite = TRUE) } \arguments{ \item{x}{numeric vector of values to manipulate.} \item{range}{numeric vector of length two giving desired output range.} \item{only.finite}{if \code{TRUE} (the default), will only modify finite values.} } \description{ Censor any values outside of range. } \examples{ censor(c(-1, 0.5, 1, 2, NA)) } scales/man/cbreaks.Rd0000644000176000001440000000277612004052402014231 0ustar ripleyusers\name{cbreaks} \alias{cbreaks} \title{Compute breaks for continuous scale.} \usage{ cbreaks(range, breaks = extended_breaks(), labels = scientific_format()) } \arguments{ \item{range}{numeric vector of length 2 giving the range of the underlying data} \item{breaks}{either a vector of break values, or a break function that will make a vector of breaks when given the range of the data} \item{labels}{either a vector of labels (character vector or list of expression) or a format function that will make a vector of labels when called with a vector of breaks. Labels can only be specified manually if breaks are - it is extremely dangerous to supply labels if you don't know what the breaks will be.} } \description{ This function wraps up the components needed to go from a continuous range to a set of breaks and labels suitable for display on axes or legends. } \examples{ cbreaks(c(0, 100)) cbreaks(c(0, 100), pretty_breaks(3)) cbreaks(c(0, 100), pretty_breaks(10)) cbreaks(c(1, 100), log_breaks()) cbreaks(c(1, 1e4), log_breaks()) cbreaks(c(0, 100), labels = math_format()) cbreaks(c(0, 1), labels = percent_format()) cbreaks(c(0, 1e6), labels = comma_format()) cbreaks(c(0, 1e6), labels = dollar_format()) cbreaks(c(0, 30), labels = dollar_format()) # You can also specify them manually: cbreaks(c(0, 100), breaks = c(15, 20, 80)) cbreaks(c(0, 100), breaks = c(15, 20, 80), labels = c(1.5, 2.0, 8.0)) cbreaks(c(0, 100), breaks = c(15, 20, 80), labels = expression(alpha, beta, gamma)) } scales/man/brewer_pal.Rd0000644000176000001440000000131412004052402014724 0ustar ripleyusers\name{brewer_pal} \alias{brewer_pal} \title{Color Brewer palette (discrete).} \usage{ brewer_pal(type = "seq", palette = 1) } \arguments{ \item{type}{One of seq (sequential), div (diverging) or qual (qualitative)} \item{palette}{If a string, will use that named palette. If a number, will index into the list of palettes of appropriate \code{type}} } \description{ Color Brewer palette (discrete). } \examples{ show_col(brewer_pal()(10)) show_col(brewer_pal("div")(5)) show_col(brewer_pal(pal = "Greens")(5)) # Can use with gradient_n to create a continous gradient cols <- brewer_pal("div")(5) show_col(gradient_n_pal(cols)(seq(0, 1, length = 30))) } \references{ \url{http://colorbrewer2.org} } scales/man/boxcox_trans.Rd0000644000176000001440000000044712004052403015322 0ustar ripleyusers\name{boxcox_trans} \alias{boxcox_trans} \title{Box-Cox power transformation.} \usage{ boxcox_trans(p) } \arguments{ \item{p}{Exponent of boxcox transformation.} } \description{ Box-Cox power transformation. } \references{ See \url{http://en.wikipedia.org/wiki/Power_transform} for } scales/man/atanh_trans.Rd0000644000176000001440000000022412004052403015104 0ustar ripleyusers\name{atanh_trans} \alias{atanh_trans} \title{Arc-tangent transformation.} \usage{ atanh_trans() } \description{ Arc-tangent transformation. } scales/man/asn_trans.Rd0000644000176000001440000000023612004052403014575 0ustar ripleyusers\name{asn_trans} \alias{asn_trans} \title{Arc-sin square root transformation.} \usage{ asn_trans() } \description{ Arc-sin square root transformation. } scales/man/as.trans.Rd0000644000176000001440000000032412004052403014334 0ustar ripleyusers\name{as.trans} \alias{as.trans} \title{Convert character string to transformer.} \usage{ as.trans(x) } \arguments{ \item{x}{name of transformer} } \description{ Convert character string to transformer. } scales/man/area_pal.Rd0000644000176000001440000000043512004052402014351 0ustar ripleyusers\name{area_pal} \alias{area_pal} \title{Point area palette (continuous).} \usage{ area_pal(range = c(1, 6)) } \arguments{ \item{range}{Numeric vector of length two, giving range of possible sizes. Should be greater than 0.} } \description{ Point area palette (continuous). } scales/man/alpha.Rd0000644000176000001440000000071212004052402013670 0ustar ripleyusers\name{alpha} \alias{alpha} \title{Modify colour transparency. Vectorised in both colour and alpha.} \usage{ alpha(colour, alpha = NA) } \arguments{ \item{colour}{colour} \item{alpha}{new alpha level in [0,1]. If alpha is \code{NA}, existing alpha values are preserved.} } \description{ Modify colour transparency. Vectorised in both colour and alpha. } \examples{ alpha("red", 0.1) alpha(colours(), 0.5) alpha("red", seq(0, 1, length = 10)) } scales/man/abs_area.Rd0000644000176000001440000000044112055506613014355 0ustar ripleyusers\name{abs_area} \alias{abs_area} \title{Point area palette (continuous), with area proportional to value.} \usage{ abs_area(max) } \arguments{ \item{max}{A number representing the maxmimum size.} } \description{ Point area palette (continuous), with area proportional to value. } scales/inst/0000755000176000001440000000000012057501623012532 5ustar ripleyusersscales/inst/tests/0000755000176000001440000000000012055506613013676 5ustar ripleyusersscales/inst/tests/test-zero-range.r0000644000176000001440000000431512002077633017107 0ustar ripleyuserscontext("Zero range") test_that("large numbers with small differences", { expect_false(zero_range(c(1330020857.8787, 1330020866.8787))) expect_true(zero_range(c(1330020857.8787, 1330020857.8787))) expect_true(zero_range(c(1330020857.8787, 1330020857.8787*(1+1e-20)))) }) test_that("small numbers with differences on order of values", { expect_false(zero_range(c(5.63e-147, 5.93e-123))) expect_false(zero_range(c(-7.254574e-11, 6.035387e-11))) expect_false(zero_range(c(-7.254574e-11, -6.035387e-11))) }) test_that("ranges with 0 endpoint(s)", { expect_false(zero_range(c(0,10))) expect_true(zero_range(c(0,0))) expect_false(zero_range(c(-10,0))) expect_false(zero_range(c(0,1)*1e-100)) expect_false(zero_range(c(0,1)*1e+100)) }) test_that("symmetric ranges", { expect_false(zero_range(c(-1,1))) expect_false(zero_range(c(-1,1*(1+1e-20)))) expect_false(zero_range(c(-1,1)*1e-100)) }) test_that("length 1 ranges", { expect_true(zero_range(c(1))) expect_true(zero_range(c(0))) expect_true(zero_range(c(1e100))) expect_true(zero_range(c(1e-100))) }) test_that("NA and Inf", { # Should return NA expect_true(is.na(zero_range(c(NA,NA)))) expect_true(is.na(zero_range(c(1,NA)))) expect_true(is.na(zero_range(c(1,NaN)))) # Not zero range expect_false(zero_range(c(1,Inf))) expect_false(zero_range(c(-Inf,Inf))) # Can't know if these are truly zero range expect_true(zero_range(c(Inf,Inf))) expect_true(zero_range(c(-Inf,-Inf))) }) test_that("Tolerance", { # By default, tolerance is 100 times this eps <- .Machine$double.eps expect_true(zero_range(c(1, 1 + eps))) expect_true(zero_range(c(1, 1 + 99 * eps))) # Cross the threshold expect_false(zero_range(c(1, 1 + 101 * eps))) expect_false(zero_range(c(1, 1 + 2 * eps), tol = eps)) # Scaling up or down all the values has no effect since the values # are rescaled to 1 before checking against tol expect_true(zero_range(100000 * c(1, 1 + eps))) expect_true(zero_range(.00001 * c(1, 1 + eps))) expect_true(zero_range(100000 * c(1, 1 + 99 * eps))) expect_true(zero_range(.00001 * c(1, 1 + 99 * eps))) expect_false(zero_range(100000 * c(1, 1 + 200 * eps))) expect_false(zero_range(.00001 * c(1, 1 + 200 * eps))) }) scales/inst/tests/test-trans.r0000644000176000001440000000040511666154730016172 0ustar ripleyuserscontext("Trans") test_that("Transformed ranges silently drop out-of-domain values", { r1 <- trans_range(log_trans(), -1:10) expect_that(r1, equals(log(c(1e-100, 10)))) r2 <- trans_range(sqrt_trans(), -1:10) expect_that(r2, equals(sqrt(c(0, 10)))) })scales/inst/tests/test-trans-date.r0000644000176000001440000000200011775336742017104 0ustar ripleyuserscontext("Trans - dates and times") a_time <- ISOdatetime(2012, 1, 1, 11, 30, 0, tz = "UTC") a_date <- as.Date(a_time) tz <- function(x) attr(as.POSIXlt(x), "tzone")[1] tz2 <- function(x) format(x, "%Z") with_tz <- function(x, value) { as.POSIXct(format(x, tz = value, usetz = TRUE), tz = value) } test_that("date/time scales raise error on incorrect inputs", { time <- time_trans() expect_error(time$trans(a_date), "Invalid input") date <- date_trans() expect_error(date$trans(a_time), "Invalid input") }) test_that("time scales learn timezones", { time <- time_trans() x <- time$inv(time$trans(a_time)) expect_equal(tz(x), "UTC") expect_equal(tz2(x), "UTC") time <- time_trans() x <- time$inv(time$trans(with_tz(a_time, "GMT"))) expect_equal(tz(x), "GMT") expect_equal(tz2(x), "GMT") }) test_that("tz arugment overrules default time zone", { time <- time_trans("GMT") x <- time$inv(time$trans(a_time)) expect_equal(tz(x), "GMT") expect_equal(tz2(x), "GMT") })scales/inst/tests/test-scale.r0000644000176000001440000000124611506705535016134 0ustar ripleyuserscontext("Scale") test_that("NA.value works for continuous scales", { x <- c(NA, seq(0, 1, length = 10), NA) pal <- rescale_pal() expect_that(cscale(x, pal)[1], equals(NA_real_)) expect_that(cscale(x, pal)[12], equals(NA_real_)) expect_that(cscale(x, pal, 5)[1], equals(5)) expect_that(cscale(x, pal, 5)[12], equals(5)) }) test_that("NA.value works for discrete", { x <- c(NA, "a", "b", "c", NA) pal <- brewer_pal() expect_that(dscale(x, pal)[1], equals(NA_character_)) expect_that(dscale(x, pal)[5], equals(NA_character_)) expect_that(dscale(x, pal, "grey50")[1], equals("grey50")) expect_that(dscale(x, pal, "grey50")[5], equals("grey50")) })scales/inst/tests/test-range.r0000644000176000001440000000257711673734075016157 0ustar ripleyuserscontext("Ranges") test_that("continuous ranges expands as expected", { r <- ContinuousRange$new() r$train(1) expect_equal(r$range, c(1, 1)) r$train(10) expect_equal(r$range, c(1, 10)) }) test_that("discrete ranges expands as expected", { r <- DiscreteRange$new() r$train("a") expect_equal(r$range, "a") r$train("b") expect_equal(r$range, c("a", "b")) r$train(letters) expect_equal(r$range, letters) }) test_that("starting with NULL always returns new", { expect_equal(discrete_range(NULL, 1:3), 1:3) expect_equal(discrete_range(NULL, 3:1), 1:3) expect_equal(discrete_range(NULL, c("a", "b", "c")), c("a", "b", "c")) expect_equal(discrete_range(NULL, c("c", "b", "a")), c("a", "b", "c")) f1 <- factor(letters[1:3], levels = letters[1:4]) expect_equal(discrete_range(NULL, f1, drop = FALSE), letters[1:4]) expect_equal(discrete_range(NULL, f1, drop = TRUE), letters[1:3]) f2 <- factor(letters[1:3], levels = letters[4:1]) expect_equal(discrete_range(NULL, f2, drop = FALSE), letters[4:1]) expect_equal(discrete_range(NULL, f2, drop = TRUE), letters[3:1]) }) test_that("factor discrete ranges stay in order", { f <- factor(letters[1:3], levels = letters[3:1]) expect_equal(discrete_range(f, f), letters[3:1]) expect_equal(discrete_range(f, "c"), letters[3:1]) expect_equal(discrete_range(f, c("a", "b", "c")), letters[3:1]) }) scales/inst/tests/test-formatter.r0000644000176000001440000000601711744305721017046 0ustar ripleyuserscontext("Formatters") test_that("comma format always adds commas", { expect_equal(comma(1e3), "1,000") expect_equal(comma(1e6), "1,000,000") expect_equal(comma(1e9), "1,000,000,000") }) test_that("scientific format shows specific sig figs", { expect_equal(scientific(123456, digits = 1), "1e+05") expect_equal(scientific(123456, digits = 2), "1.2e+05") expect_equal(scientific(123456, digits = 3), "1.23e+05") expect_equal(scientific(0.123456, digits = 1), "1e-01") expect_equal(scientific(0.123456, digits = 2), "1.2e-01") expect_equal(scientific(0.123456, digits = 3), "1.23e-01") }) test_that("dollar format", { expect_equal(dollar(c(100, 0.23, 1.456565, 2e3)), c("$100.00", "$0.23", "$1.46", "$2,000.00")) expect_equal(dollar(c(1:10 * 10)), c("$10", "$20", "$30", "$40", "$50", "$60", "$70", "$80", "$90", "$100")) expect_equal(dollar((1:10 * 10) + 0.01), c("$10.01", "$20.01", "$30.01", "$40.01", "$50.01", "$60.01", "$70.01", "$80.01", "$90.01", "$100.01")) expect_equal(dollar((1:10 * 10) + 0.001), c("$10", "$20", "$30", "$40", "$50", "$60", "$70", "$80", "$90", "$100")) expect_equal(dollar(10^(1:8)), c("$10", "$100", "$1,000", "$10,000", "$100,000", "$1,000,000", "$10,000,000", "$100,000,000")) expect_equal(dollar(seq(10111.11, 100000, 10111.11)), c("$10,111.11", "$20,222.22", "$30,333.33", "$40,444.44", "$50,555.55", "$60,666.66", "$70,777.77", "$80,888.88", "$90,999.99")) expect_equal(dollar(seq(101111.11, 1000000, 101111.11)), c("$101,111", "$202,222", "$303,333", "$404,444", "$505,556", "$606,667", "$707,778", "$808,889", "$910,000")) expect_equal(dollar(seq(101111, 1000000, 101111)), c("$101,111", "$202,222", "$303,333", "$404,444", "$505,555", "$606,666", "$707,777", "$808,888", "$909,999")) expect_equal(dollar(seq(10111111.11, 100000000, 10111111.11)), c("$10,111,111", "$20,222,222", "$30,333,333", "$40,444,444", "$50,555,556", "$60,666,667", "$70,777,778", "$80,888,889", "$91,000,000")) expect_equal(dollar((1:10) * 100000), c("$100,000", "$200,000", "$300,000", "$400,000", "$500,000", "$600,000", "$700,000", "$800,000", "$900,000", "$1,000,000")) expect_equal(dollar(((1:10) * 100000) + 0.01), c("$100,000", "$200,000", "$300,000", "$400,000", "$500,000", "$600,000", "$700,000", "$800,000", "$900,000", "$1,000,000")) expect_equal(dollar(c(9.999)), c("$10")) expect_equal(dollar(c(99.999)), c("$100")) }) test_that("formatters don't add extra spaces", { has_space <- function(x) any(grepl("\\s", x)) x <- 10 ^ c(-1, 0, 1, 3, 6, 9) expect_false(has_space(comma(x))) expect_false(has_space(dollar(x))) expect_false(has_space(percent(x))) expect_false(has_space(percent(x))) expect_false(has_space(scientific(x))) }) scales/inst/tests/test-breaks-log.r0000644000176000001440000000017611726426476017104 0ustar ripleyuserscontext("Breaks - log") test_that("Five ticks over 10^4 range work", { expect_equal(log_breaks()(10^(1:5)), 10 ^ (1:5)) })scales/inst/tests/test-bounds.r0000644000176000001440000000172412055506613016334 0ustar ripleyuserscontext("Bounds") test_that("rescale_mid returns correct results", { x <- c(-1, 0, 1) expect_equal(rescale_mid(x), c(0, 0.5, 1)) expect_equal(rescale_mid(x, mid = -1), c(0.5, 0.75, 1)) expect_equal(rescale_mid(x, mid = 1), c(0, 0.25, 0.5)) expect_equal(rescale_mid(x, mid = 1, to = c(0, 10)), c(0, 2.5, 5)) expect_equal(rescale_mid(x, mid = 1, to = c(8, 10)), c(8, 8.5, 9)) }) test_that("resacle_max returns correct results", { expect_equal(rescale_max(0), NaN) expect_equal(rescale_max(1), 1) expect_equal(rescale_max(.3), 1) expect_equal(rescale_max(c(4, 5)), c(0.8, 1.0)) expect_equal(rescale_max(c(-3, 0, -1, 2)), c(-1.5, 0, -0.5, 1)) }) test_that("zero range inputs return mid range", { expect_that(rescale(0), equals(0.5)) expect_that(rescale(c(0, 0)), equals(c(0.5, 0.5))) }) test_that("censor and squish ignore infinite values", { expect_equal(squish(c(1, Inf)), c(1, Inf)) expect_equal(censor(c(1, Inf)), c(1, Inf)) })scales/inst/tests/test-alpha.r0000644000176000001440000000144011744307162016124 0ustar ripleyuserscontext("Alpha") hex <- function(x) { rgb <- col2rgb(x, TRUE) / 255 rgb(rgb[1,], rgb[2,], rgb[3,], rgb[4, ]) } test_that("missing alpha preserves existing", { cols <- col2rgb(rep("red", 5), TRUE) / 255 cols[4, ] <- seq(0, 1, length = ncol(cols)) reds <- rgb(cols[1,], cols[2,], cols[3,], cols[4, ]) expect_equal(reds, alpha(reds, NA)) expect_equal(reds, alpha(reds, rep(NA, 5))) }) test_that("alpha values recycled to match colour", { cols <- hex(c("red", "green", "blue", "pink")) expect_equal(cols, alpha(cols, NA)) expect_equal(cols, alpha(cols, 1)) }) test_that("col values recycled to match alpha", { alphas <- round(seq(0, 255, length = 3)) reds <- alpha("red", alphas / 255) reds_alpha <- col2rgb(reds, TRUE)[4, ] expect_equal(alphas, reds_alpha) }) scales/DESCRIPTION0000644000176000001440000000201312057634772013273 0ustar ripleyusersPackage: scales Type: Package Title: Scale functions for graphics. Version: 0.2.3 Author: Hadley Wickham Maintainer: Hadley Wickham Description: Scales map data to aesthetics, and provide methods for automatically determining breaks and labels for axes and legends. Depends: R (>= 2.12), methods Imports: RColorBrewer, stringr, dichromat, munsell (>= 0.2), plyr (>= 1.2), labeling Suggests: testthat License: MIT LazyLoad: yes Collate: 'bounds.r' 'breaks.r' 'colour-manip.r' 'date-time.r' 'documentation.r' 'formatter.r' 'full-seq.r' 'pal-area.r' 'pal-brewer.r' 'pal-dichromat.r' 'pal-gradient.r' 'pal-grey.r' 'pal-hue.r' 'pal-identity.r' 'pal-linetype.r' 'pal-manual.r' 'pal-rescale.r' 'pal-shape.r' 'range.r' 'scale-continuous.r' 'scale-discrete.r' 'scales.r' 'trans-date.r' 'trans-numeric.r' 'trans.r' BuildManual: yes Packaged: 2012-12-04 23:13:23 UTC; hadley Repository: CRAN Date/Publication: 2012-12-05 13:11:38 scales/build/0000755000176000001440000000000012057501623012654 5ustar ripleyusersscales/build/partial.rdb0000644000176000001440000001432412057501623015005 0ustar ripleyusers{}w={u^xʘ?Nsswbw;YpJr;8!*!ɩTY,WɎ*U]I?=#ŮJd~=nzz{>_===D"HCw4Fb;mx(pF$qV<v$2A|@bеF<%wƗvZ|.RпX &5ykءb؟+Ҹ#(&4yGpӭq<+ 3(2],$O j-1!VXUùw3933lKB;7݌9~[^^ek!ǵS5m׮BU ajj6ʞ]ZՄDpQZ36"Eh,oM!E5\LZ5N5NZ`[7tҼ 74*zA&0XW3{u3Jft>R3' ŬFMĉ?kMU|;D+ h]ɤRHAI\-XxvЋe<[^sb~k{zTS՘=n$`tLእ`/tW>辐\@(wŜeR+i1zp7n=X1)7FG968!=N~0 i0Q/Ғx |I=8>gdC=$g o(wFH>.鉿CoA? >|HW1[^// %K!Y'Я*Dk 9_^ ^?߄~3$_ z_x'vgeۋ?P/?H/ |_'П(EKJYI9WA_A&pŧ(i5We5ژ&*v]ML5qD 0;&bnp9D#yh np=w2M LR1v1M 1MTh~Ԓ]W2aA:Lq?(DE}j>vw:uxͦ(]?VʉLBgMyjL-Dz&k i@O^0p*G0O݁ RqL5$. tUZ&7p&g|I`DVzj^DrFoj޳J atÜaի({njfa«DhQpJ "X!$2,afqLx7'9g*;jqM\zcnDb\7kٜ5 cak,fBz 7Ao 6)fufҶM>X:>jGh|P\ڥ,@+?'-DTěo!SiDe׻AF=fh!D[9*}`4wzTSy rzTA)0~~=|jm:g&} [/x`=X/+Eׁ]pzX+ @qŃ(hHpЇ"jOdM1>G'x THx< }Z)J- =x < }V3>3CWLfFm2x[}Q-/A_ SLDSi ov[yhWd7Rl1 ߃ACo@+>?H}s)2JDMLuc̴)(´8Oqema`X4Q-Ni[ib( iq"[tfs!kI1Lu#nc53M ;LTt94G'{Aʼnh.QʼnhZ}aCL#gq+) 8DqioLC) 1'gsyp3LuI{Lu4xiCjO1΂&W_JDx|iW< ib(^dڐכ+~ iWiW\4QQg`#Zd&7 ? zW)5Tc\l=V(QH!w&rʍ촛Rv3>pZ(8$|Ya8qVMs^~#{TSEi=Ħ!gi^B%Ar-M 4}u@OqNq+dN8lLeGbfܞ0{Rz [/$zsOqOO/%xTZn,]=˝jiy]&'o)LMT7Eoʏza5 4d\PE늙]CI+~Kw!hh^b +Mz|~P}*A|( |Pƚ2һ$0a^VӜY ^go |@|>.D~#jPlRH,4ͲMnR.=)^9+>2#h8xaO<+W>N jmҥWdQ?F QD-ECM2o{Ls_^Ll{{CHhIMe۶2i759fm|há"s7Uzcu/P7@ ; \>xx]2 :& )7+eGIq3ܑۭ}9VC2A|.]z }oH z&hLq= zL@'BJ C+KP思ԾǠӓ_ );'O-;Ru֓wRv.w ۮm{W"zrwK/BPYnZyn=Rg?ӓ2×v23euM+[Ͽ]Hy|]ei#y'ПIοBRrUW#e39|a$hۙ& 92W #e ib($²#e$Qt7*?i`8r% ncZ\ 5GL$rV&EG3E;Aib()LR%՛mkdrNJ]~8DILCqO&*MgFF:FyhL_bڐw&**$I#/73!f!ЛS+`g_CLM*uUAgPH q?-jVѲ68$k~f  !B* a-Hs``F `HtQCNʏf=u+*Z' lj{;(~G'TSjn҅uz2eꐿws3q=77 Uu'Yv+P][`{j˻3vzĥKd#k*k\ѷZnS @a`H;Ddʬ-*%"W̫q-,L㵒3U=ên;œvEOG6R; [L3kgD>ClG@RߪQKyTR8tсV 3կhB["8TB!'m՟" ^8ꏳIn "DLNMfEm1ZʠieINFq/?wUٔM\(0Rfj>JX>|4J @sL+nujX%- o*,1LaNZ=;M:Z(vr*b1|@\ FzIoCwa6@q=6-[GQ)fZy3=sN{EMh F ZjX5X P駞'[A2U"qHVXW@zRYctǒԻVJ'L}$~[ktjN&lpCzök ތ1lҶNzwc&!;uC7e >, SR1Nw!fo7=gQSI_:& L68fzcu W ~9fӋ .~Ov[9LVګcILqVR C Ы]`h J9BQ ]æ=+V8@@Hw$`~&Uig]-xQ;%mhOl,Qą z_0o3*p-^,TUfZQJ[>>&ݯ|dz $[Z-Z2̄/wޣzoHޯ- "튯z\epzD+GGCr>QO zLq< }R)Od'ЧIv8qig| <}F3B㌯υg9>i[ ^?/B_cKЗBOW_-#o@|CЗ+!M-w9=[ H{q;q?R\!m,:LwJnbhcQl3Fs80` FrSqema`X4Q-Ni[%HٖZm/ Bƨ\frnFp+4fv10uLC1p'Dh%sh40M= D>ʴV_XDžqFJJ{#>4Q70g`q$Pq |iboم & DxD8 aڐS`9UGs1MW&pų& E q]:)௘&pk௙&p%7L;znaQ aT-P޶d>Sd<&dz)8tf>gidUY&mlZJm#F>gS߄mdq/W^jݓ