scales/0000755000175100001440000000000013010656330011537 5ustar hornikusersscales/tests/0000755000175100001440000000000012325313141012677 5ustar hornikusersscales/tests/testthat.R0000644000175100001440000000007012325313150014657 0ustar hornikuserslibrary(testthat) library(scales) test_check("scales") scales/tests/testthat/0000755000175100001440000000000013010656330014541 5ustar hornikusersscales/tests/testthat/test-manual-pal.R0000644000175100001440000000027412654662757017722 0ustar hornikuserscontext("manual_pal") test_that("manual_pal gives warning if n greater than the number of values", { expect_warning(manual_pal(c("red", "blue", "green"))(4), "can handle a maximum") }) scales/tests/testthat/test-zero-range.r0000644000175100001440000000421112536070610017753 0ustar hornikuserscontext("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))) }) 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 1000 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 + 1001 * 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 + 1001 * eps))) expect_false(zero_range(.00001 * c(1, 1 + 1001 * eps))) }) scales/tests/testthat/test-colour-ramp.R0000644000175100001440000000040012651520475020105 0ustar hornikuserscontext("Colour ramp") test_that("Special values yield NAs", { pal <- seq_gradient_pal() expect_equal(pal(NA), NA_character_) expect_equal(pal(NaN), NA_character_) expect_equal(pal(Inf), NA_character_) expect_equal(pal(-Inf), NA_character_) }) scales/tests/testthat/test-alpha.r0000644000175100001440000000145012553731560017000 0ustar hornikuserscontext("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.out = 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.out = 3)) reds <- alpha("red", alphas / 255) reds_alpha <- col2rgb(reds, TRUE)[4, ] expect_equal(alphas, reds_alpha) }) scales/tests/testthat/test-formatter.r0000644000175100001440000000640012654140640017711 0ustar hornikuserscontext("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("wrap correctly wraps long lines", { expect_equal(wrap_format(10)("this is a long line"), "this is a\nlong line") expect_equal(wrap_format(10)(c("this is a long line", "this is another long line")), c("this is a\nlong line", "this is\nanother\nlong line")) expect_equal(wrap_format(10)("a_very_long_word_without_spaces"), "a_very_long_word_without_spaces") expect_equal(wrap_format(10)("short line"), "short\nline") expect_equal(wrap_format(15)("short line"), "short line") }) test_that("ordinal format", { expect_equal(ordinal(1), "1st") expect_equal(ordinal(2), "2nd") expect_equal(ordinal(3), "3rd") expect_equal(ordinal(4), "4th") expect_equal(ordinal(11), "11th") expect_equal(ordinal(12), "12th") expect_equal(ordinal(21), "21st") }) test_that("ordinal format maintains order", { expect_equal(ordinal(c(21, 1, 11)), c("21st", "1st", "11th")) }) 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))) }) test_that("formats work with 0 length input", { x <- numeric() expected <- character() expect_identical(comma(x), expected) expect_identical(dollar(x), expected) expect_identical(percent(x), expected) expect_identical(scientific(x), expected) expect_identical(comma_format()(x), expected) expect_identical(date_format()(as.Date(character(0))), expected) expect_identical(dollar_format()(x), expected) expect_identical(math_format()(x), list()) expect_identical(parse_format()(x), list()) expect_identical(percent_format()(x), expected) expect_identical(scientific_format()(x), expected) expect_identical(trans_format(identity)(x), expected) }) test_that("unit format", { expect_equal( unit_format(unit = "km", scale = 1e-3)(c(1e3, 2e3)), c("1 km", "2 km") ) expect_equal( unit_format(unit = "ha", scale = 1e-4)(c(1e3, 2e3)), c("0.1 ha", "0.2 ha") ) expect_equal( unit_format()(c(1e3, 2e3)), c("1,000 m", "2,000 m") ) }) # Percent formatter ------------------------------------------------------- test_that("negative percents work", { expect_equal(percent(-0.6), "-60%") }) test_that("Single 0 gives 0%", { expect_equal(percent(0), "0%") }) # Dollar formatter -------------------------------------------------------- test_that("negative comes before prefix", { expect_equal(dollar(-1), "$-1") }) test_that("missing values preserved", { expect_equal(dollar(NA_real_), "$NA") }) scales/tests/testthat/test-colors.r0000644000175100001440000000541512536046022017212 0ustar hornikuserscontext("Colors") bw <- c("black", "white") test_that("Edgy col_bin scenarios", { # Do these cases make sense? expect_equal(col_bin(bw, NULL)(1), "#777777") expect_equal(col_bin(bw, 1)(1), "#FFFFFF") }) test_that("Outside of domain returns na.color", { suppressWarnings({ expect_identical("#808080", col_factor(bw, letters)("foo")) expect_identical("#808080", col_quantile(bw, 0:1)(-1)) expect_identical("#808080", col_quantile(bw, 0:1)(2)) expect_identical("#808080", col_numeric(bw, c(0, 1))(-1)) expect_identical("#808080", col_numeric(bw, c(0, 1))(2)) expect_true(is.na(col_factor(bw, letters, na.color = NA)("foo"))) expect_true(is.na(col_quantile(bw, 0:1, na.color = NA)(-1))) expect_true(is.na(col_quantile(bw, 0:1, na.color = NA)(2))) expect_true(is.na(col_numeric(bw, c(0, 1), na.color = NA)(-1))) expect_true(is.na(col_numeric(bw, c(0, 1), na.color = NA)(2))) }) expect_warning(col_factor(bw, letters, na.color = NA)("foo")) expect_warning(col_quantile(bw, 0:1, na.color = NA)(-1)) expect_warning(col_quantile(bw, 0:1, na.color = NA)(2)) expect_warning(col_numeric(bw, c(0, 1), na.color = NA)(-1)) expect_warning(col_numeric(bw, c(0, 1), na.color = NA)(2)) }) test_that("Basic color accuracy", { expect_identical(c("#000000", "#7F7F7F", "#FFFFFF"), col_numeric(colorRamp(bw), NULL)(c(0, 0.5, 1))) expect_identical(c("#000000", "#FFFFFF"), col_bin(bw, NULL)(c(1,2))) expect_identical(c("#000000", "#FFFFFF"), col_bin(bw, c(1,2))(c(1,2))) expect_identical(c("#000000", "#FFFFFF"), col_bin(bw, c(1,2), 2)(c(1,2))) expect_identical(c("#000000", "#FFFFFF"), col_bin(bw, NULL, bins=c(1,1.5,2))(c(1,2))) expect_identical(c("#000000", "#FFFFFF"), col_bin(bw, c(1,2), bins=c(1,1.5,2))(c(1,2))) expect_identical(c("#000000", "#777777", "#FFFFFF"), col_numeric(bw, NULL)(1:3)) expect_identical(c("#000000", "#777777", "#FFFFFF"), col_numeric(bw, c(1:3))(1:3)) expect_identical(rev(c("#000000", "#777777", "#FFFFFF")), col_numeric(rev(bw), c(1:3))(1:3)) # domain != unique(x) expect_identical(c("#000000", "#0E0E0E", "#181818"), col_factor(bw, LETTERS)(LETTERS[1:3])) # domain == unique(x) expect_identical(c("#000000", "#777777", "#FFFFFF"), col_factor(bw, LETTERS[1:3])(LETTERS[1:3])) # no domain expect_identical(c("#000000", "#777777", "#FFFFFF"), col_factor(bw, NULL)(LETTERS[1:3])) # Non-factor domains are sorted unless instructed otherwise expect_identical(c("#000000", "#777777", "#FFFFFF"), col_factor(bw, rev(LETTERS[1:3]))(LETTERS[1:3])) expect_identical(rev(c("#000000", "#777777", "#FFFFFF")), col_factor(bw, rev(LETTERS[1:3]), ordered = TRUE)(LETTERS[1:3])) }) test_that("CIELab overflow", { expect_identical(c("#FFFFFF", "#CFB1FF", "#9165FF", "#0000FF"), scales::colour_ramp(c("white", "blue"))(0:3/3)) }) scales/tests/testthat/test-scale.r0000644000175100001440000000125212553731560017002 0ustar hornikuserscontext("Scale") test_that("NA.value works for continuous scales", { x <- c(NA, seq(0, 1, length.out = 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/tests/testthat/test-trans.r0000644000175100001440000000040511666154730017043 0ustar hornikuserscontext("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/tests/testthat/test-breaks-log.r0000644000175100001440000000017611726426476017755 0ustar hornikuserscontext("Breaks - log") test_that("Five ticks over 10^4 range work", { expect_equal(log_breaks()(10^(1:5)), 10 ^ (1:5)) })scales/tests/testthat/test-discrete.R0000644000175100001440000000106612775173407017466 0ustar hornikuserscontext("discrete") test_that("na.rm = FALSE keeps NA", { x1 <- c("a", NA) x2 <- factor(x1) x3 <- addNA(x2) expect_equal(train_discrete(x1, na.rm = FALSE), c("a", NA)) expect_equal(train_discrete(x2, na.rm = FALSE), c("a", NA)) expect_equal(train_discrete(x3, na.rm = FALSE), c("a", NA)) }) test_that("na.rm = TRUE drops NA", { x1 <- c("a", NA) x2 <- factor(x1) x3 <- addNA(x2) expect_equal(train_discrete(x1, na.rm = TRUE), "a") expect_equal(train_discrete(x2, na.rm = TRUE), "a") expect_equal(train_discrete(x3, na.rm = TRUE), "a") }) scales/tests/testthat/test-trans-date.r0000644000175100001440000000200011775336742017755 0ustar hornikuserscontext("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/tests/testthat/test-breaks-extended.R0000644000175100001440000000036412775473604020733 0ustar hornikuserscontext("breaks - extended") test_that("extended breaks returns no breaks for bad inputs", { breaks <- extended_breaks() expect_equal(breaks(NA), numeric()) expect_equal(breaks(Inf), numeric()) expect_equal(breaks(NaN), numeric()) }) scales/tests/testthat/test-rescale.R0000644000175100001440000000020512554266001017260 0ustar hornikuserscontext("rescale") test_that("rescale preserves NAs even when x has zero range", { expect_equal(rescale(c(1, NA)), c(0.5, NA)) }) scales/tests/testthat/test-bounds.r0000644000175100001440000000172412055506613017205 0ustar hornikuserscontext("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/tests/testthat/test-range.r0000644000175100001440000000171612566632217017017 0ustar hornikuserscontext("Ranges") 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/src/0000755000175100001440000000000013010421525012322 5ustar hornikusersscales/src/colors.cpp0000644000175100001440000001611313010421526014332 0ustar hornikusers#include #include #include #include using namespace Rcpp; // Convert an integer (0-255) to two ASCII hex digits, starting at buf void intToHex(unsigned int x, char* buf) { const char* hexchars = "0123456789ABCDEF"; buf[0] = hexchars[(x >> 4) & 0xF]; buf[1] = hexchars[x & 0xF]; } // Convert the rgb values to #RRGGBB hex string std::string rgbcolor(double r, double g, double b) { char color[8]; color[0] = '#'; intToHex(static_cast(r), color + 1); intToHex(static_cast(g), color + 3); intToHex(static_cast(b), color + 5); color[7] = 0; return std::string(color); } // Convert the rgba values to #RRGGBB hex string std::string rgbacolor(double r, double g, double b, double a) { char color[10]; color[0] = '#'; intToHex(static_cast(r), color + 1); intToHex(static_cast(g), color + 3); intToHex(static_cast(b), color + 5); intToHex(static_cast(a), color + 7); color[9] = 0; return std::string(color); } // === BEGIN SRGB/LAB CONVERSION ======================================= double linear2srgb(double c) { double a = 0.055; if (c <= 0.0031308) { return 12.92 * c; } else { return (1 + a) * ::pow(c, 1.0/2.4) - a; } } double srgb2linear(double c) { double a = 0.055; if (c <= 0.04045) { return c / 12.92; } else { return ::pow((c + a) / (1 + a), 2.4); } } double d65_x = 0.95320571254937703; double d65_y = 1.0; double d65_z = 1.08538438164691575; double srgb_xyz[][3] = { {0.416821341885317054, 0.35657671707797467, 0.179807653586085414}, {0.214923504409616606, 0.71315343415594934, 0.071923061434434166}, {0.019538500400874251, 0.11885890569265833, 0.946986975553383292} }; void srgb2xyz(double r, double g, double b, double* x, double *y, double* z) { r = srgb2linear(r); g = srgb2linear(g); b = srgb2linear(b); *x = srgb_xyz[0][0] * r + srgb_xyz[0][1] * g + srgb_xyz[0][2] * b; *y = srgb_xyz[1][0] * r + srgb_xyz[1][1] * g + srgb_xyz[1][2] * b; *z = srgb_xyz[2][0] * r + srgb_xyz[2][1] * g + srgb_xyz[2][2] * b; } double xyz_srgb[][3] = { { 3.206520517144463067, -1.52104178377365540, -0.493310848791455814}, {-0.971982546201231923, 1.88126865160848711, 0.041672484599589298}, { 0.055838338593097898, -0.20474057484135894, 1.060928433268858884} }; void xyz2srgb(double x, double y, double z, double *r, double *g, double *b) { *r = xyz_srgb[0][0] * x + xyz_srgb[0][1] * y + xyz_srgb[0][2] * z; *g = xyz_srgb[1][0] * x + xyz_srgb[1][1] * y + xyz_srgb[1][2] * z; *b = xyz_srgb[2][0] * x + xyz_srgb[2][1] * y + xyz_srgb[2][2] * z; *r = linear2srgb(*r); *g = linear2srgb(*g); *b = linear2srgb(*b); } double labf(double t) { if (t > ::pow(6.0 / 29.0, 3.0)) { return ::pow(t, 1.0 / 3.0); } else { return 1.0/3.0 * ::pow(29.0 / 6.0, 2.0) * t + (4.0 / 29.0); } } void xyz2lab(double x, double y, double z, double *l, double *a, double *b) { x = x / d65_x; y = y / d65_y; z = z / d65_z; *l = 116.0 * labf(y) - 16.0; *a = 500.0 * (labf(x) - labf(y)); *b = 200.0 * (labf(y) - labf(z)); } double labf_inv(double t) { if (t > 6.0 / 29.0) { return ::pow(t, 3.0); } else { return 3 * ::pow(6.0/29.0, 2) * (t - 4.0 / 29.0); } } void lab2xyz(double l, double a, double b, double *x, double *y, double *z) { *y = d65_y * labf_inv(1.0 / 116.0 * (l + 16.0)); *x = d65_x * labf_inv(1.0 / 116.0 * (l + 16.0) + 1.0 / 500.0 * a); *z = d65_z * labf_inv(1.0 / 116.0 * (l + 16.0) - 1.0 / 200.0 * b); } void srgb2lab(double red, double green, double blue, double *l, double *a, double *b) { double x, y, z; srgb2xyz(red, green, blue, &x, &y, &z); xyz2lab(x, y, z, l, a, b); } void lab2srgb(double l, double a, double b, double *red, double *green, double *blue) { double x, y, z; lab2xyz(l, a, b, &x, &y, &z); xyz2srgb(x, y, z, red, green, blue); } // === END SRGB/LAB CONVERSION ======================================= StringVector doColorRampSerial(NumericMatrix colors, NumericVector x, bool alpha, std::string naColor) { size_t ncolors = colors.ncol(); StringVector result(x.length()); for (R_len_t i = 0; i < x.length(); i++) { double xval = x[i]; if (xval < 0 || xval > 1 || !R_finite(xval)) { // Illegal or NA value for this x value. result[i] = NA_STRING; } else { // Scale the [0,1] value to [0,n-1] xval *= ncolors - 1; // Find the closest color that's *lower* than xval. This'll be one of the // colors we use to interpolate; the other will be colorOffset+1. size_t colorOffset = static_cast(::floor(xval)); double l, a, b; double opacity = 0; if (colorOffset == ncolors - 1) { // xvalue is exactly at the top of the range. Just use the top color. l = colors(0, colorOffset); a = colors(1, colorOffset); b = colors(2, colorOffset); if (alpha) { opacity = colors(3, colorOffset); } } else { // Do a linear interp between the two closest colors. double factorB = xval - colorOffset; double factorA = 1 - factorB; l = factorA * colors(0, colorOffset) + factorB * colors(0, colorOffset + 1); a = factorA * colors(1, colorOffset) + factorB * colors(1, colorOffset + 1); b = factorA * colors(2, colorOffset) + factorB * colors(2, colorOffset + 1); if (alpha) { opacity = ::round(factorA * colors(3, colorOffset) + factorB * colors(3, colorOffset + 1)); } } double red, green, blue; lab2srgb(l, a, b, &red, &green, &blue); red = std::max(0.0, std::min(255.0, ::round(red * 255))); green = std::max(0.0, std::min(255.0, ::round(green * 255))); blue = std::max(0.0, std::min(255.0, ::round(blue * 255))); // Convert the result to hex string if (!alpha) result[i] = rgbcolor(red, green, blue); else result[i] = rgbacolor(red, green, blue, opacity); } } return result; } // [[Rcpp::export]] StringVector doColorRamp(NumericMatrix colors, NumericVector x, bool alpha, std::string naColor) { for (int col = 0; col < colors.cols(); col++) { double red = colors(0, col) / 255; double green = colors(1, col) / 255; double blue = colors(2, col) / 255; double l, a, b; srgb2lab(red, green, blue, &l, &a, &b); colors(0, col) = l; colors(1, col) = a; colors(2, col) = b; } return doColorRampSerial(colors, x, alpha, naColor); } // For unit testing // [[Rcpp::export]] NumericVector rgbToLab(NumericVector rgb) { double l, a, b; srgb2lab(rgb[0], rgb[1], rgb[2], &l, &a, &b); NumericVector result(3); result[0] = l; result[1] = a; result[2] = b; return result; } // For unit testing // [[Rcpp::export]] NumericVector rgbToXyz(NumericVector rgb) { double x, y, z; srgb2xyz(rgb[0], rgb[1], rgb[2], &x, &y, &z); NumericVector result(3); result[0] = x; result[1] = y; result[2] = z; return result; } /*** R x <- runif(10000) colors <- c('black', 'white') c0 <- function(x) { rgb(colorRamp(colors, space = 'Lab')(x) / 255) } c1 <- colour_ramp(colors) which(c0(x) != c1(x)) */ scales/src/RcppExports.cpp0000644000175100001440000000303013010421526015314 0ustar hornikusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // doColorRamp StringVector doColorRamp(NumericMatrix colors, NumericVector x, bool alpha, std::string naColor); RcppExport SEXP scales_doColorRamp(SEXP colorsSEXP, SEXP xSEXP, SEXP alphaSEXP, SEXP naColorSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type colors(colorsSEXP); Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< bool >::type alpha(alphaSEXP); Rcpp::traits::input_parameter< std::string >::type naColor(naColorSEXP); rcpp_result_gen = Rcpp::wrap(doColorRamp(colors, x, alpha, naColor)); return rcpp_result_gen; END_RCPP } // rgbToLab NumericVector rgbToLab(NumericVector rgb); RcppExport SEXP scales_rgbToLab(SEXP rgbSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type rgb(rgbSEXP); rcpp_result_gen = Rcpp::wrap(rgbToLab(rgb)); return rcpp_result_gen; END_RCPP } // rgbToXyz NumericVector rgbToXyz(NumericVector rgb); RcppExport SEXP scales_rgbToXyz(SEXP rgbSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type rgb(rgbSEXP); rcpp_result_gen = Rcpp::wrap(rgbToXyz(rgb)); return rcpp_result_gen; END_RCPP } scales/NAMESPACE0000644000175100001440000000405012775215037012771 0ustar hornikusers# Generated by roxygen2: do not edit by hand S3method(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(col_bin) export(col_factor) export(col_numeric) export(col_quantile) export(colour_ramp) 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(hms_trans) 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(ordinal) export(ordinal_format) 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(train_continuous) export(train_discrete) export(trans_breaks) export(trans_format) export(trans_new) export(trans_range) export(unit_format) export(wrap_format) export(zero_range) importFrom(Rcpp,evalCpp) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,rect) importFrom(graphics,text) importFrom(methods,new) importFrom(methods,setRefClass) importFrom(munsell,mnsl) importFrom(plyr,is.discrete) importFrom(plyr,round_any) useDynLib(scales) scales/NEWS.md0000644000175100001440000001301113010403043012620 0ustar hornikusers# scales 0.4.1 * `extended_breaks()` no longer fails on pathological inputs * New `hms_trans()` for transforming hms time vectors. * `train_discrete()` gets a new `na.rm` argument which controls whether `NA`s are preserved or dropped. # scales 0.4.0 * Switched from `NEWS` to `NEWS.md` * `manual_pal()` produces a warning if n is greater than the number of values in the palette (@jrnold, #68). * `precision(0)` now returns 1, which means `percent(0)` now returns 0% (#50). * `scale_continuous()` uses a more correct check for numeric values. * NaN is correctly recognised as a missing value by the gradient palettes (ggplot2#1482). # scales 0.3.0 * `rescale()` preserves missing values in input when the range of `x` is (effectively) 0 (ggplot2#985). * Continuous colour palettes now use `colour_ramp()` instead of `colorRamp()`. This only supports interpolation in Lab colour space, but is hundreds of times faster. # scales 0.2.5 ## Improved formatting functions * `date_format()` gains an option to specify time zone (#51). * `dollar_format()` is now more flexible and can add either prefixes or suffixes for different currencies (#53). It gains a `negative_parens` argument to show negative values as `($100)` and now passes missing values through unchanged (#40, @dougmitarotonda). * New `ordinal_format()` generates ordinal numbers (1st, 2nd etc) (@aaronwolen, #55) * New `unit_format()` makes it easier to add units to labels, optionally scaling (@ThierryO, 46) * New `wrap_format()` function to wrap character vectors to a desired width. (@jimhester, #37). ## New colour scaling functions * New color scaling functions `col_numeric()`, `col_bin()`, `col_quantile()`, and `col_factor()`. These functions provide concise ways to map continuous or categorical values to color spectra. * New `colour_ramp()` function for performing color interpolation in the CIELAB color space (like `grDevices::colorRamp(space = 'Lab')`, but much faster). ## Other bug fixes and minor improvements * `boxcox_trans()` returns correct value when p is close to zero (#31). * `dollar()` and `percent()` both correctly return a zero length string for zero length input (@BrianDiggs, #35) * `brewer_pal()` gains a `direction` argument to easily invert the order of colours (@jiho, #36). * `show_col()` has additional options to showcase colors better (@jiho, #52) * Relaxed tolerance in `zero_range()` to `.Machine$double.eps * 1000` (#33). # scales 0.2.4 * Eliminate stringr dependency. * Fix outstanding errors in R CMD check # scales 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. # scales 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` # scales 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. # scales 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/R/0000755000175100001440000000000013010421526011735 5ustar hornikusersscales/R/pal-manual.r0000644000175100001440000000056712654662757014211 0ustar hornikusers#' Manual palette (manual). #' #' @param values vector of values to be used as a palette. #' @export manual_pal <- function(values) { function(n) { n_values <- length(values) if (n > n_values) { warning("This manual palette can handle a maximum of ", n_values, " values. You have supplied ", n , ".", call. = FALSE) } values[seq_len(n)] } } scales/R/pal-brewer.r0000644000175100001440000000421112556447174014203 0ustar hornikusers#' 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} #' @param direction Sets the order of colors in the scale. If 1, the default, #' colors are as output by \code{\link[RColorBrewer]{brewer.pal}}. If -1, the #' order of colors is reversed. #' @references \url{http://colorbrewer2.org} #' @export #' @examples #' show_col(brewer_pal()(10)) #' show_col(brewer_pal("div")(5)) #' show_col(brewer_pal(palette = "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.out = 30))) brewer_pal <- function(type = "seq", palette = 1, direction = 1) { pal <- pal_name(palette, type) function(n) { # 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. if (n < 3) { pal <- suppressWarnings(RColorBrewer::brewer.pal(n, pal)) } else { pal <- RColorBrewer::brewer.pal(n, pal) } # In both cases ensure we have n items pal <- pal[seq_len(n)] if (direction == -1) pal <- rev(pal) pal } } pal_name <- function(palette, type) { if (is.character(palette)) { if (!palette %in% unlist(brewer)) { warning("Unknown palette ", palette) palette <- "Greens" } return(palette) } type <- match.arg(type, c("div", "qual", "seq")) brewer[[type]][palette] } brewer <- list( div = c("BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu", "RdYlGn", "Spectral"), qual = c("Accent", "Dark2", "Paired", "Pastel1", "Pastel2", "Set1", "Set2", "Set3"), seq = c("Blues", "BuGn", "BuPu", "GnBu", "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn", "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu", "YlOrBr", "YlOrRd") ) scales/R/breaks.r0000644000175100001440000001112412775473452013414 0ustar hornikusers#' 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. #' @export #' @examples #' extended_breaks()(1:10) #' extended_breaks()(1:100) extended_breaks <- function(n = 5, ...) { function(x) { x <- x[is.finite(x)] if (length(x) == 0) { return(numeric()) } rng <- range(x) labeling::extended(rng[1], rng[2], 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/scale-discrete.r0000644000175100001440000000361012775173527015035 0ustar hornikusers#' 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 (update) a discrete scale #' #' @param new New data to add to scale #' @param existing Optional existing scale to update #' @param drop \code{TRUE}, will drop factor levels not associated with data #' @param na.rm If \code{TRUE}, will remove missing values #' @export train_discrete <- function(new, existing = NULL, drop = FALSE, na.rm = 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, na.rm = na.rm) } discrete_range <- function(old, new, drop = FALSE, na.rm = FALSE) { new <- clevels(new, drop = drop, na.rm = na.rm) if (is.null(old)) return(new) if (!is.character(old)) old <- clevels(old, na.rm = na.rm) 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, na.rm = FALSE) { if (is.null(x)) { character() } else if (is.factor(x)) { if (drop) x <- factor(x) values <- levels(x) if (na.rm) { values <- values[!is.na(values)] } else if (any(is.na(x))) { values <- c(values, NA) } values } else { sort(unique(x), na.last = if (na.rm) NA else TRUE) } } 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/colour-manip.r0000644000175100001440000000620012566615003014535 0ustar hornikusers#' 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(grDevices::col2rgb(colour)) / 255 coords <- grDevices::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 <- grDevices::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.out = 10)) alpha <- function(colour, alpha = NA) { col <- grDevices::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 <- grDevices::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 #' @param labels boolean, whether to show the hexadecimal representation of the colours in each tile #' @param borders colour of the borders of the tiles; matches the \code{border} argument of \code{\link[graphics]{rect}}. The default means \code{par("fg")}. Use \code{border = NA} to omit borders. #' @export #' @importFrom graphics par plot rect text show_col <- function(colours, labels = TRUE, borders = NULL) { 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, border = borders) if ( labels ) { text(col(colours) - 0.5, -row(colours) + 0.5, colours) } } scales/R/pal-hue.r0000644000175100001440000000211312553731560013465 0ustar hornikusers#' 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 #' @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.out = n)) grDevices::hcl(hues, c, l) } } scales/R/pal-area.r0000644000175100001440000000073212055506613013615 0ustar hornikusers#' 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/trans.r0000644000175100001440000000434612553731560013273 0ustar hornikusers#' 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 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") #' @export 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 <- paste0(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$transform(range(squish(x, trans$domain), na.rm = TRUE))) } scales/R/date-time.r0000644000175100001440000000327012553731560014010 0ustar hornikusers# 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, "tzone", exact = TRUE) %||% "" ) } } 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/trans-numeric.r0000644000175100001440000000566512536065057014742 0ustar hornikusers#' 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( paste0("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( paste0("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(paste0("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 #' @examples #' trans_range(log_trans(), 1:10) #' trans_range(log1p_trans(), 0:9) 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(paste0("q", distribution)) pfun <- match.fun(paste0("p", distribution)) trans_new( paste0("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/pal-shape.r0000644000175100001440000000116412536064235014010 0ustar hornikusers#' 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.r0000644000175100001440000000056211505124532014317 0ustar hornikusers#' 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/bounds.r0000644000175100001440000001443412554265703013437 0ustar hornikusers#' 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, finite = TRUE)) { if (zero_range(from) || zero_range(to)) { return(ifelse(is.na(x), NA, mean(to))) } (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 * 1000 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 + 1001 * 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 + 1001 * eps)) # FALSE #' zero_range(.00001 * c(1, 1 + eps)) # TRUE #' zero_range(.00001 * c(1, 1 + 1001 * 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. #' @return logical \code{TRUE} if the relative difference of the endpoints of #' the range are not distinguishable from 0. zero_range <- function(x, tol = 1000 * .Machine$double.eps) { 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/R/range.r0000644000175100001440000000147212566632155013241 0ustar hornikusers#' 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 <- methods::setRefClass("Range", fields = "range", methods = list( initialize = function() { initFields(range = NULL) }) ) DiscreteRange <- methods::setRefClass( "DiscreteRange", contains = "Range", methods = list( train = function(x, drop = FALSE) { range <<- train_discrete(x, range, drop) }, reset = function() range <<- NULL ) ) ContinuousRange <- methods::setRefClass( "Continuous", contains = "Range", methods = list( train = function(x) range <<- train_continuous(x, range), reset = function() range <<- NULL ) ) scales/R/pal-dichromat.r0000644000175100001440000000153312553731560014663 0ustar hornikusers#' Dichromat (colour-blind) palette (discrete). #' #' @param name Name of colour palette. One of: #' \Sexpr[results=rd,stage=build]{scales:::dichromat_schemes()} #' @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.out = 30))) dichromat_pal <- function(name) { if (!any(name == names(dichromat::colorschemes))) { stop("Palette name must be one of ", paste0(names(dichromat::colorschemes), collapse = ", "), call. = FALSE) } pal <- dichromat::colorschemes[[name]] function(n) pal[seq_len(n)] } dichromat_schemes <- function() { paste0("\\code{", names(dichromat::colorschemes), "}", collapse = ", ") } scales/R/trans-date.r0000644000175100001440000000600012775216574014204 0ustar hornikusers#' Transformation for dates (class Date). #' #' @export #' @examples #' years <- seq(as.Date("1910/1/1"), as.Date("1999/1/1"), "years") #' t <- date_trans() #' t$transform(years) #' t$inverse(t$transform(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 date-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$transform(hours) #' t$inverse(t$transform(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()) } #' Transformation for times (class hms). #' #' @export #' @examples #' if (require("hms")) { #' hms <- round(runif(10) * 86400) #' t <- hms_trans() #' t$transform(hms) #' t$inverse(t$transform(hms)) #' t$breaks(hms) #' } hms_trans <- function() { trans_new( "hms", transform = function(x) { structure(as.numeric(x), names = names(x)) }, inverse = hms::as.hms, breaks = time_breaks() ) } time_breaks <- function(n = 5) { function(x) { rng <- as.numeric(range(x)) diff <- rng[2] - rng[1] if (diff <= 2 * 60) { scale <- 1 } else if (diff <= 2 * 3600) { scale <- 60 } else if (diff <= 2 * 86400) { scale <- 3600 } else { scale <- 86400 } rng <- rng / scale breaks <- labeling::extended( rng[1], rng[2], n, Q = c(1, 2, 1.5, 4, 3), only.loose = FALSE ) hms::as.hms(breaks * scale) } } #' 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. #' @param tz a time zone name, see \code{\link{timezones}}. Defaults #' to UTC #' @export date_format <- function(format = "%Y-%m-%d", tz = 'UTC') { function(x) format(x, format, tz = tz) } scales/R/colour-mapping.r0000644000175100001440000003212012651520310015053 0ustar hornikusers#' Color mapping #' #' Conveniently maps data values (numeric or factor/character) to colors #' according to a given palette, which can be provided in a variety of formats. #' #' \code{col_numeric} is a simple linear mapping from continuous numeric data #' to an interpolated palette. #' #' @param palette The colors or color function that values will be mapped to #' @param domain The possible values that can be mapped. #' #' For \code{col_numeric} and \code{col_bin}, this can be a simple numeric #' range (e.g. \code{c(0, 100)}); \code{col_quantile} needs representative #' numeric data; and \code{col_factor} needs categorical data. #' #' If \code{NULL}, then whenever the resulting color function is called, the #' \code{x} value will represent the domain. This implies that if the function #' is invoked multiple times, the encoding between values and colors may not #' be consistent; if consistency is needed, you must provide a non-\code{NULL} #' domain. #' @param na.color The color to return for \code{NA} values. Note that #' \code{na.color=NA} is valid. #' #' @return A function that takes a single parameter \code{x}; when called with a #' vector of numbers (except for \code{col_factor}, which expects #' factors/characters), #RRGGBB color strings are returned. #' #' @export col_numeric <- function(palette, domain, na.color = "#808080") { rng <- NULL if (length(domain) > 0) { rng <- range(domain, na.rm = TRUE) if (!all(is.finite(rng))) { stop("Wasn't able to determine range of domain") } } pf <- safePaletteFunc(palette, na.color) withColorAttr('numeric', list(na.color = na.color), function(x) { if (length(x) == 0 || all(is.na(x))) { return(pf(x)) } if (is.null(rng)) rng <- range(x, na.rm = TRUE) rescaled <- scales::rescale(x, from = rng) if (any(rescaled < 0 | rescaled > 1, na.rm = TRUE)) warning("Some values were outside the color scale and will be treated as NA") pf(rescaled) }) } # Attach an attribute colorType to a color function f so we can derive legend # items from it withColorAttr <- function(type, args = list(), fun) { structure(fun, colorType = type, colorArgs = args) } # domain may or may not be NULL. # Iff domain is non-NULL, x may be NULL. # bins is non-NULL. It may be a scalar value (# of breaks) or a set of breaks. getBins <- function(domain, x, bins, pretty) { if (is.null(domain) && is.null(x)) { stop("Assertion failed: domain and x can't both be NULL") } # Hard-coded bins if (length(bins) > 1) { return(bins) } if (bins < 2) { stop("Invalid bins value of ", bins, "; bin count must be at least 2") } if (pretty) { base::pretty(domain %||% x, n = bins) } else { rng <- range(domain %||% x, na.rm = TRUE) seq(rng[1], rng[2], length.out = bins + 1) } } #' @details \code{col_bin} also maps continuous numeric data, but performs #' binning based on value (see the \code{\link[base]{cut}} function). #' @param bins Either a numeric vector of two or more unique cut points or a #' single number (greater than or equal to 2) giving the number of intervals #' into which the domain values are to be cut. #' @param pretty Whether to use the function \code{\link{pretty}()} to generate #' the bins when the argument \code{bins} is a single number. When #' \code{pretty = TRUE}, the actual number of bins may not be the number of #' bins you specified. When \code{pretty = FALSE}, \code{\link{seq}()} is used #' to generate the bins and the breaks may not be "pretty". #' @rdname col_numeric #' @export col_bin <- function(palette, domain, bins = 7, pretty = TRUE, na.color = "#808080") { # domain usually needs to be explicitly provided (even if NULL) but not if # breaks are specified if (missing(domain) && length(bins) > 1) { domain <- NULL } autobin <- is.null(domain) && length(bins) == 1 if (!is.null(domain)) bins <- getBins(domain, NULL, bins, pretty) numColors <- if (length(bins) == 1) bins else length(bins) - 1 colorFunc <- col_factor(palette, domain = if (!autobin) 1:numColors, na.color = na.color) pf = safePaletteFunc(palette, na.color) withColorAttr('bin', list(bins = bins, na.color = na.color), function(x) { if (length(x) == 0 || all(is.na(x))) { return(pf(x)) } binsToUse <- getBins(domain, x, bins, pretty) ints <- cut(x, binsToUse, labels = FALSE, include.lowest = TRUE, right = FALSE) if (any(is.na(x) != is.na(ints))) warning("Some values were outside the color scale and will be treated as NA") colorFunc(ints) }) } #' @details \code{col_quantile} similarly bins numeric data, but via the #' \code{\link[stats]{quantile}} function. #' @param n Number of equal-size quantiles desired. For more precise control, #' use the \code{probs} argument instead. #' @param probs See \code{\link[stats]{quantile}}. If provided, the \code{n} #' argument is ignored. #' @rdname col_numeric #' @export col_quantile <- function(palette, domain, n = 4, probs = seq(0, 1, length.out = n + 1), na.color = "#808080") { if (!is.null(domain)) { bins <- stats::quantile(domain, probs, na.rm = TRUE, names = FALSE) return(withColorAttr( 'quantile', list(probs = probs, na.color = na.color), col_bin(palette, domain = NULL, bins = bins, na.color = na.color) )) } # I don't have a precise understanding of how quantiles are meant to map to colors. # If you say probs = seq(0, 1, 0.25), which has length 5, does that map to 4 colors # or 5? 4, right? colorFunc <- col_factor(palette, domain = 1:(length(probs) - 1), na.color = na.color) withColorAttr('quantile', list(probs = probs, na.color = na.color), function(x) { binsToUse <- stats::quantile(x, probs, na.rm = TRUE, names = FALSE) ints <- cut(x, binsToUse, labels = FALSE, include.lowest = TRUE, right = FALSE) if (any(is.na(x) != is.na(ints))) warning("Some values were outside the color scale and will be treated as NA") colorFunc(ints) }) } # If already a factor, return the levels. Otherwise, convert to factor then # return the levels. calcLevels <- function(x, ordered) { if (is.null(x)) { NULL } else if (is.factor(x)) { levels(x) } else if (ordered) { unique(x) } else { sort(unique(x)) } } getLevels <- function(domain, x, lvls, ordered) { if (!is.null(lvls)) return(lvls) if (!is.null(domain)) { return(calcLevels(domain, ordered)) } if (!is.null(x)) { return(calcLevels(x, ordered)) } } #' @details \code{col_factor} maps factors to colors. If the palette is #' discrete and has a different number of colors than the number of factors, #' interpolation is used. #' @param levels An alternate way of specifying levels; if specified, domain is #' ignored #' @param ordered If \code{TRUE} and \code{domain} needs to be coerced to a #' factor, treat it as already in the correct order #' @rdname col_numeric #' @export col_factor <- function(palette, domain, levels = NULL, ordered = FALSE, na.color = "#808080") { # domain usually needs to be explicitly provided (even if NULL) but not if # levels are specified if (missing(domain) && !is.null(levels)) { domain <- NULL } if (!is.null(levels) && anyDuplicated(levels)) { warning("Duplicate levels detected") levels <- unique(levels) } lvls <- getLevels(domain, NULL, levels, ordered) hasFixedLevels <- is.null(lvls) pf <- safePaletteFunc(palette, na.color) withColorAttr('factor', list(na.color = na.color), function(x) { if (length(x) == 0 || all(is.na(x))) { return(pf(x)) } lvls <- getLevels(domain, x, lvls, ordered) if (!is.factor(x) || hasFixedLevels) { origNa <- is.na(x) # Seems like we need to re-factor if hasFixedLevels, in case the x value # has a different set of levels (like if droplevels was called in between # when the domain was given and now) x <- factor(x, lvls) if (any(is.na(x) != origNa)) { warning("Some values were outside the color scale and will be treated as NA") } } scaled <- scales::rescale(as.integer(x), from = c(1, length(lvls))) if (any(scaled < 0 | scaled > 1, na.rm = TRUE)) { warning("Some values were outside the color scale and will be treated as NA") } pf(scaled) }) } #' @details The \code{palette} argument can be any of the following: #' \enumerate{ #' \item{A character vector of RGB or named colors. Examples: \code{palette()}, \code{c("#000000", "#0000FF", "#FFFFFF")}, \code{topo.colors(10)}} #' \item{The name of an RColorBrewer palette, e.g. \code{"BuPu"} or \code{"Greens"}.} #' \item{A function that receives a single value between 0 and 1 and returns a color. Examples: \code{colorRamp(c("#000000", "#FFFFFF"), interpolate="spline")}.} #' } #' @examples #' pal <- col_bin("Greens", domain = 0:100) #' show_col(pal(sort(runif(10, 60, 100)))) #' #' # Exponential distribution, mapped continuously #' show_col(col_numeric("Blues", domain = NULL)(sort(rexp(16)))) #' # Exponential distribution, mapped by interval #' show_col(col_bin("Blues", domain = NULL, bins = 4)(sort(rexp(16)))) #' # Exponential distribution, mapped by quantile #' show_col(col_quantile("Blues", domain = NULL)(sort(rexp(16)))) #' #' # Categorical data; by default, the values being colored span the gamut... #' show_col(col_factor("RdYlBu", domain = NULL)(LETTERS[1:5])) #' # ...unless the data is a factor, without droplevels... #' show_col(col_factor("RdYlBu", domain = NULL)(factor(LETTERS[1:5], levels=LETTERS))) #' # ...or the domain is stated explicitly. #' show_col(col_factor("RdYlBu", levels = LETTERS)(LETTERS[1:5])) #' @rdname col_numeric #' @name col_numeric NULL safePaletteFunc <- function(pal, na.color) { filterRange( filterNA(na.color = na.color, filterZeroLength( filterRGB( toPaletteFunc(pal) ) ) ) ) } toPaletteFunc <- function(pal) { UseMethod("toPaletteFunc") } # Strings are interpreted as color names, unless length is 1 and it's the name # of an RColorBrewer palette toPaletteFunc.character <- function(pal) { if (length(pal) == 1 && pal %in% row.names(RColorBrewer::brewer.pal.info)) { return(colour_ramp( RColorBrewer::brewer.pal(RColorBrewer::brewer.pal.info[pal, 'maxcolors'], pal) )) } colour_ramp(pal) } # Accept colorRamp style matrix toPaletteFunc.matrix <- function(pal) { toPaletteFunc(grDevices::rgb(pal, maxColorValue = 255)) } # If a function, just assume it's already a function over [0-1] toPaletteFunc.function <- function(pal) { pal } # colorRamp(space = 'Lab') throws error when called with # zero-length input filterZeroLength <- function(f) { force(f) function(x) { if (length(x) == 0) { character(0) } else { f(x) } } } # Wraps an underlying non-NA-safe function (like colorRamp). filterNA <- function(f, na.color) { force(f) function(x) { results <- character(length(x)) nas <- is.na(x) results[nas] <- na.color results[!nas] <- f(x[!nas]) results } } # Wraps a function that may return RGB color matrix instead of rgb string. filterRGB <- function(f) { force(f) function(x) { results <- f(x) if (is.character(results)) { results } else if (is.matrix(results)) { grDevices::rgb(results, maxColorValue = 255) } else { stop("Unexpected result type ", class(x)[[1]]) } } } filterRange <- function(f) { force(f) function(x) { x[x < 0 | x > 1] <- NA f(x) } } #' Fast color interpolation #' #' Returns a function that maps the interval [0,1] to a set of colors. #' Interpolation is performed in the CIELAB color space. Similar to #' \code{\link[grDevices]{colorRamp}(space = 'Lab')}, but hundreds of #' times faster, and provides results in \code{"#RRGGBB"} (or #' \code{"#RRGGBBAA"}) character form instead of RGB color matrices. #' #' @param colors Colors to interpolate; must be a valid argument to #' \code{\link[grDevices]{col2rgb}}. This can be a character vector of #' \code{"#RRGGBB"} or \code{"#RRGGBBAA"}, color names from #' \code{\link[grDevices]{colors}}, or a positive integer that indexes into #' \code{\link[grDevices]{palette}()}. #' @param na.color The color to map to \code{NA} values (for example, #' \code{"#606060"} for dark grey, or \code{"#00000000"} for transparent) and #' values outside of [0,1]. Can itself by \code{NA}, which will simply cause #' an \code{NA} to be inserted into the output. #' @param alpha Whether to include alpha channels in interpolation; otherwise, #' any alpha information will be discarded. If \code{TRUE} then the returned #' function will provide colors in \code{"#RRGGBBAA"} format instead of #' \code{"#RRGGBB"}. #' #' @return A function that takes a numeric vector and returns a character vector #' of the same length with RGB or RGBA hex colors. #' #' @seealso \link[grDevices]{colorRamp} #' #' @export colour_ramp <- function(colors, na.color = NA, alpha = FALSE) { if (length(colors) == 0) { stop("Must provide at least one color to create a color ramp") } colorMatrix <- grDevices::col2rgb(colors, alpha = alpha) structure( function(x) { doColorRamp(colorMatrix, x, alpha, ifelse(is.na(na.color), "", na.color)) }, safe_palette_func = TRUE ) } scales/R/RcppExports.R0000644000175100001440000000066012775172773014403 0ustar hornikusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 doColorRamp <- function(colors, x, alpha, naColor) { .Call('scales_doColorRamp', PACKAGE = 'scales', colors, x, alpha, naColor) } rgbToLab <- function(rgb) { .Call('scales_rgbToLab', PACKAGE = 'scales', rgb) } rgbToXyz <- function(rgb) { .Call('scales_rgbToXyz', PACKAGE = 'scales', rgb) } scales/R/pal-identity.r0000644000175100001440000000023311666153542014540 0ustar hornikusers#' Identity palette. #' #' Leaves values unchanged - useful when the data is already scaled. #' #' @export identity_pal <- function() { function(x) x } scales/R/documentation.r0000644000175100001440000000052012325312655015000 0ustar hornikusers# Functions used for producing Rd chunks to reduce duplication in # documentation seealso <- function(pattern) { require("scales") names <- ls("package:scales", pattern = pattern) paste0("\\code{\\link{", names, "}}", collapse = ", ") } seealso_trans <- function() seealso("_trans$") seealso_pal <- function() seealso("_pal$") scales/R/full-seq.r0000644000175100001440000000176212325311122013654 0ustar hornikusers#' 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") #' @export 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 } } #' @export fullseq.Date <- function(range, size, ...) { seq(floor_date(range[1], size), ceiling_date(range[2], size), by = size) } #' @export fullseq.POSIXt <- function(range, size, ...) { seq(floor_time(range[1], size), ceiling_time(range[2], size), by = size) } scales/R/scales.r0000644000175100001440000000037012566643133013411 0ustar hornikusers#' Generic plot scaling methods #' #' @docType package #' @name package-scales #' @aliases scales package-scales #' @useDynLib scales #' @importFrom methods setRefClass new #' @importFrom plyr round_any is.discrete #' @importFrom Rcpp evalCpp NULL scales/R/formatter.r0000644000175100001440000002131712654140644014143 0ustar hornikusers#' 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 parameter 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)) #' #' # If you're European you can switch . and , with the more general #' # format_format #' point <- format_format(big.mark = ".", decimal.mark = ",", scientific = FALSE) #' point(c(1, 1e3, 2000, 1e6)) #' point(c(1, 1.021, 1000.01)) 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 parameter 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 prefix,suffix Symbols to display before and after amount. #' @param big.mark Character used between every 3 digits. #' @param negative_parens Should negative values be shown with parentheses? #' @param ... Other arguments passed on to \code{\link{format}}. #' @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)) #' #' usd <- dollar_format(prefix = "USD ") #' usd(c(100, -100)) #' #' euro <- dollar_format(prefix = "", suffix = "\u20ac") #' euro(100) #' #' finance <- dollar_format(negative_parens = TRUE) #' finance(c(-100, 100)) dollar_format <- function(prefix = "$", suffix = "", largest_with_cents = 100000, ..., big.mark = ",", negative_parens = FALSE) { function(x) { if (length(x) == 0) return(character()) x <- round_any(x, 0.01) if (needs_cents(x, largest_with_cents)) { nsmall <- 2L } else { x <- round_any(x, 1) nsmall <- 0L } negative <- !is.na(x) & x < 0 if (negative_parens) { x <- abs(x) } amount <- format(abs(x), nsmall = nsmall, trim = TRUE, big.mark = big.mark, scientific = FALSE, digits = 1L) if (negative_parens) { paste0(ifelse(negative, "(", ""), prefix, amount, suffix, ifelse(negative, ")", "")) } else { paste0(prefix, ifelse(negative, "-", ""), amount, suffix) } } } needs_cents <- function(x, threshold) { if (all(is.na(x))) return(FALSE) if (max(abs(x), na.rm = TRUE) > threshold) return(FALSE) !all(x == floor(x), na.rm = TRUE) } #' @export #' @rdname dollar_format dollar <- dollar_format() #' Percent formatter: multiply by one hundred and display percent sign. #' #' @return a function with single parameter 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) { if (length(x) == 0) return(character()) x <- round_any(x, precision(x) / 100) paste0(comma(x * 100), "%") } } #' @export #' @rdname percent_format percent <- percent_format() #' Scientific formatter. #' #' @return a function with single parameter 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, ...) } #' Ordinal formatter: add ordinal suffixes (-st, -nd, -rd, -th) to numbers. #' #' @return a function with single paramater x, a numeric vector, that #' returns a character vector #' @param x a numeric vector to format #' @export #' @examples #' ordinal_format()(1:10) #' ordinal(1:10) ordinal_format <- function(x) { function(x) ordinal(x) } #' @export #' @rdname ordinal_format ordinal <- function(x) { stopifnot(all(x > 0)) suffixes <- list( st = "(?P¶“ž;ÜRy`ÄûïÀÎ#r£=026ióc›†óÃ×æÆó× éNN+êÎ@I3r>ï ú¨e*H`(rÔz–ƒöw‚¯ú¨Q”ŠóÙ…j4¨tП)ÁŸÍ?¶÷CÐQË;å¬çÄ›çÅ›ÿŽ®PuÍÑ©æóVn²¤›®æ–©¦:B‹c}Î2]Ãœ´&~»áµu ÆöØMpø†Ø¶G.B’üFÌXF3QcÎ*ÇF6}`ïÈ®›HcÕìï±)4ÕÖ,­m¡É*ÀÅà‹å{„$ßÅ!Bª!mn;p1¸PÑ„¦º « Íi®ì+‹X.!ÉwsˆK–ì®4$*m½#š× \ ¾2A︆[ «0­ðÁUà«ä{‡$‡‚Þi™­9­#»ïÙbϸ€!BÌbÙE+nïtŸZöÐuõ>ÕÔúOjÅI]ݪÚ9jëZq´OumÍt¼OŒ¼wÓ2Ü™QÿƒÞuë"g¤ >%¸ |W‚ºšt´‰0]±[{{¦¦s([WíT DÔUg\sÒ‹TA\æ™°ÆH™ŽhVÂ!ºY¡æ\~RϹ–­Zãjµ»¥ú¢wT×R›ÞÌšXÌÂú*&Ö½0\½Ô YØÞ/_Õ$ùd›±%ÀP¼Ž7SsšÊˆÆqN¿»Ó–í £ZFõÀ(¢ßIGïZtˆGp5øjùäºÈ ¶ÒËUu—7ütÉ@ åälŽj×UÌ,_Û´UhG7ÒîÎÔŒ÷¢ÛáOÙ¬âúabo×¼À¨Wh­äxøU+ƒ.­u-7˲ øe†~Þö›D¹çù¬íÑ@Ög;o²0˜@çïÆ`zw ot¾ÆéÆyWLu4¸[ óx§°þ×rpN‹âÞ¤rV>¬ëÅÏÅ­¨bôdkkN_ÔšCÒ½¸|¥ÍjLǘ­Oé¶`¹"S¹‰û¼?A÷4QÅjàø€U°Þ ø`Jªƒ'®ŠÅy#W°­’æ c;ðfð›åã:àðr„Á&/‚LI‡€‡Á'.Œž¼qrtÂÖò†7²ÔFxü¸m|X/ÊÑÆ` ¼”’6L n%®®Š.LAeÜüø'ä(ã$ðAðå(£ ü$ø'SRÆŸ?þ©Ä•Ñ>aë3‚šxø%ð/ÉÑÄg€‚?*G| ü±”4ñ7À/ƒ9qM´&uAIü=ð ø9’ø ðið§åHâoÏ€?“’$¾ü6ø·—Dge¾^Lÿ|üE9ºø>ð,øY9ºøàKà/¥¤‹þü§ÉëÂ+|Ý)‹¶ÿ<~NŽ.^¾þ†]ü ø&ø›)éâ¿€o¿•¸.:Jš9©ÅT¡`Ž‡Lú*@ªø_$»ˆr‚2Tñ[$ÛI¹Ò™Ž*̲*]”LX‹lÝŸÀ”ÅÅÀ+('(A æè•+)'(AJ7ðý”LE½Àu”LzæÂÑOÄœ¹P®î¥\Ù+GƒÀ('(CW÷QN0mÜÜO9Á„µ±Ð)h¢½ óJÊm””!Š#ÀQÊ ÊÅMÀÛ)'˜P²óì?z¬ÁZØbÞºg‹ó€›À7U퉶Š¡zÿÈϘZÉÈÝPô×s³Ç‚ š–Xƒø1±ÍM_ÕB£ózSâ=»&&mæ!záÅ3£ybˆ `F³Eíl™XDë–dècG‚]à]"Ö…Zµš®\£k ÔqËVK†ãæV÷ËÂ@ŪÃì5¾^#8>(_H$ù!d›±%ÀpnôÜê/hŒhÚ2˜à"ðE¦µLÚì›ä‰¸Dw Xcwè9WÍ{qÛ#¢v ºZ°¦ˆÞ+qɇQ‹x*#Á}àûb{úfÕÖ¦Ô¼æjjÙ6¼ºˆ¥užåýªºG×&‹®¿àŽäƒÍT©\OŒ\!j†.€NÞ ~sì ]¢uí$Y#èÙëçkÒÌ4sBÏG^oÅ­ Ê\~‰üʵI3¯\ü·W—[Õz3úª+¶^ƒ ’ã–“ÑŒ•Hš¡p9ù‹®Öž¯÷¬9æ¨HƒDÌb}šåàÜŸÌ{«®R^uµ|EÕ)‹çnlQ \-Šžl3—¬Ú¬_%dGÓ9*¯96 •æÊL¥›åóÁýÓD*p|HŽ,.ƒ§$ ¶Êg#øÆÄeÑ9fMç¬ia]ì? Gׂ”£‹k€‡À¥¤‹ÃÀ#àG×E‡×}Ó…Uq+p|\Ž*>œŸ£Š[€ðBJª0€w€ß‘¸*êÓeaQLï¿GŽ(Nï¿WŽ(Žï¿/%QÜ|üäEQ(9¢ø4ð4øi9¢xøøCrDñ1àÃà§$Š/$qQtÕn„°ñ à“àOÊQÆcÀ§ÀŸ’£Œ/Ï€ŸIIOŸ&qe,*ZCƒÂ²ø!ð9ðçäÈâYàóàÏË‘[÷ø )ÉâEàYð³s# ñÎÅ/€¯‚¿*G/_MŽ,^¾þzJ²ø ðø¹äÇ!ž,†…Uñ;ŠÊÊ ÊPÅÛH¶r¥MŽ*Þ@²í”+íé¨BYì œ_æ–T—ÓS…¨(Ìõ)«)'(AÊ J9›aŸcQ(Øê¯\F9ÁTD±¸–r‚sp1\aY 7S®l–# ¶äézÊ ÊÅåÀ-”LE[Û(W¶%.‹%eÛÓÆŒbŒÁˆ‚g¤ÊG('(C{YÊ ÊÇvà­”LE·G)çœ%5ýMÄ£Ñ(§('(CãÀiÊÙñAs­‹Û3”LEwOQN0a]ôØzÎð´‘ÓŠÂÚø8ðó””¡û§)W’œQk¢ l¤U¢\šQK@ؼ©|r‚ kc±­ŸÔmGøéˆò8ð””!ŒGߤœ  a<|’rEh/a<ÆÓJÛlÍixò¥ºo€!BÌbÙ>e¸…Þ’›Ól§O--·7o8å>µTžèSsú´ºUŹÏïSnsoïºu':¿%¸|{ì\l‘‹¾ÈyX » bÎŽ`Ì<\¤VήöÅ Y…Q*W›ÄÎ#ç¿Ý­ÙY bY¸ fÜ.t«ÉÂ`Ó,”s/ Ã,3×D—ƘJp|0¶Ù›U5gk‹7¸Ÿºw 9åiÓàš>uÍXQË_#Tîka4ÁÍàÂ]¬ºdfõi­T.êaý†K‘¦ãÓj÷Iò-Š·û±Ì`g{2.Ý|öïJ¤—I3¬çF>«Æ.i9Û"[-Ø“ ¾ ëÉóöÀ¯[³ŽÿB$vyÿH .«•ˆó²9›‹Öe~V÷ßØÄâ, |Ï˵©5©Ó;ÝÈÞÁÄâ- MðøX¾ÖöÀ÷Ö¤[Ÿ·š8mÙqcbÒÖ¹hK˜½0£c~])Ò‘g%B{]Ór›]a!zqc|¤%U_ÔÙÝšÕKåB}……švdGòd’Ñï-V~TÕ¢¬39æÐý@M\:?›7먉Ӟut]+:VmöØ’9ÐfÓ*;†S›ƒºˆ‹²¦>•³J%ÿg•¨Ö¾×Çwu‡KÐ…‹³e¯Rú»é\½™êÚ²%Ý-X|”e!¶-Èbw%VwX¬µº™7ƹXkCjÝÉð <+=´zÊ;Áû0(ÿÀ£‘C.ìÉl¬iõ<©ñmÊ¢º‚Ô&½‚´ëÓ $Þ6ÔT ^=÷}wž‹µf±!-¤Z³êkçÕ궬ãÚVM”Õ4P0“v1Ü¥u5+XCÛfqýÙbÞrùëªk$¸) ^ AéÔ]¦.±ÅY[ŸU-lÏ×g¦,›SßLÝ8«Ú啼5içš7ÚxK_£6°Ãs±WäŠ\¬ž:³É|–qg N½Ekq3¯óUyME»&ÂòPá‘ÆÊ)XS™šÆªJI«f™Å™ðÈ!ÒÐKšÁ‹/¼I'}s¦Ô¤ö²y¾J„¥¡JoÞö´û™µ'ù8õí­lš´{ƒWÖº§Í\M$¬QhÏÖ«·>»cV1!D•ù[&k;õžs¾(^oÃh”ZîØLY¯Ï×,ntî¾òÃÅ¡â”õœ¡5h¤š&Оuµ±ÉbMË_ß­ðâd7O ²Gõé2……¡¥=’?\®i :êKJw=½ÏFžPÊÛG°mÚ0˶É׋ïuÄ»´ø~rHçÀoÞ¢ÌËÖô¬™Ÿ-ŸÅ ªa ×¼´¯—eËÞÐÙËȾÑÂ’ZÕ`WÛm«m“½ü¦úÎÿhÕÄGlÝ!g[lµó}Žë%½Õßœ~ë)ײŠÎæÍ›Gò£0j”ë×ô®Y;´fÝÝ!£8~z ‹cøM‡ü(‹|s_ÿγÿ:úôöyü}ý»c¶fÏ Ü`{w;ïözÜég ŒèôFé 8ÍÖFòt@9àÌ8^^yóì»ó8€qê‘!‰£\U'¨‘ïFŒô® •Í H…`ÈŒ[nÖ³hPwì<äWâ$²}­ß 9Upݲ³y`€\»d}Ù¶È 8ý–=1€ê³uíÐݧHãqÊ#aEÀè<~P´‚7IdzBçr¼R<Ç¡=>UôÄ<íåÉštO}ôî»O©a¹Z…œŒëØàH“–ð1:í„W·EoýIÆí"wrNæÃàNJàM˧›•Ï~ohì÷Þ’(¡ÑKÈ é7.#îíç™ÛÀo‹SF î®{îÙäØþÇ’) {)gCãòÀÁ¨>†ÜKg_5åÐÅÊa'¦ ’(‚íÑ‹€ÎV4Îýä˜ {mL6‘öp¾×á7’É÷u³Ï·ônœãä’àð±ý½”ùû f˜^ïÝÔòùîè>/ULh\ ü³‡ñ–2Зj&#ytäjªTä£×5èSºJ?´Úï)ÛzÙë²’"õûÎÛÏeØ?Ï ÿ´¯eçF}W¨ûtÓŸÒÉ«c3ªmMÏLèæðf5o©¦åªzÞpÉ…ŠJê„Ô¶ûðÁƒ{5ÚÈ×öÏÙXá‰ÇKßeŸÇ+Ü æŸš·«½Ë‡ ñ"w®ç¹×|Š~…z¤¨kŽNÅ—·rþÄ+=‚Ñ0Õ¯Ã]\_)å~;º.[`4ÁÁL]ŸUÐðÈåG’âAÀŒÐÅó³zÍßöŽì 1œ¶ÜäŽnZhªlª94YÈœ)Û1$ùå"¼CšÌvààB%šjåÙQhº 0ä•Ã²ð}r4¼üÆ”´xøMsé M"º˜ÏÉq{1D<Ÿ’ƒtà8øxbê!®Ñó±Ú·ð.ð»äxgx7øÝ)yç£À{Àï™3ïÕ?~ü³r¼s/ðsàŸKÉ;Ÿž?˜wºhã¶ÏÖu³h£ˆoþøð¯ÈñÍCÀ¯‚5%ß| øuð¯'æ›Næm¦_¨Ö< |üY9žù;à÷À¿—’g¾üøóÌRêÚðÚ6ÁšóÏÀ—Á_–ãœQ’ù9øÏSòÏ¿_%1ÿtóþªÿ'ð-ð·ä8çß¿ÿmJÎùoàÛàoÏ•s„zk¿§ÈVBóo¥žKçü’]L9Á4œãoþ ØM9Û-’\ιë(˜ÆðÏ]‘©9#t}£ô/§œ`*¾Áÿ…ÜWdj^ÈÓ7+·:Ÿ‡T0¡ì¢œ  ½¸›r‚©øhp/åüû¸cúhy˜þHÄEXÄåÑx SóÂä¹tÑ @r‚©¸h ˜£\š- oâvk®>aÙFN+ŠÝ~”;€S”ó†Î¥o°¢Í?04Ÿ©90Tªof€wRN0!ß,ñ¢®uP› ërú‡®qÏ}À¿ œ  ÷œþ%åSqÏ_?C9Á„ܳ쨫—Ëzþ¨~b’¼Æ«@׈8o®Q¾J¹"4vî Ï¿F9Á„’~0Nt÷1dÓJ´'ññO„ëàÌÙ ¾5ª9L‰÷”œ˜´C±’<®ˆðn(bR ‡Ñ‹%™ávqˆ `ÿíú(«¦¢šŒQ”ÜZÓ„„u¾Ã☺ãH+¾Œº!†ñdÿ°8i‡Ãâ‹e€lâõÔ[»ŠjM`¢hͺޡAç–ÀÀb[Ý?{«¯0z) %ØÞ?w lh¿y1¹špÝZu·fª“Ž®’³ÓÔÊ‘c¦êZª÷Co jjÎ?r’œ8É"D¶Ÿ[HçŸ1«djΘu¾çwGݲ^ ø>ø°“Hv8ºó¹Å. :ÿúŠb«Åí›M2³®×ÑOôö©C}jQ7'ÜB¿5éª[Õ ƒ"¾ažÉÇClc6ßM|ëArì…ã)µÝ$ùÅÛîXf°5: …K#B÷™ý[…ô2"i†uÌÈg]ä3,Çëyö½ 6}•‚¹It‘I®î÷‰Bvw]É{»»ªn©[+¹KÌ-þ¹©£¦>õÿyg—-Öhõžwg—_ºqwtq»ªc,´£k‡f„¾‹¯"¾FfÍb7W7x·ˆY æ+f±›«¼G¾SHòK8DHÈ)í†Óßô•³ØÈÕ žœOf·‘+E§Ì‡#&ë”Vð;´:Á;%x„ß¡Å:9‹å{„$ßÅa`r(­¶kA¦ºQ«\H¯½Ânƒ™Ù^as òÊÚÝlˆí9†O%wdkÌ?â(¢ÁmðÁ«À¯JÐ_ö9ò»æ®¿Z¾¿Hò}"úkÖ»×ÀÛÃCÌbÙQ©ÍþǾªtú¼Žœÿζ>uÌÓÖqòÂ}ÚÕͼž¥Ÿˆ¼Íñû‰ƒïˆ ªJåîIÉ(ÏD¯{J3!Çâ÷®ßoŽ÷©Þ3 ì¡ Á à¬vs²]œìV`À/«>ä[8D¬K“x Í!™Ij7'Á¶Lu‹d`7çì- µhY m4…ÕULlÑà¡'×#âß<"[Ç/ãA¶](†âµº™~VÔѼîLepo ™ {Þ94>iú{[ûTËö%Lö'W?t ^K^Ömb¸ãý¥‹]öîÄdžƒØI ½:›2ŠE6¢:VIW^¼\AmQs²Ö¯I4'ûIÁsw}o8L7DhÆI|XbYô³¬ÙºZÒ5Ó“ÞødÑû]Ôì¬Eîß;;WX¶1a˜ZQ¥G⋼‹ÝÓ°ƒVcÞ-η·„Íè°ÞjJ÷ ’| ‡ñî±[%梛㯈]›©®{}С9æhÓµBMH²'SËÁ¹#)3ïšÈ*ÖPúJÆP§°e +ÀWTâÄíûÎâxRn>$z² œÃƒWfjúàìhVei®f„+Í•ÀAðÁýÓD*p|HŽ,Øø{|8%Y°…'Á7&.‹Î1k:gM ëb'ðø9º`{’‚”£ vì!ðC)éâ0ðø‘ÄuÑ‘÷n!ª¸8>.GN€OÈQÅ-Àx!%UÀ;ÀïH\ ½a•°(¦€÷€ß#G'€÷‚ß+GÇ÷ß—’(î>þ@ò¢(”aQ|xü´Q<|ü!9¢øðað‡SΈÉ<þHâ¢è2òäwFXOŸRŽ2>þ”e|xüLJÊxø ø3ÉDŠÖÄР°,~|ü99²xø<øórdñ-à à/¤$‹gÁÏÎ,Ä;¿¾ þªY¼ | ü59²x ø:øë)Éâ7Àsàç’‡x²VÅï(* ('(Co#Ù6Ê ÊPÅH¶r¥=U( ”+‰«b¡§ QQ(˜ëSVSNP‚(”%@•rE•" ûˆ”Ë('˜Š(Ö×RΟ\œàÄp…e1ÜL9A²¸ x=åÊõrdghÊÊ•-)Éb+påʶÄe±¤l[cÚ˜QŒ1QðŒ]ùåeˆc/0K9Aâؼ•r‚©ˆã6à(åG'GŒF£œ¢œ?¬x.u1œ¦œ?¬x.uq;p†r‚©èâNà)Ê &¬‹[Ïž6rZQX~žr‚2´q?ð4åJ’3jM´qð!Ê¡µ´ñ0ð ”LX‹mÝ_$,ŒÇß œ  a< ü&åeãà“”+Bóx ã)àʱ¶¦cUç„-~+Á›ƒ”QNP†*¾ü1åe¨óŒÊO('˜Š*ž>O9Á¤Uá%ñ¶âà/)'(C?þŠr‚2Tñð×”L(Ùè‡Èã}*>nßTµGÖ:?’üu"D7#4Õö¬£ëZѱBR¾™fçò!DK™ÄHþ|vbR ‡²}³yb(TB¬”f)Köóþ¿D¼B>ûƒ9œ5±S@ÌJ¾«¶Ydû¼æ±9È]½ì] c†º£_1ƬM5óûÿ5`²ùscales/DESCRIPTION0000644000175100001440000000157113010656330013251 0ustar hornikusersPackage: scales Version: 0.4.1 Authors@R: c( person("Hadley", "Wickham", , "hadley@rstudio.com", c("aut", "cre")), person("RStudio", role = "cph") ) Title: Scale Functions for Visualization Description: Graphical scales map data to aesthetics, and provide methods for automatically determining breaks and labels for axes and legends. URL: https://github.com/hadley/scales BugReports: https://github.com/hadley/scales/issues Depends: R (>= 2.13) Imports: RColorBrewer, dichromat, plyr, munsell (>= 0.2), labeling, methods, Rcpp LinkingTo: Rcpp Suggests: testthat (>= 0.8), covr, hms License: MIT + file LICENSE LazyLoad: yes RoxygenNote: 5.0.1 NeedsCompilation: yes Packaged: 2016-11-08 19:11:18 UTC; hadley Author: Hadley Wickham [aut, cre], RStudio [cph] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2016-11-09 18:28:56 scales/man/0000755000175100001440000000000013010421526012307 5ustar hornikusersscales/man/cscale.Rd0000644000175100001440000000206612651520667014054 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-continuous.r \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/boxcox_trans.Rd0000644000175100001440000000057312651520667015334 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \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/grey_pal.Rd0000644000175100001440000000075512651520667014427 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-grey.r \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/linetype_pal.Rd0000644000175100001440000000043312651520667015303 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-linetype.r \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/show_col.Rd0000644000175100001440000000116612651520667014437 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-manip.r \name{show_col} \alias{show_col} \title{Show colours.} \usage{ show_col(colours, labels = TRUE, borders = NULL) } \arguments{ \item{colours}{a character vector of colours} \item{labels}{boolean, whether to show the hexadecimal representation of the colours in each tile} \item{borders}{colour of the borders of the tiles; matches the \code{border} argument of \code{\link[graphics]{rect}}. The default means \code{par("fg")}. Use \code{border = NA} to omit borders.} } \description{ A quick and dirty way to show colours in a plot. } scales/man/manual_pal.Rd0000644000175100001440000000045712651520667014735 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-manual.r \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/trans_range.Rd0000644000175100001440000000067712651520667015133 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.r \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/date_format.Rd0000644000175100001440000000070112651520667015101 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-date.r \name{date_format} \alias{date_format} \title{Formatted dates.} \usage{ date_format(format = "\%Y-\%m-\%d", tz = "UTC") } \arguments{ \item{format}{Date format using standard POSIX specification. See \code{\link{strptime}} for possible formats.} \item{tz}{a time zone name, see \code{\link{timezones}}. Defaults to UTC} } \description{ Formatted dates. } scales/man/date_breaks.Rd0000644000175100001440000000063612651520667015067 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-date.r \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/trans_breaks.Rd0000644000175100001440000000142012651520667015271 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/breaks.r \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/hms_trans.Rd0000644000175100001440000000061212775474420014615 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-date.r \name{hms_trans} \alias{hms_trans} \title{Transformation for times (class hms).} \usage{ hms_trans() } \description{ Transformation for times (class hms). } \examples{ if (require("hms")) { hms <- round(runif(10) * 86400) t <- hms_trans() t$transform(hms) t$inverse(t$transform(hms)) t$breaks(hms) } } scales/man/train_discrete.Rd0000644000175100001440000000103612775173714015621 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-discrete.r \name{train_discrete} \alias{train_discrete} \title{Train (update) a discrete scale} \usage{ train_discrete(new, existing = NULL, drop = FALSE, na.rm = FALSE) } \arguments{ \item{new}{New data to add to scale} \item{existing}{Optional existing scale to update} \item{drop}{\code{TRUE}, will drop factor levels not associated with data} \item{na.rm}{If \code{TRUE}, will remove missing values} } \description{ Train (update) a discrete scale } scales/man/math_format.Rd0000644000175100001440000000160212651520667015116 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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 parameter 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/col2hcl.Rd0000644000175100001440000000103012651520667014136 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-manip.r \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{c}{new chroma} \item{l}{new luminance} \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/asn_trans.Rd0000644000175100001440000000037012651520667014606 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{asn_trans} \alias{asn_trans} \title{Arc-sin square root transformation.} \usage{ asn_trans() } \description{ Arc-sin square root transformation. } scales/man/probability_trans.Rd0000644000175100001440000000114112651520667016342 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \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/colour_ramp.Rd0000644000175100001440000000302412651520667015137 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-mapping.r \name{colour_ramp} \alias{colour_ramp} \title{Fast color interpolation} \usage{ colour_ramp(colors, na.color = NA, alpha = FALSE) } \arguments{ \item{colors}{Colors to interpolate; must be a valid argument to \code{\link[grDevices]{col2rgb}}. This can be a character vector of \code{"#RRGGBB"} or \code{"#RRGGBBAA"}, color names from \code{\link[grDevices]{colors}}, or a positive integer that indexes into \code{\link[grDevices]{palette}()}.} \item{na.color}{The color to map to \code{NA} values (for example, \code{"#606060"} for dark grey, or \code{"#00000000"} for transparent) and values outside of [0,1]. Can itself by \code{NA}, which will simply cause an \code{NA} to be inserted into the output.} \item{alpha}{Whether to include alpha channels in interpolation; otherwise, any alpha information will be discarded. If \code{TRUE} then the returned function will provide colors in \code{"#RRGGBBAA"} format instead of \code{"#RRGGBB"}.} } \value{ A function that takes a numeric vector and returns a character vector of the same length with RGB or RGBA hex colors. } \description{ Returns a function that maps the interval [0,1] to a set of colors. Interpolation is performed in the CIELAB color space. Similar to \code{\link[grDevices]{colorRamp}(space = 'Lab')}, but hundreds of times faster, and provides results in \code{"#RRGGBB"} (or \code{"#RRGGBBAA"}) character form instead of RGB color matrices. } \seealso{ \link[grDevices]{colorRamp} } scales/man/comma_format.Rd0000644000175100001440000000160212651520667015261 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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 parameter 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)) # If you're European you can switch . and , with the more general # format_format point <- format_format(big.mark = ".", decimal.mark = ",", scientific = FALSE) point(c(1, 1e3, 2000, 1e6)) point(c(1, 1.021, 1000.01)) } scales/man/sqrt_trans.Rd0000644000175100001440000000035312651520667015017 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{sqrt_trans} \alias{sqrt_trans} \title{Square-root transformation.} \usage{ sqrt_trans() } \description{ Square-root transformation. } scales/man/wrap_format.Rd0000644000175100001440000000113212651520667015134 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \name{wrap_format} \alias{wrap_format} \title{Wrap text to a specified width, adding newlines for spaces if text exceeds the width} \usage{ wrap_format(width) } \arguments{ \item{width}{value above which to wrap} } \value{ Function with single parameter x, a character vector, that returns a wrapped character vector } \description{ Wrap text to a specified width, adding newlines for spaces if text exceeds the width } \examples{ wrap_10 <- wrap_format(10) wrap_10('A long line that needs to be wrapped') } scales/man/identity_trans.Rd0000644000175100001440000000041312651520667015654 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{identity_trans} \alias{identity_trans} \title{Identity transformation (do nothing).} \usage{ identity_trans() } \description{ Identity transformation (do nothing). } scales/man/log_trans.Rd0000644000175100001440000000047112651520667014610 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \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/log1p_trans.Rd0000644000175100001440000000047412651520667015054 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{log1p_trans} \alias{log1p_trans} \title{Log plus one transformation.} \usage{ log1p_trans() } \description{ Log plus one transformation. } \examples{ trans_range(log_trans(), 1:10) trans_range(log1p_trans(), 0:9) } scales/man/log_breaks.Rd0000644000175100001440000000067712651520667014740 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/breaks.r \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/rescale_none.Rd0000644000175100001440000000056012651520667015254 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/squish_infinite.Rd0000644000175100001440000000072012651520667016016 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/censor.Rd0000644000175100001440000000102412651520667014104 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/dscale.Rd0000644000175100001440000000074512651520667014057 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-discrete.r \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/discard.Rd0000644000175100001440000000066312651520667014234 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/rescale_max.Rd0000644000175100001440000000116112651520667015100 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/as.trans.Rd0000644000175100001440000000044412651520667014351 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.r \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/muted.Rd0000644000175100001440000000066712651520667013745 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-manip.r \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/reciprocal_trans.Rd0000644000175100001440000000037312651520667016153 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{reciprocal_trans} \alias{reciprocal_trans} \title{Reciprocal transformation.} \usage{ reciprocal_trans() } \description{ Reciprocal transformation. } scales/man/exp_trans.Rd0000644000175100001440000000054212651520667014622 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \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/seq_gradient_pal.Rd0000644000175100001440000000137312651520667016123 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-gradient.r \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. Must be "Lab" - other values are deprecated.} } \description{ Sequential colour gradient palette (continous). } \examples{ x <- seq(0, 1, length.out = 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.Rd0000644000175100001440000000136312651520667016311 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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 parameter 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/unit_format.Rd0000644000175100001440000000143712651520667015152 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \name{unit_format} \alias{unit_format} \title{Add units to the labels} \usage{ unit_format(unit = "m", scale = 1, sep = " ", ...) } \arguments{ \item{unit}{The units to append} \item{scale}{A scaling factor. Useful if the underlying data is on another scale} \item{sep}{The separator between the number and the label} \item{...}{Arguments passed on to \code{\link{format}}} } \description{ Add units to the labels } \examples{ # labels in kilometer when the raw data are in meter km <- unit_format(unit = "km", scale = 1e-3, digits = 2) km(runif(10) * 1e3) # labels in hectares, raw data in square meters ha <- unit_format(unit = "ha", scale = 1e-4) km(runif(10) * 1e5) } \seealso{ \code{\link{comma}} } scales/man/extended_breaks.Rd0000644000175100001440000000134612651520667015751 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/breaks.r \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/shape_pal.Rd0000644000175100001440000000044712651520667014557 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-shape.r \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/div_gradient_pal.Rd0000644000175100001440000000174412651520667016117 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-gradient.r \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. Must be "Lab" - other values are deprecated.} } \description{ Diverging colour gradient (continous). } \examples{ x <- seq(-1, 1, length.out = 100) r <- sqrt(outer(x^2, x^2, "+")) image(r, col = div_gradient_pal()(seq(0, 1, length.out = 12))) image(r, col = div_gradient_pal()(seq(0, 1, length.out = 30))) image(r, col = div_gradient_pal()(seq(0, 1, length.out = 100))) library(munsell) image(r, col = div_gradient_pal(low = mnsl(complement("10R 4/6", fix = TRUE)))(seq(0, 1, length = 100))) } scales/man/alpha.Rd0000644000175100001440000000103712651520667013704 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-manip.r \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.out = 10)) } scales/man/ordinal_format.Rd0000644000175100001440000000106112651520667015614 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \name{ordinal_format} \alias{ordinal} \alias{ordinal_format} \title{Ordinal formatter: add ordinal suffixes (-st, -nd, -rd, -th) to numbers.} \usage{ ordinal_format(x) ordinal(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{ Ordinal formatter: add ordinal suffixes (-st, -nd, -rd, -th) to numbers. } \examples{ ordinal_format()(1:10) ordinal(1:10) } scales/man/identity_pal.Rd0000644000175100001440000000041412651520667015302 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-identity.r \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/area_pal.Rd0000644000175100001440000000055512651520667014367 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-area.r \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/train_continuous.Rd0000644000175100001440000000060712651520667016224 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale-continuous.r \name{train_continuous} \alias{train_continuous} \title{Train (update) a continuous scale} \usage{ train_continuous(new, existing = NULL) } \arguments{ \item{new}{New data to add to scale} \item{existing}{Optional existing scale to update} } \description{ Train (update) a continuous scale } scales/man/brewer_pal.Rd0000644000175100001440000000174412651520667014746 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-brewer.r \name{brewer_pal} \alias{brewer_pal} \title{Color Brewer palette (discrete).} \usage{ brewer_pal(type = "seq", palette = 1, direction = 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}} \item{direction}{Sets the order of colors in the scale. If 1, the default, colors are as output by \code{\link[RColorBrewer]{brewer.pal}}. If -1, the order of colors is reversed.} } \description{ Color Brewer palette (discrete). } \examples{ show_col(brewer_pal()(10)) show_col(brewer_pal("div")(5)) show_col(brewer_pal(palette = "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.out = 30))) } \references{ \url{http://colorbrewer2.org} } scales/man/fullseq.Rd0000644000175100001440000000072612651520667014276 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/full-seq.r \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/cbreaks.Rd0000644000175100001440000000306312651520667014232 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/breaks.r \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/rescale_mid.Rd0000644000175100001440000000134512651520667015070 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/time_trans.Rd0000644000175100001440000000115312775215037014762 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-date.r \name{time_trans} \alias{time_trans} \title{Transformation for date-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 date-times (class POSIXt). } \examples{ hours <- seq(ISOdate(2000,3,20, tz = ""), by = "hour", length.out = 10) t <- time_trans() t$transform(hours) t$inverse(t$transform(hours)) t$format(t$breaks(range(hours))) } scales/man/rescale.Rd0000644000175100001440000000122012651520667014227 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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, finite = 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/col_numeric.Rd0000644000175100001440000001051512651520667015117 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/colour-mapping.r \name{col_numeric} \alias{col_bin} \alias{col_factor} \alias{col_numeric} \alias{col_quantile} \title{Color mapping} \usage{ col_numeric(palette, domain, na.color = "#808080") col_bin(palette, domain, bins = 7, pretty = TRUE, na.color = "#808080") col_quantile(palette, domain, n = 4, probs = seq(0, 1, length.out = n + 1), na.color = "#808080") col_factor(palette, domain, levels = NULL, ordered = FALSE, na.color = "#808080") } \arguments{ \item{palette}{The colors or color function that values will be mapped to} \item{domain}{The possible values that can be mapped. For \code{col_numeric} and \code{col_bin}, this can be a simple numeric range (e.g. \code{c(0, 100)}); \code{col_quantile} needs representative numeric data; and \code{col_factor} needs categorical data. If \code{NULL}, then whenever the resulting color function is called, the \code{x} value will represent the domain. This implies that if the function is invoked multiple times, the encoding between values and colors may not be consistent; if consistency is needed, you must provide a non-\code{NULL} domain.} \item{na.color}{The color to return for \code{NA} values. Note that \code{na.color=NA} is valid.} \item{bins}{Either a numeric vector of two or more unique cut points or a single number (greater than or equal to 2) giving the number of intervals into which the domain values are to be cut.} \item{pretty}{Whether to use the function \code{\link{pretty}()} to generate the bins when the argument \code{bins} is a single number. When \code{pretty = TRUE}, the actual number of bins may not be the number of bins you specified. When \code{pretty = FALSE}, \code{\link{seq}()} is used to generate the bins and the breaks may not be "pretty".} \item{n}{Number of equal-size quantiles desired. For more precise control, use the \code{probs} argument instead.} \item{probs}{See \code{\link[stats]{quantile}}. If provided, the \code{n} argument is ignored.} \item{levels}{An alternate way of specifying levels; if specified, domain is ignored} \item{ordered}{If \code{TRUE} and \code{domain} needs to be coerced to a factor, treat it as already in the correct order} } \value{ A function that takes a single parameter \code{x}; when called with a vector of numbers (except for \code{col_factor}, which expects factors/characters), #RRGGBB color strings are returned. } \description{ Conveniently maps data values (numeric or factor/character) to colors according to a given palette, which can be provided in a variety of formats. } \details{ \code{col_numeric} is a simple linear mapping from continuous numeric data to an interpolated palette. \code{col_bin} also maps continuous numeric data, but performs binning based on value (see the \code{\link[base]{cut}} function). \code{col_quantile} similarly bins numeric data, but via the \code{\link[stats]{quantile}} function. \code{col_factor} maps factors to colors. If the palette is discrete and has a different number of colors than the number of factors, interpolation is used. The \code{palette} argument can be any of the following: \enumerate{ \item{A character vector of RGB or named colors. Examples: \code{palette()}, \code{c("#000000", "#0000FF", "#FFFFFF")}, \code{topo.colors(10)}} \item{The name of an RColorBrewer palette, e.g. \code{"BuPu"} or \code{"Greens"}.} \item{A function that receives a single value between 0 and 1 and returns a color. Examples: \code{colorRamp(c("#000000", "#FFFFFF"), interpolate="spline")}.} } } \examples{ pal <- col_bin("Greens", domain = 0:100) show_col(pal(sort(runif(10, 60, 100)))) # Exponential distribution, mapped continuously show_col(col_numeric("Blues", domain = NULL)(sort(rexp(16)))) # Exponential distribution, mapped by interval show_col(col_bin("Blues", domain = NULL, bins = 4)(sort(rexp(16)))) # Exponential distribution, mapped by quantile show_col(col_quantile("Blues", domain = NULL)(sort(rexp(16)))) # Categorical data; by default, the values being colored span the gamut... show_col(col_factor("RdYlBu", domain = NULL)(LETTERS[1:5])) # ...unless the data is a factor, without droplevels... show_col(col_factor("RdYlBu", domain = NULL)(factor(LETTERS[1:5], levels=LETTERS))) # ...or the domain is stated explicitly. show_col(col_factor("RdYlBu", levels = LETTERS)(LETTERS[1:5])) } scales/man/expand_range.Rd0000644000175100001440000000102612651520667015250 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/atanh_trans.Rd0000644000175100001440000000035612651520667015124 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{atanh_trans} \alias{atanh_trans} \title{Arc-tangent transformation.} \usage{ atanh_trans() } \description{ Arc-tangent transformation. } scales/man/hue_pal.Rd0000644000175100001440000000171712651520667014241 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-hue.r \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{c}{chroma (intensity of colour), maximum value varies depending on combination of hue and luminance.} \item{l}{luminance (lightness), in [0, 100]} \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/pretty_breaks.Rd0000644000175100001440000000120512651520667015472 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/breaks.r \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/rescale_pal.Rd0000644000175100001440000000070212651520667015067 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-rescale.r \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/dichromat_pal.Rd0000644000175100001440000000124012651520667015421 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-dichromat.r \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.out = 30))) } scales/man/gradient_n_pal.Rd0000644000175100001440000000135012651520667015563 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-gradient.r \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. Must be "Lab" - other values are deprecated.} } \description{ Arbitrary colour gradient palette (continous). } scales/man/reverse_trans.Rd0000644000175100001440000000035412651520667015502 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-numeric.r \name{reverse_trans} \alias{reverse_trans} \title{Reverse transformation.} \usage{ reverse_trans() } \description{ Reverse transformation. } scales/man/trans_format.Rd0000644000175100001440000000113412651520667015314 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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 parameter 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/date_trans.Rd0000644000175100001440000000065712651520667014752 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans-date.r \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$transform(years) t$inverse(t$transform(years)) t$format(t$breaks(range(years))) } scales/man/squish.Rd0000644000175100001440000000111512651520667014130 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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/package-scales.Rd0000644000175100001440000000042712651520667015464 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scales.r \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/percent_format.Rd0000644000175100001440000000111412651520667015623 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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 parameter 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/zero_range.Rd0000644000175100001440000000304512651520667014753 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bounds.r \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 = 1000 * .Machine$double.eps) } \arguments{ \item{x}{numeric range: vector of length 2} \item{tol}{A value specifying the tolerance.} } \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 * 1000 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 + 1001 * 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 + 1001 * eps)) # FALSE zero_range(.00001 * c(1, 1 + eps)) # TRUE zero_range(.00001 * c(1, 1 + 1001 * 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/format_format.Rd0000644000175100001440000000076112651520667015462 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \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/Range-class.Rd0000644000175100001440000000057412651520667014763 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/range.r \docType{class} \name{Range-class} \alias{ContinuousRange} \alias{DiscreteRange} \alias{Range} \alias{Range-class} \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/dollar_format.Rd0000644000175100001440000000277512651520667015456 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \name{dollar_format} \alias{dollar} \alias{dollar_format} \title{Currency formatter: round to nearest cent and display dollar sign.} \usage{ dollar_format(prefix = "$", suffix = "", largest_with_cents = 1e+05, ..., big.mark = ",", negative_parens = FALSE) dollar(x) } \arguments{ \item{prefix, suffix}{Symbols to display before and after amount.} \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{...}{Other arguments passed on to \code{\link{format}}.} \item{big.mark}{Character used between every 3 digits.} \item{negative_parens}{Should negative values be shown with parentheses?} \item{x}{a numeric vector to format} } \value{ a function with single parameter 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)) usd <- dollar_format(prefix = "USD ") usd(c(100, -100)) euro <- dollar_format(prefix = "", suffix = "\\u20ac") euro(100) finance <- dollar_format(negative_parens = TRUE) finance(c(-100, 100)) } scales/man/trans_new.Rd0000644000175100001440000000246012651520667014620 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trans.r \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/abs_area.Rd0000644000175100001440000000056212651520667014356 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal-area.r \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/man/parse_format.Rd0000644000175100001440000000075112651520667015303 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatter.r \name{parse_format} \alias{parse_format} \title{Parse a text label to produce expressions for plotmath.} \usage{ parse_format() } \value{ a function with single parameter 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/LICENSE0000644000175100001440000000006113010421256012536 0ustar hornikusersYEAR: 2010-2016 COPYRIGHT HOLDER: Hadley Wickham