scales/0000755000176200001440000000000012566717477011552 5ustar liggesusersscales/tests/0000755000176200001440000000000012325313141012661 5ustar liggesusersscales/tests/testthat.R0000644000176200001440000000007012325313150014641 0ustar liggesuserslibrary(testthat) library(scales) test_check("scales") scales/tests/testthat/0000755000176200001440000000000012566717477014554 5ustar liggesusersscales/tests/testthat/test-zero-range.r0000644000176200001440000000421112536070610017735 0ustar liggesuserscontext("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-alpha.r0000644000176200001440000000145012553731560016762 0ustar liggesuserscontext("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.r0000644000176200001440000000627212536563561017714 0ustar liggesuserscontext("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%") }) # 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.r0000644000176200001440000000541512536046022017174 0ustar liggesuserscontext("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.r0000644000176200001440000000125212553731560016764 0ustar liggesuserscontext("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.r0000644000176200001440000000040511666154730017025 0ustar liggesuserscontext("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.r0000644000176200001440000000017611726426476017737 0ustar liggesuserscontext("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-trans-date.r0000644000176200001440000000200011775336742017737 0ustar liggesuserscontext("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-rescale.R0000644000176200001440000000020512554266001017242 0ustar liggesuserscontext("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.r0000644000176200001440000000172412055506613017167 0ustar liggesuserscontext("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.r0000644000176200001440000000171612566632217017001 0ustar liggesuserscontext("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/0000755000176200001440000000000012566662515012331 5ustar liggesusersscales/src/colors.cpp0000644000176200001440000001611012566662515014335 0ustar liggesusers#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_IsNA(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.cpp0000644000176200001440000000266312566662515015335 0ustar liggesusers// This file was generated by Rcpp::compileAttributes // 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 __result; Rcpp::RNGScope __rngScope; 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); __result = Rcpp::wrap(doColorRamp(colors, x, alpha, naColor)); return __result; END_RCPP } // rgbToLab NumericVector rgbToLab(NumericVector rgb); RcppExport SEXP scales_rgbToLab(SEXP rgbSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< NumericVector >::type rgb(rgbSEXP); __result = Rcpp::wrap(rgbToLab(rgb)); return __result; END_RCPP } // rgbToXyz NumericVector rgbToXyz(NumericVector rgb); RcppExport SEXP scales_rgbToXyz(SEXP rgbSEXP) { BEGIN_RCPP Rcpp::RObject __result; Rcpp::RNGScope __rngScope; Rcpp::traits::input_parameter< NumericVector >::type rgb(rgbSEXP); __result = Rcpp::wrap(rgbToXyz(rgb)); return __result; END_RCPP } scales/NAMESPACE0000644000176200001440000000403612566643143012760 0ustar liggesusers# Generated by roxygen2 (4.1.1): 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(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/NEWS0000644000176200001440000001264012566613370012237 0ustar liggesusersVersion 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. Version 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). Version 0.2.4 ------------------------------------------------------------------------------ * Eliminate stringr dependency. * Fix outstanding errors in R CMD check Version 0.2.3 ------------------------------------------------------------------------------ * `floor_time` calls `to_time`, but that function was moved into a function so it was no longer available in the scales namespace. Now `floor_time` has its own copy of that function. (Thanks to Stefan Novak) * Color palettes generated by `brewer_pal` no longer give warnings when fewer than 3 colors are requested. (Winston Chang) * `abs_area and `rescale_max` functions have been added, for scaling the area of points to be proportional to their value. These are used by `scale_size_area` in ggplot2. Version 0.2.2 ------------------------------------------------------------------------------ * `zero_range` has improved behaviour thanks to Brian Diggs. * `brewer_pal` complains if you give it an incorrect palette type. (Fixes #15, thanks to Jean-Olivier Irisson) * `shape_pal` warns if asked for more than 6 values. (Fixes #16, thanks to Jean-Olivier Irisson) * `time_trans` gains an optional argument `tz` to specify the time zone to use for the times. If not specified, it will be guess from the first input with a non-null time zone. * `date_trans` and `time_trans` now check that their inputs are of the correct type. This prevents ggplot2 scales from silently giving incorrect outputs when given incorrect inputs. * Change the default breaks algorithm for `cbreaks()` and `trans_new()`. Previously it was `pretty_breaks()`, and now it's `extended_breaks()`, which uses the `extended()` algorithm from the labeling package. * fixed namespace problem with `fullseq` Version 0.2.1 ------------------------------------------------------------------------------ * `suppressWarnings` from `train_continuous` so zero-row or all infinite data frames don't potentially cause problems. * check for zero-length colour in `gradient_n_pal` * added `extended_breaks` which implements an extension to Wilkinson's labelling approach, as implemented in the `labeling` package. This should generally produce nicer breaks than `pretty_breaks`. * `alpha` can now preserve existing alpha values if `alpha` is missing. * `log_breaks` always gives breaks evenly spaced on the log scale, never evenly spaced on the data scale. This will result in really bad breaks for some ranges (e.g 0.5-0.6), but you probably shouldn't be using log scales in that situation anyway. Version 0.2.0 ------------------------------------------------------------------------------ * `censor` and `squish` gain `only.finite` argument and default to operating only on finite values. This is needed for ggplot2, and reflects the use of Inf and -Inf as special values. * `bounds` functions now `force` evaluation of range to avoid bug with S3 method dispatch inside primitive functions (e.g. `[`) * Simplified algorithm for `discrete_range` that is robust to `stringsAsFactors` global option. Now, the order of a factor will only be preserved if the full factor is the first object seen, and all subsequent inputs are subsets of the levels of the original factor. * `scientific` ensures output is always in scientific format and off the specified number of significant digits. `comma` ensures output is never in scientific format. (Fixes #7) * Another tweak to `zero_range` to better detect when a range has zero length. (Fixes #6) scales/R/0000755000176200001440000000000012566662515011743 5ustar liggesusersscales/R/pal-manual.r0000644000176200001440000000025111473036515014142 0ustar liggesusers#' Manual palette (manual). #' #' @param values vector of values to be used as a palette. #' @export manual_pal <- function(values) { function(n) values[seq_len(n)] } scales/R/pal-brewer.r0000644000176200001440000000421112556447174014165 0ustar liggesusers#' 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.r0000644000176200001440000001075612325312033013362 0ustar liggesusers#' 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) { labeling::extended(min(x), max(x), n, only.loose = FALSE, ...) } } #' Log breaks (integer breaks on log-transformed scales). #' #' @param n desired number of breaks #' @param base base of logarithm to use #' @export #' @examples #' log_breaks()(c(1, 1e6)) #' log_breaks()(c(1, 1e5)) log_breaks <- function(n = 5, base = 10) { function(x) { rng <- log(range(x, na.rm = TRUE), base = base) min <- floor(rng[1]) max <- ceiling(rng[2]) if (max == min) return(base ^ min) by <- floor((max - min) / n) + 1 base ^ seq(min, max, by = by) } } #' Pretty breaks on transformed scale. #' #' These often do not produce very attractive breaks. #' #' @param trans function of single variable, \code{x}, that given a numeric #' vector returns the transformed values #' @param inv inverse of the transformation function #' @param n desired number of ticks #' @param ... other arguments passed on to pretty #' @export #' @examples #' trans_breaks("log10", function(x) 10 ^ x)(c(1, 1e6)) #' trans_breaks("sqrt", function(x) x ^ 2)(c(1, 100)) #' trans_breaks(function(x) 1 / x, function(x) 1 / x)(c(1, 100)) #' trans_breaks(function(x) -x, function(x) -x)(c(1, 100)) trans_breaks <- function(trans, inv, n = 5, ...) { trans <- match.fun(trans) inv <- match.fun(inv) function(x) { inv(pretty(trans(x), n, ...)) } } #' Compute breaks for continuous scale. #' #' This function wraps up the components needed to go from a continuous range #' to a set of breaks and labels suitable for display on axes or legends. #' #' @param range numeric vector of length 2 giving the range of the underlying #' data #' @param breaks either a vector of break values, or a break function that #' will make a vector of breaks when given the range of the data #' @param labels either a vector of labels (character vector or list of #' expression) or a format function that will make a vector of labels when #' called with a vector of breaks. Labels can only be specified manually if #' breaks are - it is extremely dangerous to supply labels if you don't know #' what the breaks will be. #' @export #' @examples #' cbreaks(c(0, 100)) #' cbreaks(c(0, 100), pretty_breaks(3)) #' cbreaks(c(0, 100), pretty_breaks(10)) #' cbreaks(c(1, 100), log_breaks()) #' cbreaks(c(1, 1e4), log_breaks()) #' #' cbreaks(c(0, 100), labels = math_format()) #' cbreaks(c(0, 1), labels = percent_format()) #' cbreaks(c(0, 1e6), labels = comma_format()) #' cbreaks(c(0, 1e6), labels = dollar_format()) #' cbreaks(c(0, 30), labels = dollar_format()) #' #' # You can also specify them manually: #' cbreaks(c(0, 100), breaks = c(15, 20, 80)) #' cbreaks(c(0, 100), breaks = c(15, 20, 80), labels = c(1.5, 2.0, 8.0)) #' cbreaks(c(0, 100), breaks = c(15, 20, 80), #' labels = expression(alpha, beta, gamma)) cbreaks <- function(range, breaks = extended_breaks(), labels = scientific_format()) { if (zero_range(range)) { return(list(breaks = range[1], labels = format(range[1]))) } if (is.function(breaks)) { breaks <- breaks(range) if (!is.function(labels)) { stop("Labels can only be manually specified in conjunction with breaks", call. = FALSE) } } if (is.function(labels)) { labels <- labels(breaks) } else { if (length(labels) != length(breaks)) { stop("Labels and breaks must be same length") } if (is.expression(labels)) { labels <- as.list(labels) } else { labels <- as.character(labels) } } list(breaks = breaks, labels = labels) } scales/R/scale-discrete.r0000644000176200001440000000320312556445476015017 0ustar liggesusers#' 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 #' @export train_discrete <- function(new, existing = NULL, drop = FALSE) { if (is.null(new)) return(existing) if (!is.discrete(new)) { stop("Continuous value supplied to discrete scale", call. = FALSE) } discrete_range(existing, new, drop = drop) } discrete_range <- function(old, new, drop = FALSE) { new <- clevels(new, drop = drop) if (is.null(old)) return(new) if (!is.character(old)) old <- clevels(old) new_levels <- setdiff(new, as.character(old)) # Keep as a factor if we don't have any new levels if (length(new_levels) == 0) { return(old) } sort(c(old, new_levels)) } clevels <- function(x, drop = FALSE) { if (is.null(x)) { character() } else if (is.factor(x)) { if (drop) x <- factor(x) values <- levels(x) if (any(is.na(x))) values <- c(values, NA) values } else { sort(unique(x)) } } map_discrete <- function(palette, x, limits, na.value = NA) { n <- length(limits) pal <- palette(n)[match(as.character(x), limits)] ifelse(!is.na(x), pal, na.value) } scales/R/colour-manip.r0000644000176200001440000000620012566615003014517 0ustar liggesusers#' 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.r0000644000176200001440000000211312553731560013447 0ustar liggesusers#' 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.r0000644000176200001440000000073212055506613013577 0ustar liggesusers#' 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.r0000644000176200001440000000434612553731560013255 0ustar liggesusers#' 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.r0000644000176200001440000000327012553731560013772 0ustar liggesusers# 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.r0000644000176200001440000000566512536065057014724 0ustar liggesusers#' 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.r0000644000176200001440000000116412536064235013772 0ustar liggesusers#' 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.r0000644000176200001440000000056211505124532014301 0ustar liggesusers#' 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.r0000644000176200001440000001443412554265703013421 0ustar liggesusers#' 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.r0000644000176200001440000000147212566632155013223 0ustar liggesusers#' 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.r0000644000176200001440000000153312553731560014645 0ustar liggesusers#' 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.r0000644000176200001440000000416412553731560014166 0ustar liggesusers#' 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 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()) } #' 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.r0000644000176200001440000003212012566615042015051 0ustar liggesusers#' 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.R0000644000176200001440000000063712536046022014347 0ustar liggesusers# This file was generated by Rcpp::compileAttributes # 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.r0000644000176200001440000000023311666153542014522 0ustar liggesusers#' Identity palette. #' #' Leaves values unchanged - useful when the data is already scaled. #' #' @export identity_pal <- function() { function(x) x } scales/R/documentation.r0000644000176200001440000000052012325312655014762 0ustar liggesusers# 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.r0000644000176200001440000000176212325311122013636 0ustar liggesusers#' 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.r0000644000176200001440000000037012566643133013373 0ustar liggesusers#' 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.r0000644000176200001440000002125712566615276014142 0ustar liggesusers#' 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 = "(?Sv»‡>Øýâ}«ŸkH¸$_Ôm¿ÖÆ >vôøÁ{ò/µ÷§ã²·ýæP±JúŒá3g×P¹bžvÝ2äÌ”‡ÆÜÿ¬SwÛº5461k #Ûß«o˜ÕG&òCv^/öÐŒ^Ê{|pÌ虜¹‚/‡Ñè90ûy:Þñ»¼æ¥°$U÷óªSc¶‹}-ëÿÚâûï’ÚÞñig»€8(Ý"7Ýâw¤ÌغI;V4tÛ`ª/XùÙ£äèŽi•4³¤±êØ’·JŽYšµfíÁJˆáõ­ Îö6ØM¸|klÛ#WašÇmµæьլuæ,ez ³éýûÇöØDÝV;°¼[ƦÀ\—äX{ Ì6 \¾\½G(ûq¤êêu;€ËÁ¥ª&0×¥9½hêvH¾Y`¸\]Är eß+ Ž„\²roµ#ÑX÷Ѽ%ðá:ðu zÇ1bPƒY®_¯Þ;”ýeâôN[«æ,Û{tßþ{–ÂqĬ–=¬áöŸÐÊ.:Ž1 •ôÁÓzqÖÐvjGvW ½8> 9½d»gÌ‚{Ñ2ùqïDÿæÍ‘ ÒŸîß“ ®fm}*HWüÒÞ‘©ªÖUSCqHêª;®9ìGªˆC^æ™ Î({&¢Y]GÑÍ 4çšÓFÞ±*š5©Õ†[š'z[s,­éŬ‰ÅüØRÃƦcÌ„d›‚ªW5e?$ Õf,C p”oãÍÔÜŽ®2¢q Óî´gdG‚dÔŸQ+`éwÖ6£V]7Ònß ÞƒÂ9Á^z¦íqï?ºÑB=Ù;¢š& 3kÀ×Ä6­MÓ"ÚÑ‹¼{3u÷{Ñíð&oÖ ãÇ ±wèî`Ü­´ˆVŠN¼ü’š•þ)—% =ž0ϲÔÿa†o‡O£œ}ε?é+z«3'þ ºoq/ %÷*áÞßÊÒtùÓ\s!—‹¢Y:â>[.hxYÜ«TÞ*½Ä鸵5Œžm}ÓˆÚt(ßKëÀ×IÙѬÉtMTŒ9£"Ùh6eªWq&èž&ªØR£ ~‡7 >œ’*F€£à£‰«byÁÌOW¬Ý‘ÆmÀ»ÀïR#Œ›€‡À©Ÿ½< ~8%a?š¸0VÌÓãS½`º·Ö’ÚÈO‚ŸT£÷‹àE5Ú8œŸII% n%®žª.J’ÊøðàŸP£ŒÓÀO‚R2ÊÀO*%eüðÓàŸN\Sc^R |ü 5šøðIð'ÕhâÏ_ÿjJšø;à×À¿–¸&Ú§g IIüððgÔHâ)à³àϪ‘Ä×Ï?—’$¾|üùÄ%Ñ]°—ÓÅO/€¿ Fÿ|üE5ºø>ðWà¿JI/_9y]¸•o8óeÙþâ߀¯ƒ¿®F¿¾þ†]ü ðMð7SÒÅß+q]tÍè¥Y½(§Š,æxhÖ7 T¡ŠÿA¶Ë'T¡Š? ÛnƳÝé¨"‹iÖlã„ «bYÅð&0%eq9pã„ d‘Å$}öZÆ È"Û ¼ŽqÂTdÑÜÌ8aÒ3¶q*æÌEö=ÀýŒg÷«ÑÆ0ðvÆ UhãzàÆ SÑÆÀƒŒ&¬N{Z—]d1¯”½qB¢8gœP…(îÞÏ8aBÙ.>tðø‰_hãËy..Þ~cÍžhËj×Â|IŸ1ó·½%Ýü¹àÒ¦5²â¡_& ùÜôMQ-¤Ýï4šïá5™´C@Ñ+/ž+P&Ž8$Ìh¶ ¢ƒ¯‹hÝÊ {ìHØÞ#c] UØÒ5¶B›´*ÚŒiÛfi Ë{$ŒåÇP åšCë_ ¯ƒ«e?" Õf¬B p\=/ñV4F4m5L¸ |™´i>“vx&¹"ža¯ XyG+¸ƒñŠ9A¢v¦ mÚš#½WÓÒɨU¼‘ðøØž¾K«èsZAwt­\1ݶˆµu®åƒš¶Ï˜Ôg‹Ž·âŽÊÁgª4_©ç¦ÍütÔ]Þ~Wì]¡ ý4-tíõÊ5[ÊOë¥)£yÁ•°„(søê×ZdÍQ¾q‰Ÿ^^[oUïÍèË®øz BÜHÆ­'-¢ë5GézòV]]}¾Ñ³n—Æe:$2‹iÖ€ |2—]¥½ìj-øÚšW–/ÜÍEõšQôl˜ºäíf=øz);šNR¹ýqiZºÕ\›©Ž³<>œ šÈBŽ€¨‘ÅeÀQðÑ”dÁ—ùlß–¸,º'¬3y댴.vR£‹›‡Á«Ññõø‘”tqx üXâºèrÇo†´*îN‚OªQÅ€SàSjTq7p|:%U˜ÀÀH\Æ™²´(æ€gÁϪÅ)à9ðsjDqø0øÃ)‰âcÀGÀI\=õo=JØøYà£àªQÆ'?¦F>þxJÊø ð ð'’s­©‘aiY< |ü5²øðYðgÕÈâIàsàÏ¥$‹&«®’”…üuä§À_‚ÿR,ø¢«À_P# ¾èêEðS’ů€/¿”üӕŨ´*~|ü5ªø-ðUðWÕ¨âeàk௥¤Š×o€¿‘üÓU…´(Þf˜ÅóKB¢øodÛÎx¶](ÞD¶Œg;ÒE¶ØŸ¸Î-Á+ˆéÈÊ"‹Ù¾ìÕŒ*Ev%°qB²ÈâuÿìFÆ S‘Å5ÀMŒ‹ëÜ’ÅÊrÅšÐ'ÌbŒ›‘ì(pã„*Ä1ÜË8¡ q`^7»qÂTıx;ã⊳¤f:I1:ãÀûW]-¤.ÇW]-¤.ïg\\u¥T:p‚q„u±¢bäMWy½(­ øQÆ Uh~Ù³ŒªÐFxŽqÂT´ñ0ðcŒ&¬åã´Q±¥'³Ÿ~‰qBÂøðËŒªÆ#ÀGÏJÍã% ŒÇ€3N˜ô½ª}ª")Á{}Ùo3N¨B_~‡qBªø 𻌦¢Šg€Ï2ž•š×k® `,­ŠŸÆ8¡ UüøsÆ U¨â9à/'L(Ûè˺iÅEð&ð›jöÈ.¢Œ(Ê~‡€Ò ¤)UÐúí/…,³…Â=søóö›£šfJ¼eydÒ-â«©†\»rzeÊ‹?mäÙjlBµ¬‡v9âÐ1–Ç3‡VÎôˆ#f³ZÕº7ª]Â:IqõtBêéαÈeZ¦R+”#_Õ*¥ŸøZ¹úàO+í­šøöÊ [#ÎGÌj¹mÎt¦ûgœ¼^±´rÑrú ¦]ÐfÊSZÞ8£íÔäwÚ=+¼ÈÙ¿y³DøÞ«àPÂÛÀo‹]Š1J1¹ `7áNð±Ëp™V’\;ËU²£4¡5ÉŸ?½%Z%óÀrE¸fÞ.u«+ÂpÓ"”óÓnF‡ya¶G—FL%ŽmöMË[Åúêõ¿;ÛßG}nîÐú&ŠzþdŸT½o„Ñ„;À¥‡X ÙvæŒ3úL¹h®Dv˜O«ß§ìÛ”ï÷c™Áã8r”®Ã|þsÞÞ¿DFnt®–zFÏW,ZUÏß&ðã›°ž.œ÷û¾½$g{ûßðŸ÷Â'E­&\”ËW„d=Iç oƒžfµïsQ®ÕDK|‰º½{ÇãÛø–;<ݲÀ ONêm÷}nÍ:e«KÓž›4§f+†ì óݪ)7Ô"»ó¬&èhHP²œf¿Ð‰QÜ„˜heÍ v/É3åéÆ :ê¾Ø•+Ð$£7Z¬~Û¯ªe9{vÂfï~4qéâ\a²ÔhD]šŽœmzѶê‹j`[nìâµâ$Š½Ý…<8í8åCCôÓƒc[Ê‹¢ Z•©!4ŸGz:]Tüá!ðC²5à¿HÚ®†Pàuò¾ ýñƒEWÌgÜ2Y³Îƒ}衵 R­GI‡Á‡ãúÕ§Éjø›vH©·Fï½Ið~Qˆ’’ù ø“ÒwÓúéåõsн5öFoIÔЮè5d²üÃë‹l=¼ü¾8uruÝ|ïØÁc'=’L]H\KÂëA0= ¸–¶^uõÐÃëa7¦ ’¨‚Û¢W›­/}JLÈ·É%Ò.vüf2å¾Îý¥è^ë.îy¯÷§^ß=Ê7„2<ìôî*îÝúYrÇê%#!ïîᙪ á^Ÿ4À ‰÷‹¾Q·ê£þ6d¬€Q›Xž¤··ï(WŒ²;B¥:õ†Ê·½žáÿ\‹¼@N«}‰¶mÒ%o§ MÌkëÌü”QÕú· Ž ŽlÞ¡,­d9lx7ÁtU. Šj²Ï»ð@É \°[„“ÿñëêùø·$U·ƒÖ…~›ïé!9t»€8¸ƒ-ÉÇç›´cEC· &¿‚•÷f\Yœ=³¤¹#íâ–j5V¢+³ Fg«’†G®?Ê~D@f®šoi/·mï)¤n;PˆÝ´À\ùs`¶Y Qµc(û5â¸Cfðp© ̵úÐ(0ß,0`cYUž¡ì× ˆ#!Ï ìãžÑúóVÑš­l™(º·3›ù†¼­äqÈ16F´| œE¸|k‚ŽÃÃøÀ|³À€«°*ÇQöÛ”¿VDZºi)\ÀGÌj¹¤®i÷S/}uÂH« Q æЫ$‹ªÆnª•ÒÁü[E’JY×ú¬[@ò 켸vAlÙ².h¤«ž'Ô¤®>âZ¤Y“ëy8¨iGKt>rŒ\2q9p øs‚ÓŠ©{öT¬¹’cí)΃#ÃQÛowhs¼ .Ð=ËÅд¾aa 1be¹žI.Ö €q)ø¥Rvœ_º£2Ò½ xø 2ÆE÷ ›;>’o¶ÁóÍjrŠcíÓ+'V(–º¤ƒøíòðj4¼üŽ”tx'ø é et70žWã þ¿^HÉAp|21­ ׌…XýÛ ð#àQã)àCà¥äÏ‚Ÿ]0ïHµ?~üój¼søð/¤ä¿~ü‹ Ž ¼Îí@Å0Jƒ#Ûd|ó8ð)ð§Ôøæo€ßÿfJ¾yø-ðo%æ›nî}~PªÕ|øCðªñÌßþ£”<Ãzþüljyfó ¸}›dËùgà¯Á­Æ?ÿü øoRòÏo¿ÿ]bþéý#y¯þïÀ·ÀßRãœþü)9ç¿€ÿãB9Gj´ö6C¾ZÜ{x!Ãã~.gœ0 çx¯}ö2ÎßIn<çÈ\u²˜ÆðÂQ®ÍÔ…£\@ßdW¯aœ0ß`9ŠlqS¦nÛ嘾Y{Èœšvjw£ò‘YLgx10·0Tá£ë€{c`*õÑ>à~ÆÅ]—cúhMÞ+ã",àõ4ÊÔh\HÝÔ'LÅEÀ<ãY©Ù’à.n¯îSVÅÌëE¹ËOöàã„*|ƒÕmÙ3Œ¦â›yà‡'LÈ7+½QÇ:¬OÑÂœÁ‘÷ȸçaà_0N¨Â=ÿ’qÂTÜóWÀÏ1N˜{VwŒrÙ(7NÍÒ–0nÚ.ã /¿ÉxVêÞ=ºƒ>|šq„²’A»= x[%Ú£øø±àºsv‚ïŒjN˜)ñ““I· ˆC®¦$cÁñ]×q\ÕB&µ ˆ#zµ$ Ž°G@戟n‰²l*ªÉ¸‹ò?ß“Z6˜ëùÂÄq1ôÆ‘V|õB:ãÉ(~˜8J´L@_˜8Éj¢×÷Ç]õ×/£êóMõmî–;µ$Šmõ`ëVo—0z %\8†Ú!¾¶˜\K¸i£¶W/i³¶¡QÔ4­l¬D;®»_tï4]Ë{Á&)Ö$OÙ~a%]6›©‹.+ë|×ï¶vËÍç{ÿÃN’ìhtç ‹]tþÍUÅÖªÛ3› ³¹ß6Nõh#ZÑ(M9ÓƒÖ¬£íԶ˄zÃ<“‡ákcvßMC½­@v|Wé”únʾM@ù¾;–çÙ>š#"†z[ü22y Ìè\ãëñüø&ì‚»­~Ã;hµøYOíü%ây¼ÿ°F<‡8mkÅsBˆ“K}yÒ¹uvÐùõây¬9¼L<‡È—‹ç°dùŠ€tWŠçVÖÊËó»*Àæ ƒÒnÓ¢þµ€º¹:¤ú|öùcHý_ãË—Ÿß$žÇ ¼kê庀úï÷ÙÍs³x¾·vþzñ<¦ÉoÑR³:ðï–&õ¿7P†!_=Ó¹á€ß¢ó#!u8’~kˆ.è³m:ÛÞ‚Ž(Ý{š´¿÷ŠŸ5‰Õu£O'tî&ŸßèÜŽ=Ý ›[Ê´3D#·¤½- mìÏ­`çvûÎñßÜ#žïcçöŠç„pWû|ëfÈgüóÛCÚæ-Ý!ž[UK{0@Ãwèó®Ú¥;¢ÁÃ6 ±ÿh@Úcçî87vžö'Úz\L»¼vþD‹}¥}_@ŸùþM@<×Yûþ=âyŒþ$¤? Õ…è:'ž_ËÎÝë»Îñ´÷èu<äwïoñx„PÒÝßK)’ÃŨHÿw¢"’Ñ‚†BrZ‘‡õ6FBÅTú(Z‰)å¤X %Ö‘œãèS 9LyX£xZ ªŠé„ª"…øEÑ+ƒR›é]Ú’RÔz¡)Õ V}8¢è}ÔɄʺp!ˆ¢ù®˜PyÒ 4”POušñ— Ùˆ5%úyo˜QèRßläÿшB÷­^|ŽŸObx-çožq·=]èÃë&4Ûrí3£ÿ¼Ñ„¼êEH¸:Æ4X*ŠÐfqH˜´˜¨³ª¾0³Zˆ Ô Þ+cV`®-EZ¾B½S(û•âHÈ)¦=ØtÓ‚õ‚'ç“Ö‚¥è”ÅpÇd²DÆ#bT nðn£ñçjËÕ{„²ïGÚ}×ÒL-8Ð p)½Fô ¿ ú«¨ö _vÂGB^Ù¸—¯êpÃv#d{ÐÐÙšð&•"Ü^~}‚þ ‹­%Fjºüõþ¢ìÄ!鯖#&…®ùè>bVË®jköâj Ô¤3àähï.÷Ü„«­“´»¥qÆ1J£0ÎÎÈìÀÙ z™ƒïŠ]Œ­šÆäîÉÈ8×DwxJ·¸´cÿ–ƒ¥ÉÍýObÑ _'L¸|k‚í!,‚Æ—MãPÝ(û6qH¶‡UI¬8$Í¡Â$AŒ°=S Ëå‹ Öºe­öõí’òcC »‰Yg/ŒˆÄmnUë˜ðjq¨6£5ÀQ¾U7ÓogU-ÍëÍTo.ãÝhf‚–ØLΖ¼xjšUñ$L1ñj'i·'/2Üvÿ2d–v¯îßÛÉ=õm/¢M+2Õ{4Ñû Ýìz…l9—òd<½¯>T›!Ü,`³kÇÐ)¢q«ÐÐ…«È»¥Ñ­B:Â]à»b»øJÔ%ë¥Åjƒâ³ò+Á¯\ø6¸JÈö*ð«Ô‹Ÿ²ß Õfˆ/ ,\\ÊîQ"ڶ͎°\jXØo)“úlÑáwT¼ñÑ=‹+nÓö©{P;á*ž%ŽZËT‚^ààwÆvö5U“]cõr¹hz©„ZfEŸÓ º£Gh—ì\~ÍÂ7Ê5B¶ÂóMÕ­²¿V@ªÍàïs„¼×‘T£ä#G²mâºi”·òF‰„¦mijâ—yc¤xüPüfé6Aô)SÕGÆ1›åz¨`½Úf¹NÈ6Åf¹M‘cJÍò2ÔÇj–lŠ,¢m—£)^¾ Ír”Ù4 é¶æmmæµÓFÞq[§;d/Ñi£îXÖjsÓf~:jÝ^ŽæG¸ |Wl¯óMи]Åi½8k„­Ì³N\(¼f¶ÐÍïr![¡P­û+ yŽ8*}óÈ<â¿AHiÂõJÖ(ªˆC²é·üzz˜9tßÒ# üSEñÓ;vûV¥¼^¶giÍ°{‘õª— šéصgnï0g‹QK³~%¼üŽØ¥¹K÷nœ]ë„ ZÃ(°‹1^¼.Óʳ4Å/ØT¤¢>aí8Ã} … äq¯ïŠ] }AÃ}÷¯ºq÷”÷:>¿C÷þ€«®‹\’«a=!¢•Æ-‰q¦ì^=È4ÏAv²J¯Ý„Í™Å"ŸÑlkÆÐNšnÜRAmQKÒëû-ÉAªxáá®ç ›ë†„6ež6èä /¢Wd½bh3†^r¥79[t¿µ8Qƒàcçr…U1§Ì’^Ô؆ŒQ-†§A›ûļZœ/œ ŸÑá£Õ”®”}›€ñ®±·ø¡s—€8¢›Ó°3MàƒÝ.7]+Ôd$2µ\Ø%“ìê׋{ÓøF¡E³t2Ä+|ÈZðµ5¯œŽ;ømaKaB$z¶ D!ïƒ×eêáìhÖf–éŽ^š–n5ׇÁ‡ôOYhÀð5²à7à£à£)É‚¯<Ù¾-qYtOXgòÖi]ì?¤F<ÎaðÃjtÁ×?’’.ŽK\]÷"­Š{“à“jTñàø”UÜ œŸNI&ððWE§{_%-Š9àYð³jDq xüœQœ> þpJ¢øððGEY ¹Î¼´2> |üQ5Êø$ð1ðÇÔ(ããÀÇÁOI_>þDòc΢552,-‹§Ï€?£Fß> þ¬Y< |ü¹”dñ=àóàÏ/Œ,ä¯#?þü—jdÁwYzü5²ø>ðEðS’ů€/¿”üӕŨ´*~|ü5ªø-ðUðWÕ¨âeàk௥¤Š×o€¿‘üÓU…´(ÞfÈcöñØr - ¾}R;ã„*Dñ&²í`<Û‘Ž(¼hk„]Œg»]ALGVYÌöe¯fœP,¼¢„}ŒóÈo ,‹,^%òö©Z–©Û§J©,ðÜÆÛ,ê† Ëbe¹bMèf1ÆÍHv¸‡qq˨…""y[F 0T!Ìëf÷1žÝ—’8öogœ0aqt“8btÇ÷1N¨B‡ãŒªÐÅàýŒ‹»r)Õ…œ`œ0a]¬¨yÓÕF^/JkÃ~”qBÚÀ„_ö,ã„*´‘žcœ0m< üã„ kcyÅðÖ‚H ã3À/1N¨BŸ~™qBÂxø(ãY©y¼„ñðqÆ “¾WµOUä/%O¿Í8¡ U|øÆ U¨â+Àï2N˜Š*ž>ËxVj^¯¹*sF¾¯ø ðgŒªPÅ€?gœP…*žþ‚q„²¾G¶kõðFðkö¨ZÓEÙß$ ŽèfæÚ‘³ C/ÚV@θ ¨Æ`Ã-gJ‘üöodR›€8Tûf3ÊÄQª†x-µ(Kþïzä—IÊ+tîâÞ/™‹{¿`2ŒÎ]Üû¥ñ·èüHHŽ†¤ß¢ úìâÞ/i/îýҨϋ{¿ÿÆŽ_"<ê…Pºû{÷~É\ÜûåÿÁÞ/nyDÖÛ¼Ûö~‰VbJyAîý"ç8úÆ»vï—xZ ªŠé„ª"…½_¢W¥~—ïýÒz¡)Õ»wï—è}Ô…¿÷K4ß½»÷~I¨§òMUT‚†½_’Û[$lßú¬6V¥˜|6lX„“yöJ´ûKx8Ý°³ 3ÔçšyûVþ¦º/scales/DESCRIPTION0000644000176200001440000000153312566717477013262 0ustar liggesusersPackage: scales Version: 0.3.0 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) License: MIT + file LICENSE LazyLoad: yes NeedsCompilation: yes Packaged: 2015-08-24 18:41:17 UTC; hadley Author: Hadley Wickham [aut, cre], RStudio [cph] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2015-08-25 00:48:31 scales/man/0000755000176200001440000000000012566662515012315 5ustar liggesusersscales/man/cscale.Rd0000644000176200001440000000207612536046022014025 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000060312536046022015276 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000076512536046022014400 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000044312536046022015254 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000117612536064235014416 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000046712536046022014706 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000070712536046022015075 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000071112536117171015056 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000064612536046022015040 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000143012536046022015242 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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/train_discrete.Rd0000644000176200001440000000073512556445500015600 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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) } \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} } \description{ Train (update) a discrete scale } scales/man/math_format.Rd0000644000176200001440000000161212536064252015074 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000104012536046022014107 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000040012536046022014550 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000115112536046022016313 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000304212553547332015120 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000161212536065447015246 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000036312536046022014770 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000114212536111755015113 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000042312536046022015625 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000050112536046022014552 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000050412536065101015015 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000070712536046022014702 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000057012536046022015225 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000073012536046022015767 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000103412536046022014055 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000075512536046022014030 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000067312536046022014205 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000117112536046022015051 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000045412536046022014322 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000067712536046022013716 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000040312536046022016115 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000055212536046022014573 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000140312553731560016074 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000137312536064252016267 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000144712536557336015142 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000135612536046022015722 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000045712536046022014530 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000175412556445500016076 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000104712553731560013664 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000107112536117110015562 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000042412536046022015253 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000056512536046022014340 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000061712556445500016203 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000175412553731560014726 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000073612536046022014247 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000307312536046022014203 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000135512536046022015041 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000115112553731560014740 0ustar liggesusers% Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/trans-date.r \name{time_trans} \alias{time_trans} \title{Transformation for times (class POSIXt).} \usage{ time_trans(tz = NULL) } \arguments{ \item{tz}{Optionally supply the time zone. If \code{NULL}, the default, the time zone will be extracted from first input with a non-null tz.} } \description{ Transformation for times (class POSIXt). } \examples{ hours <- seq(ISOdate(2000,3,20, tz = ""), by = "hour", length.out = 10) t <- time_trans() t$transform(hours) t$inverse(t$transform(hours)) t$format(t$breaks(range(hours))) } scales/man/rescale.Rd0000644000176200001440000000123012554266021014203 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000001052712536046040015072 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000103612536046022015221 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000036612536046022015075 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000172712536046022014212 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000121512536046022015443 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000071212536046022015040 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000125012553731560015401 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000136012553547220015541 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000036412536046022015453 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000114412536064252015272 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000066712553731560014732 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000112512536046022014101 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000043712536046022015435 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000112412536064252015601 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000305412536111701014720 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000077112536046022015433 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000060412566632155014740 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000300412536563561015424 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000247012536046022014571 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000057212536046022014327 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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.Rd0000644000176200001440000000076112536064252015261 0ustar liggesusers% Generated by roxygen2 (4.1.1): 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/LICENSE0000644000176200001440000000006112325311240012517 0ustar liggesusersYEAR: 2010-2014 COPYRIGHT HOLDER: Hadley Wickham