This is an automated email from the git hooks/post-receive script. benjamin-guest pushed a commit to branch master in repository r-cran-munsell.
commit 251d499a0909e8770b31e49ee92e3129104a9343 Author: Benjamin Eikel <benja...@eikel.org> Date: Sun Oct 16 13:40:50 2016 +0200 New upstream version 0.4.3 --- DESCRIPTION | 22 ++-- LICENSE | 2 +- MD5 | 75 ++++++----- NAMESPACE | 7 + NEWS => NEWS.md | 16 +++ R/alter.r | 205 ++++++++++++++++++++++------- R/check.r | 19 +-- R/convert.r | 84 ++++++++++-- R/munsell.r | 12 +- R/plot.r | 292 +++++++++++++++++++++++++----------------- R/sysdata.rda | Bin 53934 -> 53940 bytes README.md | 72 +++++++++++ inst/raw/getmunsellmap.R | 8 +- man/check_mnsl.Rd | 21 ++- man/chroma_slice.Rd | 20 +-- man/complement.Rd | 17 ++- man/complement_slice.Rd | 13 +- man/darker.Rd | 19 ++- man/desaturate.Rd | 18 ++- man/fix_mnsl.Rd | 18 +-- man/hue_slice.Rd | 14 +- man/hvc2mnsl.Rd | 39 +++--- man/in_gamut.Rd | 22 ++-- man/lighter.Rd | 21 ++- man/mnsl.Rd | 37 +++--- man/mnsl2hvc.Rd | 38 ++++++ man/mnsl_hues.Rd | 9 +- man/munsell.Rd | 11 +- man/pbgyr.Rd | 25 ++++ man/plot_closest.Rd | 25 ++-- man/plot_hex.Rd | 14 +- man/plot_mnsl.Rd | 20 ++- man/rgb2mnsl.Rd | 19 +-- man/rygbp.Rd | 25 ++++ man/saturate.Rd | 18 ++- man/seq_mnsl.Rd | 23 ++-- man/text_colour.Rd | 11 +- man/theme_munsell.Rd | 8 +- man/value_slice.Rd | 15 ++- tests/testthat.R | 3 + tests/testthat/test-alter.R | 78 +++++++++++ tests/testthat/test-convert.R | 12 ++ 42 files changed, 999 insertions(+), 428 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c58b117..eeefd49 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,16 +1,20 @@ Package: munsell Type: Package -Title: Munsell colour system -Version: 0.4.2 +Title: Utilities for Using Munsell Colours +Version: 0.4.3 Author: Charlotte Wickham <cwick...@gmail.com> Maintainer: Charlotte Wickham <cwick...@gmail.com> -Description: Functions for exploring and using the Munsell - colour system -Suggests: ggplot2 (>= 0.9.2) -Imports: colorspace +Description: Provides easy access to, and manipulation of, the Munsell + colours. Provides a mapping between Munsell's + original notation (e.g. "5R 5/10") and hexadecimal strings suitable + for use directly in R graphics. Also provides utilities + to explore slices through the Munsell colour tree, to transform + Munsell colours and display colour palettes. +Suggests: ggplot2, testthat +Imports: colorspace, methods License: MIT + file LICENSE -Collate: 'alter.r' 'check.r' 'convert.r' 'munsell.r' 'plot.r' -Packaged: 2013-07-08 19:19:22 UTC; wickhamc +RoxygenNote: 5.0.1 NeedsCompilation: no +Packaged: 2016-02-12 19:58:18 UTC; wickhamc Repository: CRAN -Date/Publication: 2013-07-11 20:15:53 +Date/Publication: 2016-02-13 00:46:00 diff --git a/LICENSE b/LICENSE index 07bcce3..9c0478a 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2013 +YEAR: 2016 COPYRIGHT HOLDER: Charlotte Wickham \ No newline at end of file diff --git a/MD5 b/MD5 index 06b776e..d37a34d 100644 --- a/MD5 +++ b/MD5 @@ -1,36 +1,43 @@ -389bfcde01b71e98d93b8ed8c1b48862 *DESCRIPTION -c720cf09c40daf3a0bdc9db678983a7d *LICENSE -a404b9eebb7ec6368c98f812ca478ce3 *NAMESPACE -92b83b21ce58b53a38bc6ddd66d5b82d *NEWS -171797784068db5819bff9174a530742 *R/alter.r -49827aff51f633348b17a70f4678d81f *R/check.r -fe0d8199f684268d1cf6f0b396f8c6ef *R/convert.r -7573344c1fd851fb51ae252a4801bed1 *R/munsell.r -bc49263be50c3ee16fd3fbf47fc16aa1 *R/plot.r -ac56e1ebdaadd8948c7ad6242ce417ce *R/sysdata.rda -ae61fcf5622bde66874ff9817175fea8 *inst/raw/getmunsellmap.R +b529a9cd7ed8ff85d38812a1fbebaa4f *DESCRIPTION +87ef3467fce6d5a255c09d2c0f4e980b *LICENSE +f2b196714119df71068365d96a78adca *NAMESPACE +9d107514352b78ffcf3ccab7620a36af *NEWS.md +1eba030243b78f1b2ee322b9b56fbd82 *R/alter.r +c385fffc4bf275ee9d376f9f2fbdf28b *R/check.r +84136b509afe014941d22dca629fea48 *R/convert.r +0c0d5c63bdba8c43db46acb682c79f98 *R/munsell.r +edcd785aa8fe3af6c9ca9b97c7092db7 *R/plot.r +a5f63509303f8527dcb119cbbf5c1dd2 *R/sysdata.rda +5f98b36aebc4125d509e4d60a8f7666c *README.md +4c45c679a2b7365d48ee7f168b37ce77 *inst/raw/getmunsellmap.R 1a50e408003768c47b8ee59f96daf9f6 *inst/raw/greys.dat 17ec52f21d55878850b4323ab28122d3 *inst/raw/real.dat -ead1fe4f25e786697bbfe9d86c4f6687 *man/check_mnsl.Rd -2869fb4328548b655dd7a0f74ce6eb8d *man/chroma_slice.Rd -8d03c77f0bb9b11a2bc45a72361b3ea0 *man/complement.Rd -9e3abd017167a638488589c7c472356e *man/complement_slice.Rd -9b5bedcf6af88917cab1f91356d7f1dc *man/darker.Rd -46512510acecd1ca66ae23facc878109 *man/desaturate.Rd -ec9f3b193186b387f87319fd46cf2c74 *man/fix_mnsl.Rd -18710296757aaa5a19d4bf63f17eec9c *man/hue_slice.Rd -47848efc21506f2bd34097a1e7758929 *man/hvc2mnsl.Rd -2b34b5562ac568bf22a0e14368e2ff47 *man/in_gamut.Rd -059650316af6543e0a03a428f01508f1 *man/lighter.Rd -e4132dba7b8781c9bbaed52a3fb24697 *man/mnsl.Rd -3a83faa6b296c306e2c0ba3371355e00 *man/mnsl_hues.Rd -ee5cb3131be5bdadace4721d9b4c981d *man/munsell.Rd -5a23098c3f8ae7fb8418808c8652345d *man/plot_closest.Rd -20cae4cf7b177b6708066eedfe574b9e *man/plot_hex.Rd -536d2edc9f9b08fa895660c667ecacec *man/plot_mnsl.Rd -279310bb2213d4ba5db9262a6910d18b *man/rgb2mnsl.Rd -847385746ad472dc6d135818e8eebb9e *man/saturate.Rd -3a4591cd390b802794012a3aaff7cb00 *man/seq_mnsl.Rd -cd286aae131cdb8759dc0bf8cb99078a *man/text_colour.Rd -997e0ca16ef6590ca12af5019a28f33c *man/theme_munsell.Rd -d6cb894c3dd70d07a67d0e553a39254b *man/value_slice.Rd +f9721be8a64b25360959b6c2534c9b81 *man/check_mnsl.Rd +3b2c933fdf0b300d5d8e86e749607ef9 *man/chroma_slice.Rd +b4a6ddaafda3120626f7ed9970f4b173 *man/complement.Rd +bb63127049e66934cf9a1a3dadeec19a *man/complement_slice.Rd +6078d37f2c28e01a8a12fa19938f1ef1 *man/darker.Rd +3cfeb41bab1f849348246a199a935761 *man/desaturate.Rd +8600ad0e05320570bd948a7dabac0674 *man/fix_mnsl.Rd +61e18e38d7e53b68ffecd8dad053359e *man/hue_slice.Rd +2853d29ea8d261330bd820af75699b3f *man/hvc2mnsl.Rd +3c6da218c28ca6226b4f23c0754357ef *man/in_gamut.Rd +07bc24322c72b341bd1df98e65d84e0e *man/lighter.Rd +49168eba5fabb4df345130d82f386b20 *man/mnsl.Rd +6387c1cbbf852b74e5b1531842933663 *man/mnsl2hvc.Rd +17154a8594319f7b9873b455fa6a2bbf *man/mnsl_hues.Rd +226294cbb387c94849e23931c2031014 *man/munsell.Rd +62a075938ef24ae48a0b1f4703fbd4ed *man/pbgyr.Rd +a8306bff7ac2734253ac629105f5fa72 *man/plot_closest.Rd +81daeb5d8788772c2daa6e15bc8557fc *man/plot_hex.Rd +0f0c7330a9725d0e037a44a316c985e6 *man/plot_mnsl.Rd +edac9eb7ace39737c17814662c102fff *man/rgb2mnsl.Rd +ddd991310c9510cc47cd78ed7f87cb15 *man/rygbp.Rd +ede2ac70f96f467aaecee17114c5191b *man/saturate.Rd +9c6be07f66a03725408d4d2c5bed376a *man/seq_mnsl.Rd +b506eb92ea3290c3df7e97e53a635f16 *man/text_colour.Rd +6674b94e75800c00af9cdbf22e0f4332 *man/theme_munsell.Rd +94bb8c5fe0041ecec376cd222da72275 *man/value_slice.Rd +793adaa149c94009bab8e335b413b9f8 *tests/testthat.R +0b91378a76c507aa56d6a981ba2a3b78 *tests/testthat/test-alter.R +bda817290cbf2bac4e3746d83ff3381a *tests/testthat/test-convert.R diff --git a/NAMESPACE b/NAMESPACE index d105fdc..7285559 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,5 @@ +# Generated by roxygen2: do not edit by hand + export(check_mnsl) export(chroma_slice) export(complement) @@ -11,13 +13,18 @@ export(in_gamut) export(lighter) export(mnsl) export(mnsl2hex) +export(mnsl2hvc) export(mnsl_hues) +export(pbgyr) export(plot_closest) export(plot_hex) export(plot_mnsl) export(rgb2mnsl) +export(rygbp) export(saturate) export(seq_mnsl) export(text_colour) export(value_slice) import(colorspace) +importFrom(methods,as) +importFrom(stats,na.exclude) diff --git a/NEWS b/NEWS.md similarity index 66% rename from NEWS rename to NEWS.md index 9032744..5b72750 100644 --- a/NEWS +++ b/NEWS.md @@ -1,3 +1,19 @@ +Version 0.4.3 +============================================================================== +* many fixes to remove R CMD check notes/warnings fixes issue (#5) + +* fix bug that gave incorrect greys + +* add functions rygbp and pbgyr to change the hue of a colour + +* add function mnsl2hvc to pull apart a munsell string + +* reimplement altering functions to make use of mnsl2hvc and hvc2mnsl + +* fix plot_mnsl to show multiple swatches of identical colour + +* lighter, darker, saturate and desaturate take an additional argument 'steps' to specify how many steps to take. + Version 0.4.2 ============================================================================== diff --git a/R/alter.r b/R/alter.r index df931ad..c617f0e 100644 --- a/R/alter.r +++ b/R/alter.r @@ -1,95 +1,153 @@ #' Make a munsell colour lighter #' -#' Increases the value of the Munsell colour by 1. +#' Increases the value of the Munsell colour. #' @param col character vector of Munsell colours +#' @param steps number of steps to take in increasing value #' @return character vector of Munsell colours #' @export +#' @importFrom stats na.exclude #' @examples #' lighter("5PB 2/4") -#' cols <- c("5PB 2/4", "5Y 7/8") -#' plot_mnsl(c(cols, lighter(cols))) -lighter <- function(col){ - col.split <- lapply(strsplit(col, "/"), - function(x) unlist(strsplit(x, " "))) - unlist(lapply(col.split, function(x) - paste(x[1], " ", as.numeric(x[2]) + 1,"/", x[3] , sep = ""))) +#' cols <- c("5PB 2/4", "5Y 6/8") +#' p <- plot_mnsl(c(cols, lighter(cols), lighter(cols, 2))) +#' p + ggplot2::facet_wrap(~ names, ncol = 2) +#' # lighter and darker are usually reversible +#' lighter(darker("5PB 2/4")) +#' # unless you try to pass though white or black +#' lighter(darker("5PB 1/4")) +lighter <- function(col, steps = 1){ + col <- na.exclude(col) + col_hvc <- mnsl2hvc(as.vector(col)) + + col_hvc[, "value"] <- col_hvc[, "value"] + steps + # check edge cases + whites <- col_hvc[, "value"] >= 10 + blacks <- col_hvc[, "value"] <= 0 + if (any(whites | blacks)){ + col_hvc[whites, "hue"] <- "N" + col_hvc[whites, "value"] <- 10 + col_hvc[whites, "chroma"] <- 0 + col_hvc[blacks, "hue"] <- "N" + col_hvc[blacks, "value"] <- 0 + col_hvc[blacks, "chroma"] <- 0 + } + na_handle(col, hvc2mnsl(col_hvc)) +} + +na_handle <- function(naobj, res){ + nas <- attr(naobj, "na.action") + if(is.null(nas)) return(res) + + if (is.vector(res) & is.vector(as.vector(naobj))){ + keep <- rep(NA, length(naobj) + length(nas)) + stopifnot(length(naobj) == length(res)) + keep[-nas] <- 1:length(res) + result <- res[keep] + } else if(is.data.frame(res) & is.vector(as.vector(naobj))){ + keep <- rep(NA, length(naobj) + length(nas)) + stopifnot(length(naobj) == nrow(res)) + keep[-nas] <- 1:nrow(res) + result <- res[keep, ] + } else if(is.vector(res) & is.data.frame(naobj)){ + keep <- rep(NA, nrow(naobj) + length(nas)) + stopifnot(nrow(naobj) == length(res)) + keep[-nas] <- 1:length(res) + result <- res[keep] + } else if (is.data.frame(res) & is.data.frame(naobj)){ + keep <- rep(NA, nrow(naobj) + length(nas)) + stopifnot(nrow(naobj) == nrow(res)) + keep[-nas] <- 1:nrow(res) + result <- res[keep, ] + } + + result } #' Make a munsell colour darker #' #' Decreases the value of the Munsell colour by 1. #' @param col character vector of Munsell colours +#' @param steps number of steps to take in decreasing value #' @return character vector of Munsell colours #' @export #' @examples -#' darker("5PB 2/4") -#' cols <- c("5PB 2/4", "5Y 7/8") -#' plot_mnsl(c(cols, darker(cols))) -darker <- function(col){ - col.split <- lapply(strsplit(col, "/"), - function(x) unlist(strsplit(x, " "))) - unlist(lapply(col.split, function(x) - paste(x[1], " ", as.numeric(x[2]) - 1,"/", x[3] , sep = ""))) +#' darker("5PB 3/4") +#' cols <- c("5PB 3/4", "5Y 7/8") +#' p <- plot_mnsl(c(cols, darker(cols), darker(cols, 2))) +#' p + ggplot2::facet_wrap(~ names, ncol = 2) +darker <- function(col, steps = 1){ + lighter(col, steps = -steps) } #' Make a munsell colour more saturated #' -#' Increases the chroma of the Munsell colour by one step (+ 2). +#' Increases the chroma of the Munsell colour by step steps (multiples of 2). #' @param col character vector of Munsell colours +#' @param steps number of steps to take in increasing chroma #' @return character vector of Munsell colours #' @export +#' @importFrom stats na.exclude #' @examples #' saturate("5PB 2/4") -#' cols <- c("5PB 2/4", "5Y 7/8") -#' plot_mnsl(c(cols, saturate(cols))) -saturate <- function(col){ - col.split <- lapply(strsplit(col, "/"), - function(x) unlist(strsplit(x, " "))) - unlist(lapply(col.split, function(x) - paste(x[1], " ", x[2], "/", as.numeric(x[3]) + 2, sep = ""))) +#' cols <- c("5PB 2/2", "5Y 7/6") +#' p <- plot_mnsl(c(cols, saturate(cols), saturate(cols, 2))) +#' p + ggplot2::facet_wrap(~ names, ncol = 2) +saturate <- function(col, steps = 1){ + col <- na.exclude(col) + + col_hvc <- mnsl2hvc(as.vector(col)) + col_hvc[, "chroma"] <- col_hvc[, "chroma"] + 2*steps + greys <- col_hvc[, "chroma"] <= 0 + if (any(greys)){ + col_hvc[greys, "hue"] <- "N" + col_hvc[greys, "chroma"] <- 0 + } + na_handle(col, hvc2mnsl(col_hvc)) } #' Make a munsell colour less saturated #' -#' Decreases the chroma of the Munsell colour by one step (- 2). +#' Decreases the chroma of the Munsell colour by one step steps (multiples of 2). #' @param col character vector of Munsell colours +#' @param steps number of steps to take in decreasing chroma #' @return character vector of Munsell colours #' @export #' @examples #' desaturate("5PB 2/4") -#' cols <- c("5PB 2/4", "5Y 7/8") -#' plot_mnsl(c(cols, desaturate(cols))) -desaturate <- function(col){ - col.split <- lapply(strsplit(col, "/"), - function(x) unlist(strsplit(x, " "))) - unlist(lapply(col.split, function(x) - paste(x[1], " ", x[2], "/", as.numeric(x[3]) - 2, sep = ""))) +#' cols <- c("5PB 2/6", "5Y 7/8") +#' p <- plot_mnsl(c(cols, desaturate(cols), desaturate(cols, 2))) +#' p + ggplot2::facet_wrap(~ names, ncol = 2) +desaturate <- function(col, steps = 1){ + saturate(col, steps = -steps) } #' Find the complement of a munsell colour #' #' Finds the munsell colour with the same chroma and value but on the opposite -#' side of the hue circle. +#' side of the hue circle. The complement is not defined +#' for greys (hue == "N"), and the function returns the grey untransformed. #' @param col character vector of Munsell colours #' @param ... passed on to \code{\link{in_gamut}}. Use \code{fix = TRUE} to #' fix "bad" complement #' @return character vector of Munsell colours #' @export +#' @importFrom stats na.exclude #' @examples #' complement("5PB 2/4") #' cols <- c("5PB 2/4", "5Y 7/8") #' plot_mnsl(c(cols, complement(cols))) complement <- function(col, ...){ - col <- check_mnsl(col, ...) - col.split <- lapply(strsplit(col, "/"), - function(x) unlist(strsplit(x, " "))) - hues <- levels(munsell.map$hue)[-1] - - comps <- unlist(lapply(col.split, function(x) { - hue.index <- match(x[1], hues) - paste(hues[(hue.index + 20) %% 40], " ", x[2], "/", x[3], sep = "") - })) - in_gamut(comps, ...) + col <- na.exclude(col) + + col_hvc <- mnsl2hvc(as.vector(col)) + greys <- col_hvc[, "hue"] == "N" + inds <- match(col_hvc$hue, mnsl_hues()) + col_hvc[, "hue"] <- mnsl_hues()[((inds + 20 -1) %% 40) + 1] + if (any(greys)){ + warning("Complement not defined for greys") + col_hvc[greys, "hue"] <- "N" + } + na_handle(col, hvc2mnsl(col_hvc)) } #' Generate a sequence of Munsell colours @@ -99,16 +157,67 @@ complement <- function(col, ...){ #' @param from character string of first Munsell colour #' @param to character string of last Munsell colour #' @param n number of colours in sequence +#' @param fix Should colours outside of the gamut be fixed? +#' Passed on to \code{\link{fix_mnsl}} #' @return character vector of Munsell colours #' @export +#' @importFrom methods as #' @examples #' seq_mnsl("5R 2/4", "5R 5/16", 4) #' plot_mnsl(seq_mnsl("5R 2/4", "5R 5/16", 4)) -#' plot_mnsl(seq_mnsl("5R 2/4", complement("5R 2/4", fix = TRUE), 5)) -seq_mnsl <- function(from, to, n){ - in.LUV <- munsell.map[match(c(from, to), munsell.map$name), c("L", "U", "V")] +#' plot_mnsl(seq_mnsl("5R 5/6", +#' complement("5R 5/6"), 5)) +seq_mnsl <- function(from, to, n, fix = FALSE){ + cols <- in_gamut(c(from, to), fix = fix) + if(any(is.na(cols))) stop("Colors must be in gamut") + in.LUV <- munsell.map[match(cols, munsell.map$name), c("L", "U", "V")] LUV.seq <- matrix(c(seq(in.LUV$L[1], in.LUV$L[2], length = n), seq(in.LUV$U[1], in.LUV$U[2], length = n), seq(in.LUV$V[1], in.LUV$V[2], length = n)), ncol = 3) - rgb2mnsl(as(LUV(LUV.seq), "RGB")@coords) -} \ No newline at end of file + rgb2mnsl(as(LUV(LUV.seq), "sRGB")@coords) +} + + + +#' Change the hue of a munsell colour +#' +#' Moves the hue of a munsell colour in the direction red->yellow->green->blue->purple->red +#' @param col character vector of Munsell colours +#' @param steps number of hue steps to take +#' @return character vector of Munsell colours +#' @export +#' @importFrom stats na.exclude +#' @examples +#' my_red <- "10R 4/8" +#' rygbp(my_red) +#' plot_mnsl(c(my_red, rygbp(my_red, 2), rygbp(my_red, 4))) +rygbp <- function(col, steps = 1){ + col <- na.exclude(col) + + col_hvc <- mnsl2hvc(as.vector(col)) + greys <- col_hvc[, "hue"] == "N" + + inds <- match(col_hvc$hue, mnsl_hues()) + col_hvc[, "hue"] <- mnsl_hues()[((inds + steps -1) %% 40) + 1] + if (any(greys)){ + warning("Greys returned untransformed") + col_hvc[greys, "hue"] <- "N" + } + + na_handle(col, hvc2mnsl(col_hvc)) +} + +#' Change the hue of a munsell colour +#' +#' Moves the hue of a munsell colour in the direction purple->blue->green->yellow->red->purple +#' @param col character vector of Munsell colours +#' @param steps number of hue steps to take +#' @return character vector of Munsell colours +#' @export +#' @examples +#' my_red <- "2.5R 4/8" +#' pbgyr(my_red) +#' plot_mnsl(c(my_red, pbgyr(my_red, 2), pbgyr(my_red, 4))) +pbgyr <- function(col, steps = 1){ + rygbp(col, steps = -steps) +} diff --git a/R/check.r b/R/check.r index 4817302..9d747b0 100644 --- a/R/check.r +++ b/R/check.r @@ -11,9 +11,11 @@ #' @examples #' check_mnsl(c("5R 5/8","2.5R 9/28")) #' @keywords internal -check_mnsl <- function(col, fix = FALSE){ - missing <- is.na(col) - col <- toupper(col[!missing]) +#' @importFrom methods as +#' @importFrom stats na.exclude +check_mnsl <- function(col){ + col_na <- na.exclude(col) + col <- toupper(as.vector(col_na)) # check format right.format <- grep("^[N]|([0-9]?.?[0-9][A-Z]{1,2})[ ][0-9]?.?[0-9]/[0-9]?.?[0-9]{1,2}$", col) @@ -62,10 +64,7 @@ check_mnsl <- function(col, fix = FALSE){ stop("some colours have chromas that are not multiples of two: ", bad.chroma) } - col <- in_gamut(col, fix = fix) - result <- rep(NA, length(missing)) - result[!missing] <- col - result + na_handle(col_na, col) } #' Checks if a Munsell colour is defined in RGB space @@ -79,10 +78,12 @@ check_mnsl <- function(col, fix = FALSE){ #' @return a character vector containing the input colours. If any colours #' were outside the gamut they will be represented by NA. #' @export +#' @importFrom stats na.exclude #' @examples #' in_gamut(c("5R 5/8","2.5R 9/28")) #' @keywords internal in_gamut <- function(col, fix = FALSE){ + col <- na.exclude(col) positions <- match(col, munsell.map$name) hex <- munsell.map[positions, "hex"] if(any(is.na(hex))){ @@ -95,7 +96,7 @@ in_gamut <- function(col, fix = FALSE){ col[is.na(hex)] <- fix_mnsl(col[is.na(hex)]) } } - col + na_handle(col, as.vector(col)) } #' Fix an undefined Munsell colour #' @@ -123,7 +124,7 @@ fix_mnsl <- function(col){ #' Munsell hues #' #' Returns a character vector of the Munsell hues in hue order starting at 2.5R and excluding grey ("N"). -#' @return a character vector containing the fixed colours. +#' @return a character vector containing the hue values. #' @export #' @examples #' mnsl_hues() diff --git a/R/convert.r b/R/convert.r index 764ec37..4676813 100644 --- a/R/convert.r +++ b/R/convert.r @@ -19,9 +19,8 @@ #' @examples #' mnsl2hex("5PB 5/10") #' # use a munsell colour in a plot -#' require("ggplot2") -#' ggplot(data.frame(x = 1:10)) + geom_point(aes(x = x, y = x), -#' colour = mnsl2hex("5PB 5/10")) +#' plot.new() +#' rect(0, 0, 1 ,1 , col = mnsl("5R 5/10")) mnsl <- function(col, ...){ col <- check_mnsl(col, ...) positions <- match(col, munsell.map$name) @@ -40,7 +39,8 @@ mnsl2hex <- mnsl #' this package value should be an integer in 0:10 and chroma an even number #' at most 24. Note that not all possible specifications result in #' representable colours. Regular recycling rules apply. -#' @param hue a character vector of Munsell hues +#' @param hue a character vector of Munsell hues, or a 3 column data frame +#' containing the hue value and chroma levels #' @param value a numeric vector of values #' @param chroma a numeric vector of chromas #' @param ... passed on to \code{\link{check_mnsl}}. Use \code{fix = TRUE} to @@ -48,20 +48,62 @@ mnsl2hex <- mnsl #' @return a character string specification of a hex colour #' @seealso \code{\link{check_mnsl}}, \code{\link{mnsl2hex}} #' @export +#' @importFrom stats na.exclude #' @examples #' hvc2mnsl("5PB", 5, 10) #' # All values of 5PB with chroma 10 #' hvc2mnsl("5PB", 1:9, 10) # note some are undefined -#' plot_mnsl(hvc2mnsl("5PB", 1:9, 2)) -hvc2mnsl <- function(hue, value, chroma, ...){ - selected <- paste(hue, " ", value, "/", chroma, sep = "") +#' plot_mnsl(hvc2mnsl("5PB", 1:9, 10)) +hvc2mnsl <- function(hue, value = NULL, chroma = NULL, ...){ + if(!(is.null(value) == is.null(chroma))) stop("specify both value and chroma") + hcv <- hue + if(!is.null(value)) { + hcv <- cbind(hcv, value, chroma) + } + hcv <- na.exclude(hcv) + selected <- paste(hcv[, 1], " ", hcv[, 2], "/", hcv[, 3], sep = "") selected <- check_mnsl(selected, ...) - selected + na_handle(hcv, selected) } -#' Converts an RGB colour to Munsell +#' Converts a Munsell colour to a hue, chroma and value triplet #' -#' Finds the closest Munsell colour (in LUV space) to the specified RGB colour +#' Takes a text specification of a Munsell colour and returns +#' the hue, chroma and value triplet. +#' +#' Munsell colours are specified by hue, value and chroma. They +#' take a form like "5PB 5/10" where the first characters represent the +#' hue, followed by a space then the value and chroma separated by a "/". In +#' this package value should be an integer in 0:10 and chroma an even number +#' at most 24. Note that not all possible specifications result in +#' representable colours. +#' @param col a character vector of Munsell colours +#' @param ... passed on to \code{\link{check_mnsl}}. Use \code{fix = TRUE} to +#' fix "bad" colours +#' @return a data frame with named columns hue, value and chroma containing the hue, +#' value and chroma levels. +#' @seealso \code{\link{check_mnsl}}, \code{\link{hvc2mnsl}} +#' @importFrom stats na.exclude +#' @export +#' @examples +#' mnsl2hvc("5PB 5/10") +#' hvc2mnsl(mnsl2hvc("5PB 5/10")) +mnsl2hvc <- function(col, ...){ + col <- check_mnsl(col, ...) + col <- na.exclude(col) + if (length(col) == 0) stop("zero non-missing colours") + col.split <- lapply(strsplit(col, "/"), + function(x) unlist(strsplit(x, " "))) + col_mat <- data.frame(do.call(rbind, col.split), + stringsAsFactors = FALSE) + colnames(col_mat) <- c("hue", "value", "chroma") + col_mat[, "value"] <- as.numeric(col_mat[, "value"]) + col_mat[, "chroma"] <- as.numeric(col_mat[, "chroma"]) + na_handle(col, col_mat) +} +#' Converts an sRGB colour to Munsell +#' +#' Finds the closest Munsell colour (in LUV space) to the specified sRGB colour #' #' @param R a numeric vector of red values or a 3 column matrix with the #' proportions R, G, B in the columns. @@ -69,12 +111,17 @@ hvc2mnsl <- function(hue, value, chroma, ...){ #' @param B numeric vector of blue values #' @seealso \code{\link{plot_closest}} #' @export +#' @importFrom methods as #' @examples #' rgb2mnsl(0.1, 0.1, 0.3) #' rgb2mnsl(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) #' plot_closest(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) rgb2mnsl <- function(R, G = NULL, B = NULL){ - LUV.vals <- as(RGB(R, G, B), "LUV")@coords + LUV.vals <- as(sRGB(R, G, B), "LUV")@coords + # check for black + if (any(LUV.vals[,"L"] == 0)){ + LUV.vals[LUV.vals[,"L"] == 0, ] <- 0 + } ncolors <- nrow(LUV.vals) dist.calc <- function(x, y) rowSums((rep(x, each = ncolors) - y) ^ 2) dists <- apply(munsell.map[, c("L", "U", "V")], 1, dist.calc, y = LUV.vals) @@ -82,3 +129,18 @@ rgb2mnsl <- function(R, G = NULL, B = NULL){ else closest <- apply(dists, 1, which.min) munsell.map[closest, "name"] } + +RGB2mnsl <- function(rgb.cols){ + LUV.vals <- as(rgb.cols, "LUV")@coords + # check for black + if (any(LUV.vals[,"L"] == 0)){ + LUV.vals[LUV.vals[,"L"] == 0, ] <- 0 + } + ncolors <- nrow(LUV.vals) + dist.calc <- function(x, y) rowSums((rep(x, each = ncolors) - y) ^ 2) + dists <- apply(munsell.map[, c("L", "U", "V")], 1, dist.calc, y = LUV.vals) + if(is.null(dim(dists))) closest <- which.min(dists) + else closest <- apply(dists, 1, which.min) + munsell.map[closest, "name"] +} + diff --git a/R/munsell.r b/R/munsell.r index aa0a22a..8371982 100644 --- a/R/munsell.r +++ b/R/munsell.r @@ -1,10 +1,16 @@ #' Munsell colour system. #' +#' @description #' This package makes it easy to access and manipulate the colours in the -#' munsell colour system. -#' +#' munsell colour system. The conversion from munsell specifications to sRGB based on the renotation data from \url{http://www.cis.rit.edu/mcsl/online/munsell.php} which is a digitization of Table 1 in Newhall, Nickerson & Judd (1943). The code for conversion can be found in the package directory in inst/raw/getmunsellmap.r +#' @references S. M. Newhall, D. Nickerson, and D. B. Judd. Final report of the O.S.A. subcommittee on the spacing of the munsell colors. J. Opt. Soc. Am., 33(7):385-411, 07 1943. +#' @references Munsell Renotation Data, RIT Munsell Color Science Laboratory. \url{http://www.cis.rit.edu/mcsl/online/munsell.php} #' @docType package #' @name munsell #' @aliases munsell package-munsell #' @import colorspace -NULL \ No newline at end of file +NULL + + +globalVariables(c("hue", "value", "chroma", "name", + "x", "y", "text.colour", "colour")) \ No newline at end of file diff --git a/R/plot.r b/R/plot.r index 4d8b48b..96f94b5 100644 --- a/R/plot.r +++ b/R/plot.r @@ -3,20 +3,20 @@ #' Removes unnecessary clutter in plots #' @keywords internal #' @param bg.col takes colour to use as background colour -theme_munsell <- function(bg.col) { - theme( - panel.grid.major = element_line(colour = NA), - panel.grid.minor = element_line(colour = NA), - panel.background = element_rect(fill = bg.col), - plot.background = element_blank(), - axis.line = element_line(colour = NA), - axis.ticks = element_blank(), - axis.text = element_blank(), - axis.title = element_blank(), - legend.background = element_blank(), - legend.key = element_blank(), - legend.text = element_text(), - legend.title = element_text()) +theme_munsell <- function(bg.col = "white") { + ggplot2::theme( + panel.grid.major = ggplot2::element_line(colour = NA), + panel.grid.minor = ggplot2::element_line(colour = NA), + panel.background = ggplot2::element_rect(fill = bg.col), + plot.background = ggplot2::element_blank(), + axis.line = ggplot2::element_line(colour = NA), + axis.ticks = ggplot2::element_blank(), + axis.text = ggplot2::element_blank(), + axis.title = ggplot2::element_blank(), + legend.background = ggplot2::element_blank(), + legend.key = ggplot2::element_blank(), + legend.text = ggplot2::element_text(), + legend.title = ggplot2::element_text()) } @@ -31,18 +31,24 @@ theme_munsell <- function(bg.col) { #' plot_hex("#000000") #' plot_hex(c("#000000","#FFFFFF")) plot_hex <- function(hex.colour, back.col = "white"){ - require("ggplot2") - if(length(hex.colour) == 1) add.ops <- list(geom_text(aes(label = names))) - else add.ops <- list(facet_wrap(~ names)) + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } + if(length(hex.colour) == 1) { + add.ops <- list(ggplot2::geom_text(ggplot2::aes(label = names))) + } + else add.ops <- list(ggplot2::facet_wrap(~ names)) df <- data.frame(colour = hex.colour, names = factor(hex.colour, levels=hex.colour), x = 0, y = 0) - ggplot(data = df, aes(x = x, y = y)) + geom_tile(aes(fill = colour)) + - scale_fill_identity() + add.ops + - scale_x_continuous(expand = c(0, 0))+ - scale_y_continuous(expand = c(0, 0))+ - coord_fixed(ratio = 1) + theme_munsell(back.col) + ggplot2::ggplot(data = df, ggplot2::aes(x = x, y = y)) + + ggplot2::geom_tile(ggplot2::aes(fill = colour)) + + ggplot2::scale_fill_identity() + add.ops + + ggplot2::scale_x_continuous(expand = c(0, 0)) + + ggplot2::scale_y_continuous(expand = c(0, 0)) + + ggplot2::coord_fixed(ratio = 1) + theme_munsell(back.col) } #' Plot a munsell colour @@ -61,24 +67,36 @@ plot_hex <- function(hex.colour, back.col = "white"){ #' p #' # returned object is a ggplot object so we can alter the layout #' summary(p) -#' p + facet_wrap(~ names, nrow = 1) +#' p + ggplot2::facet_wrap(~ num, nrow = 1) plot_mnsl <- function(cols, back.col = "white", ...){ - require("ggplot2") - - if(length(cols) == 1) {add.ops <- list( - geom_text(aes(label = names, colour = text_colour(as.character(names)))), - scale_colour_identity())} - else add.ops <- list(facet_wrap(~ names)) - cols <- check_mnsl(cols, ...) - df <- data.frame(names = factor(cols, levels = cols), - hex = mnsl2hex(cols), x = 0 , y = 0) - ggplot(data = df, aes(x = x, y = y)) + geom_tile(aes(fill = hex)) + + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } + add.ops <- NULL + if(length(cols) > 1) { + add.ops <- list(ggplot2::facet_wrap(~ num)) + } + cols <- check_mnsl(cols) + cols <- in_gamut(cols, ...) + df <- data.frame(num = 1:length(cols), + names = factor(cols, levels = c(unique(cols))), + hex = mnsl2hex(cols), x = 0 , y = 0, stringsAsFactors = FALSE) + df$labels <- factor(df$names, levels = c(unique(cols), "NA")) + df$labels[is.na(df$labels)] <- "NA" + ggplot2::ggplot(data = df, ggplot2::aes(x = x, y = y)) + + ggplot2::geom_tile(ggplot2::aes(fill = hex)) + add.ops + - scale_x_continuous(expand = c(0, 0))+ - scale_y_continuous(expand = c(0, 0))+ - coord_fixed() + + ggplot2::geom_text(ggplot2::aes(label = labels, + colour = text_colour(as.character(names)))) + + ggplot2::scale_x_continuous(expand = c(0, 0))+ + ggplot2::scale_y_continuous(expand = c(0, 0))+ + ggplot2::coord_fixed() + theme_munsell(back.col) + - scale_fill_identity() + ggplot2::scale_fill_identity() + + ggplot2::scale_colour_identity() + + ggplot2::theme(strip.background = ggplot2::element_blank(), + strip.text = ggplot2::element_blank()) } @@ -94,32 +112,36 @@ plot_mnsl <- function(cols, back.col = "white", ...){ #' hue_slice(c("5R", "5P")) #' \dontrun{hue_slice("all")} hue_slice <- function(hue.name = "all", back.col = "white"){ - require("ggplot2") - + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } if (any(hue.name == "all")) { - return(ggplot(aes(x = factor(chroma), y = factor(value)), - data = munsell.map) + - geom_tile(aes(fill = hex), colour = back.col) + - facet_wrap(~ hue) + - scale_x_discrete("Chroma", expand = c(0, 0)) + - coord_fixed(ratio = 1) + - scale_y_discrete("Value", expand = c(0, 0)) + + return( + ggplot2::ggplot(ggplot2::aes(x = factor(chroma), y = factor(value)), + data = munsell.map) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), colour = back.col) + + ggplot2::facet_wrap(~ hue) + + ggplot2::scale_x_discrete("Chroma", expand = c(0, 0)) + + ggplot2::coord_fixed(ratio = 1) + + ggplot2::scale_y_discrete("Value", expand = c(0, 0)) + theme_munsell(back.col) + - scale_fill_identity()) + ggplot2::scale_fill_identity() + ) } else { if (!all(hue.name %in% munsell.map$hue)) stop("invalid hue names") - ggplot(aes(x = factor(chroma), y = factor(value)), - data = subset(munsell.map, hue %in% hue.name)) + - geom_tile(aes(fill = hex), colour = back.col, size = 1) + - geom_text(aes(label = name, colour = text_colour(name)), - angle = 45, size = 2) + - scale_colour_identity() + - scale_x_discrete("Chroma") + - scale_y_discrete("Value", expand = c(0.125, 0)) + - theme_munsell(back.col) + - scale_fill_identity()+ - facet_wrap(~ hue) + ggplot2::ggplot(ggplot2::aes(x = factor(chroma), y = factor(value)), + data = subset(munsell.map, hue %in% hue.name)) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), colour = back.col, size = 1) + + ggplot2::geom_text(ggplot2::aes(label = name, colour = text_colour(name)), + angle = 45, size = 2) + + ggplot2::scale_colour_identity() + + ggplot2::scale_x_discrete("Chroma") + + ggplot2::scale_y_discrete("Value", expand = c(0.125, 0)) + + theme_munsell(back.col) + + ggplot2::scale_fill_identity() + + ggplot2::facet_wrap(~ hue) } } @@ -136,18 +158,20 @@ hue_slice <- function(hue.name = "all", back.col = "white"){ #' # all values #' \dontrun{value_slice(1:10)} value_slice <- function(value.name = 1:10, back.col = "white"){ - require("ggplot2") - + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } if (!all(value.name %in% munsell.map$value)) stop("invalid Value") - ggplot(aes(x = hue, y = factor(chroma)), - data = subset(munsell.map, value %in% value.name & hue != "N" & !is.na(hex))) + - geom_tile(aes(fill = hex), colour = back.col) + - coord_polar() + - scale_x_discrete("Hue") + - scale_y_discrete("Chroma") + - facet_wrap(~ value) + + ggplot2::ggplot(ggplot2::aes(x = hue, y = factor(chroma)), + data = subset(munsell.map, value %in% value.name & hue != "N" & !is.na(hex))) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), colour = back.col) + + ggplot2::coord_polar() + + ggplot2::scale_x_discrete("Hue") + + ggplot2::scale_y_discrete("Chroma") + + ggplot2::facet_wrap(~ value) + theme_munsell(back.col) + - scale_fill_identity() + ggplot2::scale_fill_identity() } #' Plot all colours with the same chroma @@ -163,26 +187,28 @@ value_slice <- function(value.name = 1:10, back.col = "white"){ #' # Maybe want to delete text and add axis instead #' p <- chroma_slice(18) #' p$layers[[2]] <- NULL # remove text layer -#' p + theme(axis.text = element_text(), -#' axis.text.x = element_text(angle = 90, hjust = 1)) +#' p + ggplot2::theme(axis.text = ggplot2::element_text(), +#' axis.text.x = ggplot2::element_text(angle = 90, hjust = 1)) #' # all values #' \dontrun{chroma_slice(seq(0, 38, by = 2))} chroma_slice <- function(chroma.name = seq(0, 26, by = 2), back.col = "white"){ - require("ggplot2") - + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } if (!all(chroma.name %in% munsell.map$chroma)) stop("invalid Chroma") - ggplot(aes(x = hue, y = value), - data = subset(munsell.map, chroma %in% chroma.name & hue != "N")) + - geom_tile(aes(fill = hex), colour = back.col) + - geom_text(aes(label = name, colour = text_colour(name)), + ggplot2::ggplot(ggplot2::aes(x = hue, y = value), + data = subset(munsell.map, chroma %in% chroma.name & hue != "N")) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), colour = back.col) + + ggplot2::geom_text(ggplot2::aes(label = name, colour = text_colour(name)), angle = 45, size = 2) + - scale_colour_identity() + - scale_x_discrete("Hue") + - scale_y_continuous("Value") + - coord_fixed(ratio = 1/4) + - facet_wrap(~ chroma) + + ggplot2::scale_colour_identity() + + ggplot2::scale_x_discrete("Hue") + + ggplot2::scale_y_continuous("Value") + + ggplot2::coord_fixed(ratio = 1/4) + + ggplot2::facet_wrap(~ chroma) + theme_munsell(back.col) + - scale_fill_identity() + ggplot2::scale_fill_identity() } #' A vertical slice through the Munsell space @@ -195,38 +221,74 @@ chroma_slice <- function(chroma.name = seq(0, 26, by = 2), back.col = "white"){ #' @examples #' complement_slice("5PB") #' complement_slice("5R") +#' complement_slice("10G") complement_slice <- function(hue.name, back.col = "white"){ - require("ggplot2") - + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } + if (length(hue.name) > 1) stop("complement_slice currently only takes one hue") if (!hue.name %in% munsell.map$hue) stop("invalid hue name") - hues <- levels(munsell.map$hue)[-1] - index <- which(hues == hue.name) - comp.hue <- hues[(index + 20) %% 40] + comp.hue <- mnsl2hvc(complement(hvc2mnsl(hue.name, 2, 2)))$hue munsell.sub <- subset(munsell.map, hue == hue.name | hue == comp.hue) + munsell.sub <- within(munsell.sub, { chroma <- ifelse(hue == comp.hue, -1, 1) * chroma - hue <- factor(hue, levels = c(comp.hue, "N", hues[index])) + hue <- factor(hue, levels = c(comp.hue, "N", hue.name)) }) - ggplot(aes(x = chroma, y = value), - data = munsell.sub) + - geom_tile(aes(fill = hex), colour = back.col, size = 1) + - geom_text(aes(label = name, colour = text_colour(name)), + ggplot2::ggplot(ggplot2::aes(x = chroma, y = value), + data = munsell.sub) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), colour = back.col, size = 1) + + ggplot2::geom_text(ggplot2::aes(label = name, colour = text_colour(name)), angle = 45, size = 2) + - scale_fill_identity() + - scale_colour_identity() + - scale_x_continuous("Chroma") + - scale_y_continuous("Value") + - facet_grid(. ~ hue, scales = "free_x", space = "free") + - coord_fixed() + + ggplot2::scale_fill_identity() + + ggplot2::scale_colour_identity() + + ggplot2::scale_x_continuous("Chroma") + + ggplot2::scale_y_continuous("Value") + + ggplot2::facet_grid(. ~ hue, scales = "free_x", space = "free") + + ggplot2::coord_fixed() + theme_munsell(back.col) } -#' Plot closest Munsell colour to an RGB colour +# +# slice <- function(hue = NULL, chroma = NULL, value = NULL) { +# if (!requireNamespace("ggplot2", quietly = TRUE)) { +# stop("ggplot2 needed for this function to work. Please install it.", +# call. = FALSE) +# } +# spec <- as.list(match.call())[-1] +# cols <- merge(munsell:::munsell.map, expand.grid(spec)) +# vars <- names(spec) +# varying <- c("hue", "chroma", "value")[!(c("hue", "chroma", "value") %in% vars)] +# if (length(vars) == 1){ +# print(ggplot(cols, aes_string(varying[1], varying[2])) + +# geom_tile(aes(fill = hex), size = 1) + +# geom_text(aes(label = name, colour = text_colour(name)), +# angle = 45, size = 2) + +# scale_fill_identity() + +# scale_colour_identity() + +# coord_fixed() + +# theme_munsell()) +# } else if (length(vars) == 2){ +# print(ggplot(cols, aes_string(varying[1], 1)) + +# geom_tile(aes(fill = hex), size = 1) + +# geom_text(aes(label = name, colour = text_colour(name)), +# angle = 45, size = 2) + +# scale_fill_identity() + +# scale_colour_identity() + +# coord_fixed() + +# theme_munsell()) +# } +# cols[order(cols$hue, cols$chroma, cols$value), "name"] +# } + + +#' Plot closest Munsell colour to an sRGB colour #' -#' Take an RGB colour and plots it along with the closest Munsell colour (using \code{\link{rgb2mnsl}} to find it) +#' Take an sRGB colour and plots it along with the closest Munsell colour (using \code{\link{rgb2mnsl}} to find it) #' @param R a numeric vector of red values or a 3 column matrix with the #' proportions R, G, B in the columns. #' @param G numeric vector of green values @@ -239,24 +301,27 @@ complement_slice <- function(hue.name, back.col = "white"){ #' plot_closest(0.1, 0.1, 0.3) #' plot_closest(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) plot_closest <- function(R, G = NULL, B = NULL, back.col = "white"){ - require("ggplot2") - + if (!requireNamespace("ggplot2", quietly = TRUE)) { + stop("ggplot2 needed for this function to work. Please install it.", + call. = FALSE) + } closest <- rgb2mnsl(R, G, B) ncolours <- length(closest) - rgbnames <- apply(round(RGB(R, G, B)@coords, 2), 1, paste, collapse = ", ") + rgbnames <- apply(round(sRGB(R, G, B)@coords, 2), 1, paste, collapse = ", ") little.df <- data.frame(type = rep(c("actual", "closest"), each = ncolours), - hex = c(hex(RGB(R,G,B)), mnsl2hex(closest)), + hex = c(hex(sRGB(R,G,B)), mnsl2hex(closest)), name = c(rgbnames, closest), x = rep(c(0, 0), each = ncolours), y = rep(1:ncolours, 2), text.colour = rep(text_colour(closest), 2)) - ggplot(data = little.df, aes(x = x, y = y)) + geom_tile(aes(fill = hex), - colour = back.col, size = 2) + - geom_text(aes(label = name, colour = text.colour), size = 2) + - scale_colour_identity() + - coord_fixed(ratio = 1) + + ggplot2::ggplot(data = little.df, ggplot2::aes(x = x, y = y)) + + ggplot2::geom_tile(ggplot2::aes(fill = hex), + colour = back.col, size = 2) + + ggplot2::geom_text(ggplot2::aes(label = name, colour = text.colour), size = 2) + + ggplot2::scale_colour_identity() + + ggplot2::coord_fixed(ratio = 1) + theme_munsell(back.col) + - scale_fill_identity()+ - facet_wrap(~ type) + ggplot2::scale_fill_identity()+ + ggplot2::facet_wrap(~ type) } #' Get text colour @@ -267,9 +332,6 @@ plot_closest <- function(R, G = NULL, B = NULL, back.col = "white"){ #' @export #' @keywords internal text_colour <- function(cols){ - col.split <- lapply(strsplit(cols, "/"), - function(x) unlist(strsplit(x, " "))) - col.split <- lapply(col.split, gsub, pattern = "[A-Z]", replacement = "") - values <- as.numeric(sapply(col.split, "[", 2)) + values <- mnsl2hvc(cols)[, "value"] ifelse(values >4, "black", "white") } \ No newline at end of file diff --git a/R/sysdata.rda b/R/sysdata.rda index 6d0ccde..4b1212d 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/README.md b/README.md new file mode 100644 index 0000000..7c35498 --- /dev/null +++ b/README.md @@ -0,0 +1,72 @@ +<!-- README.md is generated from README.Rmd. Please edit that file --> +![Downloads](http://cranlogs.r-pkg.org/badges/last-week/munsell) + +munsell +======= + +The `munsell` package provides easy access to, and manipulation of, the Munsell colours. The `munsell` package provides a mapping between Munsell's orginal notation (e.g. "5R 5/10") and hexidecimal sRGB strings suitable for use directly in R graphics. The package also provides utilities to explore slices through the Munsell colour tree, to transform Munsell colours and display colour palettes. + +Munsell devised his system of colour notation to match the three percetual dimensions of colour: hue, value and chroma. His notation provides a naming scheme to colours that eases the choice of color according to a specific purpose. His century old advice is still relevent for the producers of statistical graphics and the munsell package aims to enable user to easily follow it. + +Functions in `munsell` fall into three basic use categories: specifying Munsell colours, altering Munsell colours and exploring the Munsell color space. + +The code below relies on the development version of `munsell`, get it with: + +``` r +devtools::install_github("cwickham/munsell") +``` + +Color specification +------------------- + +Following Munsell, specifying colours is done with a specific string format: "H V/C" where H is a hue code (see `mnsl_hues()` for a list of those available, excluding "N"), V an integer in \([0, 10]\) specifying value, and C an even integer specifying chroma. The `mnsl` function takes the string and returns a hexadecimal RGB representation: + +``` r +library(munsell) +mnsl("5R 5/10") +#> [1] "#C65858" +``` + +Visually examining a colour can either be done by using `mnsl` with a base plotting call, or using `plot_mnsl` which plots colour swatches using `ggplot2`: + +``` r +plot.new() +rect(0, 0, 1 ,1 , col = mnsl("5R 5/10")) +plot_mnsl("5R 5/10") +``` + +Colour manipulation +------------------- + +`munsell` provides convenience functions that alter a colour by taking steps in the hue, value and chroma dimensions: `rygbp`, `pbgyr`, `lighter`, `darker`, `saturate` and `desaturate`. + +``` r +my_blue <- "5PB 5/8" +p <- plot_mnsl(c( + lighter(my_blue, 2), my_blue, darker(my_blue, 2), + desaturate(my_blue, 2), my_blue, saturate(my_blue, 2), + rygbp(my_blue, 2), my_blue, pbgyr(my_blue, 2))) +p +``` + +![](READMEimages/manipulate-blue-1.png) + +Each function optionally takes the number of steps to take in the dimension and consequently are easily used to create scales in a particular dimension. + +``` r +p <- plot_mnsl(sapply(0:6, darker, col = "5PB 7/4")) +p + ggplot2::facet_wrap(~ num, nrow = 1) +``` + +![](READMEimages/palette-1.png) + +Colour space exploration +------------------------ + +Slices through the colour space of constant hue, chroma or value can be displayed using the functions: `hue_slice`, `chroma_slice` and `value_slice`. Additionally `complement_slice` displays a slice of constant hue, alongside a slice of its complement, the hue that is on the opposite side of the colour sphere to that specified. + +``` r +complement_slice("5R") +``` + +![](READMEimages/complement-slice-1.png) diff --git a/inst/raw/getmunsellmap.R b/inst/raw/getmunsellmap.R index beb21c7..10b0db5 100644 --- a/inst/raw/getmunsellmap.R +++ b/inst/raw/getmunsellmap.R @@ -9,7 +9,7 @@ getmunsellmap <- function(){ # 3. convert XYZ (D65) to sRGB # 1. convert to XYZ - # http://www.brucelindbloom.com/index.html?ColorCalcHelp.html + # http://www.brucelindbloom.com/Eqn_xyY_to_XYZ.html # Y needs to be scaled down by 100 col.map <- within(col.map, { Y <- Y/100 @@ -18,13 +18,13 @@ getmunsellmap <- function(){ }) # 2. convert to XYZ to use correct reference white (C to D65) - # http://www.brucelindbloom.com/index.html?ColorCalcHelp.html + # http://www.brucelindbloom.com/Eqn_ChromAdapt.html # using Bradford method Bradford.C.D65 <- matrix(c(0.990448, -0.012371, -0.003564, -0.007168, 1.015594, 0.006770, -0.011615, -0.002928, 0.918157), ncol=3, byrow=TRUE) col.map[ , c("X", "Y", "Z")] <- as.matrix(col.map[, c("X", "Y", "Z")]) %*% Bradford.C.D65 - # 3. Use colorspace methods to convert XYZ to hex (RGB) + # 3. Use colorspace methods to convert XYZ to hex (sRGB) col.map$hex <- hex(XYZ(100 * as.matrix(col.map[, c("X", "Y", "Z")]))) cols <- c("R", "YR", "Y", "GY", "G", "BG", "B", "PB", "P", "RP") @@ -34,7 +34,7 @@ getmunsellmap <- function(){ # from here: http://wiki.laptop.org/go/Munsell grey.map <- read.table("greys.dat", header = TRUE) - grey.map$hex <- hex(RGB(as.matrix(1/255 * grey.map[, c("r", "b", "g")]))) + grey.map$hex <- hex(sRGB(as.matrix(1/255 * grey.map[, c("r", "b", "g")]))) munsell.map <- rbind(grey.map[, c("h", "C", "V", "hex")], col.map[, c("h", "C", "V", "hex")]) diff --git a/man/check_mnsl.Rd b/man/check_mnsl.Rd index 0a99c38..f714599 100644 --- a/man/check_mnsl.Rd +++ b/man/check_mnsl.Rd @@ -1,25 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.r \name{check_mnsl} \alias{check_mnsl} \title{Checks for valid Munsell colours} \usage{ - check_mnsl(col, fix = FALSE) +check_mnsl(col) } \arguments{ - \item{col}{a character vector representing Munsell - colours.} +\item{col}{a character vector representing Munsell colours.} - \item{fix}{passed on to \code{\link{fix_mnsl}}. Use - \code{fix = TRUE} to fix "bad" colours} +\item{fix}{passed on to \code{\link{fix_mnsl}}. Use \code{fix = TRUE} to +fix "bad" colours} } \value{ - a character vector containing the input colours. If any - colours were outside the gamut they will be represented - by NA. +a character vector containing the input colours. If any colours +were outside the gamut they will be represented by NA. } \description{ - Checks user supplied munsell specification for validity. - I.e. colour is of form "h v/c" and h, v and c take valid - values. +Checks user supplied munsell specification for validity. +I.e. colour is of form "h v/c" and h, v and c take valid values. } \examples{ check_mnsl(c("5R 5/8","2.5R 9/28")) diff --git a/man/chroma_slice.Rd b/man/chroma_slice.Rd index f2c4bfa..5fb099d 100644 --- a/man/chroma_slice.Rd +++ b/man/chroma_slice.Rd @@ -1,21 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{chroma_slice} \alias{chroma_slice} \title{Plot all colours with the same chroma} \usage{ - chroma_slice(chroma.name = seq(0, 26, by = 2), - back.col = "white") +chroma_slice(chroma.name = seq(0, 26, by = 2), back.col = "white") } \arguments{ - \item{chroma.name}{integer vector of the desired values.} +\item{chroma.name}{integer vector of the desired values.} - \item{back.col}{colour for the background} +\item{back.col}{colour for the background} } \value{ - ggplot object +ggplot object } \description{ - Plots slices of the Munsell colour system where chroma is - constant. +Plots slices of the Munsell colour system where chroma is constant. } \examples{ chroma_slice(2) @@ -23,9 +23,9 @@ chroma_slice(18) # Maybe want to delete text and add axis instead p <- chroma_slice(18) p$layers[[2]] <- NULL # remove text layer -p + theme(axis.text = element_text(), - axis.text.x = element_text(angle = 90, hjust = 1)) -# all values +p + ggplot2::theme(axis.text = ggplot2::element_text(), + axis.text.x = ggplot2::element_text(angle = 90, hjust = 1)) +# all values \dontrun{chroma_slice(seq(0, 38, by = 2))} } diff --git a/man/complement.Rd b/man/complement.Rd index d616909..79869ab 100644 --- a/man/complement.Rd +++ b/man/complement.Rd @@ -1,21 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{complement} \alias{complement} \title{Find the complement of a munsell colour} \usage{ - complement(col, ...) +complement(col, ...) } \arguments{ - \item{col}{character vector of Munsell colours} +\item{col}{character vector of Munsell colours} - \item{...}{passed on to \code{\link{in_gamut}}. Use - \code{fix = TRUE} to fix "bad" complement} +\item{...}{passed on to \code{\link{in_gamut}}. Use \code{fix = TRUE} to +fix "bad" complement} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Finds the munsell colour with the same chroma and value - but on the opposite side of the hue circle. +Finds the munsell colour with the same chroma and value but on the opposite +side of the hue circle. The complement is not defined +for greys (hue == "N"), and the function returns the grey untransformed. } \examples{ complement("5PB 2/4") diff --git a/man/complement_slice.Rd b/man/complement_slice.Rd index 2bcf739..24fd4b6 100644 --- a/man/complement_slice.Rd +++ b/man/complement_slice.Rd @@ -1,22 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{complement_slice} \alias{complement_slice} \title{A vertical slice through the Munsell space} \usage{ - complement_slice(hue.name, back.col = "white") +complement_slice(hue.name, back.col = "white") } \arguments{ - \item{hue.name}{character string of the desired hue.} +\item{hue.name}{character string of the desired hue.} - \item{back.col}{colour for the background} +\item{back.col}{colour for the background} } \value{ - ggplot object +ggplot object } \description{ - Plot a hue and its complement at all values and chromas +Plot a hue and its complement at all values and chromas } \examples{ complement_slice("5PB") complement_slice("5R") +complement_slice("10G") } diff --git a/man/darker.Rd b/man/darker.Rd index 2a5b3c0..075b163 100644 --- a/man/darker.Rd +++ b/man/darker.Rd @@ -1,21 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{darker} \alias{darker} \title{Make a munsell colour darker} \usage{ - darker(col) +darker(col, steps = 1) } \arguments{ - \item{col}{character vector of Munsell colours} +\item{col}{character vector of Munsell colours} + +\item{steps}{number of steps to take in decreasing value} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Decreases the value of the Munsell colour by 1. +Decreases the value of the Munsell colour by 1. } \examples{ -darker("5PB 2/4") -cols <- c("5PB 2/4", "5Y 7/8") -plot_mnsl(c(cols, darker(cols))) +darker("5PB 3/4") +cols <- c("5PB 3/4", "5Y 7/8") +p <- plot_mnsl(c(cols, darker(cols), darker(cols, 2))) +p + ggplot2::facet_wrap(~ names, ncol = 2) } diff --git a/man/desaturate.Rd b/man/desaturate.Rd index 46b2ec7..7a1afdc 100644 --- a/man/desaturate.Rd +++ b/man/desaturate.Rd @@ -1,22 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{desaturate} \alias{desaturate} \title{Make a munsell colour less saturated} \usage{ - desaturate(col) +desaturate(col, steps = 1) } \arguments{ - \item{col}{character vector of Munsell colours} +\item{col}{character vector of Munsell colours} + +\item{steps}{number of steps to take in decreasing chroma} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Decreases the chroma of the Munsell colour by one step (- - 2). +Decreases the chroma of the Munsell colour by one step steps (multiples of 2). } \examples{ desaturate("5PB 2/4") -cols <- c("5PB 2/4", "5Y 7/8") -plot_mnsl(c(cols, desaturate(cols))) +cols <- c("5PB 2/6", "5Y 7/8") +p <- plot_mnsl(c(cols, desaturate(cols), desaturate(cols, 2))) +p + ggplot2::facet_wrap(~ names, ncol = 2) } diff --git a/man/fix_mnsl.Rd b/man/fix_mnsl.Rd index 63be284..55e1f14 100644 --- a/man/fix_mnsl.Rd +++ b/man/fix_mnsl.Rd @@ -1,22 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.r \name{fix_mnsl} \alias{fix_mnsl} \title{Fix an undefined Munsell colour} \usage{ - fix_mnsl(col) +fix_mnsl(col) } \arguments{ - \item{col}{a character vector representing Munsell - colours.} +\item{col}{a character vector representing Munsell colours.} } \value{ - a character vector containing the fixed colours. +a character vector containing the fixed colours. } \description{ - Takes correctly specified but undefined colours and - outputs something sensible. Normally this happens when - the chroma is too high. So, here sensible means the - colour with the same hue and value and maximum defined - chroma. +Takes correctly specified but undefined colours and outputs something +sensible. Normally this happens when the chroma is too high. So, here +sensible means the colour with the same hue and value and maximum defined +chroma. } \examples{ fix_mnsl(c("5R 5/8","2.5R 9/28")) diff --git a/man/hue_slice.Rd b/man/hue_slice.Rd index 74442a6..e98993a 100644 --- a/man/hue_slice.Rd +++ b/man/hue_slice.Rd @@ -1,21 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{hue_slice} \alias{hue_slice} \title{Plot all colours with the same hue} \usage{ - hue_slice(hue.name = "all", back.col = "white") +hue_slice(hue.name = "all", back.col = "white") } \arguments{ - \item{hue.name}{character vector of the desired hues. Or - "all" for all hues.} +\item{hue.name}{character vector of the desired hues. Or "all" for all hues.} - \item{back.col}{colour for the background} +\item{back.col}{colour for the background} } \value{ - ggplot object +ggplot object } \description{ - Plots slices of the Munsell colour system where hue is - constant. +Plots slices of the Munsell colour system where hue is constant. } \examples{ hue_slice("5R") diff --git a/man/hvc2mnsl.Rd b/man/hvc2mnsl.Rd index 982d3c2..b8afcb6 100644 --- a/man/hvc2mnsl.Rd +++ b/man/hvc2mnsl.Rd @@ -1,43 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert.r \name{hvc2mnsl} \alias{hvc2mnsl} \title{Converts a hue, chroma and value to a Munsell colour} \usage{ - hvc2mnsl(hue, value, chroma, ...) +hvc2mnsl(hue, value = NULL, chroma = NULL, ...) } \arguments{ - \item{hue}{a character vector of Munsell hues} +\item{hue}{a character vector of Munsell hues, or a 3 column data frame +containing the hue value and chroma levels} - \item{value}{a numeric vector of values} +\item{value}{a numeric vector of values} - \item{chroma}{a numeric vector of chromas} +\item{chroma}{a numeric vector of chromas} - \item{...}{passed on to \code{\link{check_mnsl}}. Use - \code{fix = TRUE} to fix "bad" colours} +\item{...}{passed on to \code{\link{check_mnsl}}. Use \code{fix = TRUE} to +fix "bad" colours} } \value{ - a character string specification of a hex colour +a character string specification of a hex colour } \description{ - Takes separate specifications of hue, value and chroma - and returns the text specification of that colour. +Takes separate specifications of hue, value and chroma and returns the +text specification of that colour. } \details{ - Munsell colours are specified by hue, value and chroma. - They take a form like "5PB 5/10" where the first - characters represent the hue, followed by a space then - the value and chroma separated by a "/". In this package - value should be an integer in 0:10 and chroma an even - number at most 24. Note that not all possible - specifications result in representable colours. Regular - recycling rules apply. +Munsell colours are specified by hue, value and chroma. They +take a form like "5PB 5/10" where the first characters represent the +hue, followed by a space then the value and chroma separated by a "/". In +this package value should be an integer in 0:10 and chroma an even number +at most 24. Note that not all possible specifications result in +representable colours. Regular recycling rules apply. } \examples{ hvc2mnsl("5PB", 5, 10) # All values of 5PB with chroma 10 hvc2mnsl("5PB", 1:9, 10) # note some are undefined -plot_mnsl(hvc2mnsl("5PB", 1:9, 2)) +plot_mnsl(hvc2mnsl("5PB", 1:9, 10)) } \seealso{ - \code{\link{check_mnsl}}, \code{\link{mnsl2hex}} +\code{\link{check_mnsl}}, \code{\link{mnsl2hex}} } diff --git a/man/in_gamut.Rd b/man/in_gamut.Rd index 69e9b7b..8322512 100644 --- a/man/in_gamut.Rd +++ b/man/in_gamut.Rd @@ -1,25 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.r \name{in_gamut} \alias{in_gamut} \title{Checks if a Munsell colour is defined in RGB space} \usage{ - in_gamut(col, fix = FALSE) +in_gamut(col, fix = FALSE) } \arguments{ - \item{col}{a character vector representing Munsell - colours.} +\item{col}{a character vector representing Munsell colours.} - \item{fix}{passed on to \code{\link{fix_mnsl}}. Use - \code{fix = TRUE} to fix "bad" colours} +\item{fix}{passed on to \code{\link{fix_mnsl}}. Use \code{fix = TRUE} to +fix "bad" colours} } \value{ - a character vector containing the input colours. If any - colours were outside the gamut they will be represented - by NA. +a character vector containing the input colours. If any colours +were outside the gamut they will be represented by NA. } \description{ - Not all possible correctly formatted Munsell colours - result in a colour representable in RGB space. This - function checks if the colour is representable. +Not all possible correctly formatted Munsell colours result in a colour +representable in RGB space. This function checks if the colour is +representable. } \examples{ in_gamut(c("5R 5/8","2.5R 9/28")) diff --git a/man/lighter.Rd b/man/lighter.Rd index fcaebf6..32e0d5f 100644 --- a/man/lighter.Rd +++ b/man/lighter.Rd @@ -1,21 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{lighter} \alias{lighter} \title{Make a munsell colour lighter} \usage{ - lighter(col) +lighter(col, steps = 1) } \arguments{ - \item{col}{character vector of Munsell colours} +\item{col}{character vector of Munsell colours} + +\item{steps}{number of steps to take in increasing value} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Increases the value of the Munsell colour by 1. +Increases the value of the Munsell colour. } \examples{ lighter("5PB 2/4") -cols <- c("5PB 2/4", "5Y 7/8") -plot_mnsl(c(cols, lighter(cols))) +cols <- c("5PB 2/4", "5Y 6/8") +p <- plot_mnsl(c(cols, lighter(cols), lighter(cols, 2))) +p + ggplot2::facet_wrap(~ names, ncol = 2) +# lighter and darker are usually reversible +lighter(darker("5PB 2/4")) +# unless you try to pass though white or black +lighter(darker("5PB 1/4")) } diff --git a/man/mnsl.Rd b/man/mnsl.Rd index f36784d..1053d1c 100644 --- a/man/mnsl.Rd +++ b/man/mnsl.Rd @@ -1,41 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert.r \name{mnsl} \alias{mnsl} \alias{mnsl2hex} \title{Converts a Munsell colour to hex} \usage{ - mnsl(col, ...) +mnsl(col, ...) } \arguments{ - \item{col}{a character string representing a Munsell - colour.} +\item{col}{a character string representing a Munsell colour.} - \item{...}{passed on to \code{\link{check_mnsl}}. Use - \code{fix = TRUE} to fix "bad" colours} +\item{...}{passed on to \code{\link{check_mnsl}}. Use \code{fix = TRUE} to +fix "bad" colours} } \value{ - a character string specification of a hex colour +a character string specification of a hex colour } \description{ - Take a character string representation of a Munsell - colour and returns the hex specification of that colour +Take a character string representation of a Munsell colour and returns the +hex specification of that colour } \details{ - Munsell colours are specified by hue, value and chroma. - They take a form like "5PB 5/10" where the first - characters represent the hue, followed by a space then - the value and chroma separated by a "/". In this package - value should be an integer in 0:10 and chroma an even - number at most 24. Note that not all possible - specifications result in representable colours. +Munsell colours are specified by hue, value and chroma. They +take a form like "5PB 5/10" where the first characters represent the +hue, followed by a space then the value and chroma separated by a "/". In +this package value should be an integer in 0:10 and chroma an even number +at most 24. Note that not all possible specifications result in +representable colours. } \examples{ mnsl2hex("5PB 5/10") # use a munsell colour in a plot -require("ggplot2") -ggplot(data.frame(x = 1:10)) + geom_point(aes(x = x, y = x), - colour = mnsl2hex("5PB 5/10")) +plot.new() +rect(0, 0, 1 ,1 , col = mnsl("5R 5/10")) } \seealso{ - \code{\link{check_mnsl}}, \code{\link{hvc2mnsl}} +\code{\link{check_mnsl}}, \code{\link{hvc2mnsl}} } diff --git a/man/mnsl2hvc.Rd b/man/mnsl2hvc.Rd new file mode 100644 index 0000000..b31bf04 --- /dev/null +++ b/man/mnsl2hvc.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert.r +\name{mnsl2hvc} +\alias{mnsl2hvc} +\title{Converts a Munsell colour to a hue, chroma and value triplet} +\usage{ +mnsl2hvc(col, ...) +} +\arguments{ +\item{col}{a character vector of Munsell colours} + +\item{...}{passed on to \code{\link{check_mnsl}}. Use \code{fix = TRUE} to +fix "bad" colours} +} +\value{ +a data frame with named columns hue, value and chroma containing the hue, +value and chroma levels. +} +\description{ +Takes a text specification of a Munsell colour and returns +the hue, chroma and value triplet. +} +\details{ +Munsell colours are specified by hue, value and chroma. They +take a form like "5PB 5/10" where the first characters represent the +hue, followed by a space then the value and chroma separated by a "/". In +this package value should be an integer in 0:10 and chroma an even number +at most 24. Note that not all possible specifications result in +representable colours. +} +\examples{ +mnsl2hvc("5PB 5/10") +hvc2mnsl(mnsl2hvc("5PB 5/10")) +} +\seealso{ +\code{\link{check_mnsl}}, \code{\link{hvc2mnsl}} +} + diff --git a/man/mnsl_hues.Rd b/man/mnsl_hues.Rd index fd289f3..9aceb60 100644 --- a/man/mnsl_hues.Rd +++ b/man/mnsl_hues.Rd @@ -1,15 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check.r \name{mnsl_hues} \alias{mnsl_hues} \title{Munsell hues} \usage{ - mnsl_hues() +mnsl_hues() } \value{ - a character vector containing the fixed colours. +a character vector containing the hue values. } \description{ - Returns a character vector of the Munsell hues in hue - order starting at 2.5R and excluding grey ("N"). +Returns a character vector of the Munsell hues in hue order starting at 2.5R and excluding grey ("N"). } \examples{ mnsl_hues() diff --git a/man/munsell.Rd b/man/munsell.Rd index c55705f..7f4e4b8 100644 --- a/man/munsell.Rd +++ b/man/munsell.Rd @@ -1,3 +1,5 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/munsell.r \docType{package} \name{munsell} \alias{munsell} @@ -5,7 +7,12 @@ \alias{package-munsell} \title{Munsell colour system.} \description{ - This package makes it easy to access and manipulate the - colours in the munsell colour system. +This package makes it easy to access and manipulate the colours in the +munsell colour system. The conversion from munsell specifications to sRGB based on the renotation data from \url{http://www.cis.rit.edu/mcsl/online/munsell.php} which is a digitization of Table 1 in Newhall, Nickerson & Judd (1943). The code for conversion can be found in the package directory in inst/raw/getmunsellmap.r +} +\references{ +S. M. Newhall, D. Nickerson, and D. B. Judd. Final report of the O.S.A. subcommittee on the spacing of the munsell colors. J. Opt. Soc. Am., 33(7):385-411, 07 1943. + +Munsell Renotation Data, RIT Munsell Color Science Laboratory. \url{http://www.cis.rit.edu/mcsl/online/munsell.php} } diff --git a/man/pbgyr.Rd b/man/pbgyr.Rd new file mode 100644 index 0000000..a8da706 --- /dev/null +++ b/man/pbgyr.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r +\name{pbgyr} +\alias{pbgyr} +\title{Change the hue of a munsell colour} +\usage{ +pbgyr(col, steps = 1) +} +\arguments{ +\item{col}{character vector of Munsell colours} + +\item{steps}{number of hue steps to take} +} +\value{ +character vector of Munsell colours +} +\description{ +Moves the hue of a munsell colour in the direction purple->blue->green->yellow->red->purple +} +\examples{ +my_red <- "2.5R 4/8" +pbgyr(my_red) +plot_mnsl(c(my_red, pbgyr(my_red, 2), pbgyr(my_red, 4))) +} + diff --git a/man/plot_closest.Rd b/man/plot_closest.Rd index 2e85a02..9e0d9b4 100644 --- a/man/plot_closest.Rd +++ b/man/plot_closest.Rd @@ -1,31 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{plot_closest} \alias{plot_closest} -\title{Plot closest Munsell colour to an RGB colour} +\title{Plot closest Munsell colour to an sRGB colour} \usage{ - plot_closest(R, G = NULL, B = NULL, back.col = "white") +plot_closest(R, G = NULL, B = NULL, back.col = "white") } \arguments{ - \item{R}{a numeric vector of red values or a 3 column - matrix with the proportions R, G, B in the columns.} +\item{R}{a numeric vector of red values or a 3 column matrix with the +proportions R, G, B in the columns.} - \item{G}{numeric vector of green values} +\item{G}{numeric vector of green values} - \item{B}{numeric vector of blue values} +\item{B}{numeric vector of blue values} - \item{back.col}{colour for the background} +\item{back.col}{colour for the background} } \value{ - ggplot object +ggplot object } \description{ - Take an RGB colour and plots it along with the closest - Munsell colour (using \code{\link{rgb2mnsl}} to find it) +Take an sRGB colour and plots it along with the closest Munsell colour (using \code{\link{rgb2mnsl}} to find it) } \examples{ plot_closest(0.1, 0.1, 0.3) -plot_closest(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) +plot_closest(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) } \seealso{ - \code{\link{rgb2mnsl}} +\code{\link{rgb2mnsl}} } diff --git a/man/plot_hex.Rd b/man/plot_hex.Rd index 65f0209..2894cf7 100644 --- a/man/plot_hex.Rd +++ b/man/plot_hex.Rd @@ -1,21 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{plot_hex} \alias{plot_hex} \title{Plot hex colours} \usage{ - plot_hex(hex.colour, back.col = "white") +plot_hex(hex.colour, back.col = "white") } \arguments{ - \item{hex.colour}{character vector specifying colours in - hex form} +\item{hex.colour}{character vector specifying colours in hex form} - \item{back.col}{specification of background colour of - display} +\item{back.col}{specification of background colour of display} } \value{ - A ggplot object +A ggplot object } \description{ - Quick way to look at a set of hex colours. +Quick way to look at a set of hex colours. } \examples{ plot_hex("#000000") diff --git a/man/plot_mnsl.Rd b/man/plot_mnsl.Rd index 66448f2..43c6386 100644 --- a/man/plot_mnsl.Rd +++ b/man/plot_mnsl.Rd @@ -1,25 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{plot_mnsl} \alias{plot_mnsl} \title{Plot a munsell colour} \usage{ - plot_mnsl(cols, back.col = "white", ...) +plot_mnsl(cols, back.col = "white", ...) } \arguments{ - \item{cols}{character vector specifying colours in - Munsell form} +\item{cols}{character vector specifying colours in Munsell form} - \item{back.col}{specification of background colour of - display} +\item{back.col}{specification of background colour of display} - \item{...}{passed to \code{\link{check_mnsl}}. Add fix = - TRUE to fix "bad" colours()} +\item{...}{passed to \code{\link{check_mnsl}}. Add fix = TRUE to fix "bad" colours()} } \value{ - A ggplot object +A ggplot object } \description{ - Takes munsell text specifications and plots colour - squares of them. +Takes munsell text specifications and plots colour squares of them. } \examples{ plot_mnsl("5R 5/6") @@ -29,6 +27,6 @@ p <- plot_mnsl(c("5R 6/6", "5Y 6/6", "5G 6/6", "5B 6/6", "5P 6/6"), p # returned object is a ggplot object so we can alter the layout summary(p) -p + facet_wrap(~ names, nrow = 1) +p + ggplot2::facet_wrap(~ num, nrow = 1) } diff --git a/man/rgb2mnsl.Rd b/man/rgb2mnsl.Rd index 51c9c5f..20549ab 100644 --- a/man/rgb2mnsl.Rd +++ b/man/rgb2mnsl.Rd @@ -1,20 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert.r \name{rgb2mnsl} \alias{rgb2mnsl} -\title{Converts an RGB colour to Munsell} +\title{Converts an sRGB colour to Munsell} \usage{ - rgb2mnsl(R, G = NULL, B = NULL) +rgb2mnsl(R, G = NULL, B = NULL) } \arguments{ - \item{R}{a numeric vector of red values or a 3 column - matrix with the proportions R, G, B in the columns.} +\item{R}{a numeric vector of red values or a 3 column matrix with the +proportions R, G, B in the columns.} - \item{G}{numeric vector of green values} +\item{G}{numeric vector of green values} - \item{B}{numeric vector of blue values} +\item{B}{numeric vector of blue values} } \description{ - Finds the closest Munsell colour (in LUV space) to the - specified RGB colour +Finds the closest Munsell colour (in LUV space) to the specified sRGB colour } \examples{ rgb2mnsl(0.1, 0.1, 0.3) @@ -22,6 +23,6 @@ rgb2mnsl(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) plot_closest(matrix(c(.1, .2, .4, .5, .6, .8), ncol = 3)) } \seealso{ - \code{\link{plot_closest}} +\code{\link{plot_closest}} } diff --git a/man/rygbp.Rd b/man/rygbp.Rd new file mode 100644 index 0000000..9c59d75 --- /dev/null +++ b/man/rygbp.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r +\name{rygbp} +\alias{rygbp} +\title{Change the hue of a munsell colour} +\usage{ +rygbp(col, steps = 1) +} +\arguments{ +\item{col}{character vector of Munsell colours} + +\item{steps}{number of hue steps to take} +} +\value{ +character vector of Munsell colours +} +\description{ +Moves the hue of a munsell colour in the direction red->yellow->green->blue->purple->red +} +\examples{ +my_red <- "10R 4/8" +rygbp(my_red) +plot_mnsl(c(my_red, rygbp(my_red, 2), rygbp(my_red, 4))) +} + diff --git a/man/saturate.Rd b/man/saturate.Rd index 7d484b8..b0f3f7b 100644 --- a/man/saturate.Rd +++ b/man/saturate.Rd @@ -1,22 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{saturate} \alias{saturate} \title{Make a munsell colour more saturated} \usage{ - saturate(col) +saturate(col, steps = 1) } \arguments{ - \item{col}{character vector of Munsell colours} +\item{col}{character vector of Munsell colours} + +\item{steps}{number of steps to take in increasing chroma} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Increases the chroma of the Munsell colour by one step (+ - 2). +Increases the chroma of the Munsell colour by step steps (multiples of 2). } \examples{ saturate("5PB 2/4") -cols <- c("5PB 2/4", "5Y 7/8") -plot_mnsl(c(cols, saturate(cols))) +cols <- c("5PB 2/2", "5Y 7/6") +p <- plot_mnsl(c(cols, saturate(cols), saturate(cols, 2))) +p + ggplot2::facet_wrap(~ names, ncol = 2) } diff --git a/man/seq_mnsl.Rd b/man/seq_mnsl.Rd index d83f4bd..cfb4956 100644 --- a/man/seq_mnsl.Rd +++ b/man/seq_mnsl.Rd @@ -1,27 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/alter.r \name{seq_mnsl} \alias{seq_mnsl} \title{Generate a sequence of Munsell colours} \usage{ - seq_mnsl(from, to, n) +seq_mnsl(from, to, n, fix = FALSE) } \arguments{ - \item{from}{character string of first Munsell colour} +\item{from}{character string of first Munsell colour} - \item{to}{character string of last Munsell colour} +\item{to}{character string of last Munsell colour} - \item{n}{number of colours in sequence} +\item{n}{number of colours in sequence} + +\item{fix}{Should colours outside of the gamut be fixed? +Passed on to \code{\link{fix_mnsl}}} } \value{ - character vector of Munsell colours +character vector of Munsell colours } \description{ - Generates a sequence of Munsell colours. The sequence is - generated by finding the closest munsell colours to a - equidistant sequence of colours in #' LUV space. +Generates a sequence of Munsell colours. The sequence is generated by +finding the closest munsell colours to a equidistant sequence of colours in #' LUV space. } \examples{ seq_mnsl("5R 2/4", "5R 5/16", 4) plot_mnsl(seq_mnsl("5R 2/4", "5R 5/16", 4)) -plot_mnsl(seq_mnsl("5R 2/4", complement("5R 2/4", fix = TRUE), 5)) +plot_mnsl(seq_mnsl("5R 5/6", + complement("5R 5/6"), 5)) } diff --git a/man/text_colour.Rd b/man/text_colour.Rd index 715bbdd..a0ce549 100644 --- a/man/text_colour.Rd +++ b/man/text_colour.Rd @@ -1,18 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{text_colour} \alias{text_colour} \title{Get text colour} \usage{ - text_colour(cols) +text_colour(cols) } \arguments{ - \item{a}{character vector of munsell colours} +\item{a}{character vector of munsell colours} } \value{ - a vector of "black" or "white" +a vector of "black" or "white" } \description{ - Get the appropriate text colour for writing on a munsell - colour. +Get the appropriate text colour for writing on a munsell colour. } \keyword{internal} diff --git a/man/theme_munsell.Rd b/man/theme_munsell.Rd index 0759fe1..792f01d 100644 --- a/man/theme_munsell.Rd +++ b/man/theme_munsell.Rd @@ -1,14 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{theme_munsell} \alias{theme_munsell} \title{Default munsell plot theme} \usage{ - theme_munsell(bg.col) +theme_munsell(bg.col = "white") } \arguments{ - \item{bg.col}{takes colour to use as background colour} +\item{bg.col}{takes colour to use as background colour} } \description{ - Removes unnecessary clutter in plots +Removes unnecessary clutter in plots } \keyword{internal} diff --git a/man/value_slice.Rd b/man/value_slice.Rd index 5e2b11d..35b2b32 100644 --- a/man/value_slice.Rd +++ b/man/value_slice.Rd @@ -1,25 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.r \name{value_slice} \alias{value_slice} \title{Plot all colours with the same value} \usage{ - value_slice(value.name = 1:10, back.col = "white") +value_slice(value.name = 1:10, back.col = "white") } \arguments{ - \item{value.name}{integer vector of the desired values.} +\item{value.name}{integer vector of the desired values.} - \item{back.col}{colour for the background} +\item{back.col}{colour for the background} } \value{ - ggplot object +ggplot object } \description{ - Plots slices of the Munsell colour system where value is - constant. +Plots slices of the Munsell colour system where value is constant. } \examples{ value_slice(2) value_slice(c(2, 4)) -# all values +# all values \dontrun{value_slice(1:10)} } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..7245f4c --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,3 @@ +library(testthat) +library(munsell) +test_check("munsell") \ No newline at end of file diff --git a/tests/testthat/test-alter.R b/tests/testthat/test-alter.R new file mode 100644 index 0000000..d6f98cf --- /dev/null +++ b/tests/testthat/test-alter.R @@ -0,0 +1,78 @@ + +context("Lightening/darkening colours") + +test_that("Lightening a light colour gives white", { + expect_equal(lighter("5PB 9/4"), "N 10/0") + expect_equal(lighter("N 9/0"), "N 10/0") + expect_equal(lighter("N 10/0 "), "N 10/0") + expect_equal(lighter(c("N 9/0 ", "N 10/0 ")), c("N 10/0", "N 10/0")) +}) + +test_that("Darkening a dark colour gives black", { + expect_equal(darker("N 0/0"), "N 0/0") + expect_equal(darker("5PB 1/4"), "N 0/0") +}) + +test_that("Negative darkening lightens", { + expect_equal(lighter("5PB 2/4", -1), darker("5PB 2/4", 1)) +}) + +context("Saturate/desaturate colours") + +test_that("Saturation edge cases", { + expect_equal(desaturate("5PB 2/2"), "N 2/0") + expect_equal(saturate("5PB 2/32"), "5PB 2/34") +}) + +test_that("Saturation/desaturate opposites", { + expect_equal(desaturate("5PB 2/4"), saturate("5PB 2/4", -1)) + expect_equal(desaturate(saturate("5PB 2/10")), "5PB 2/10") +}) + +context("Complement colours") + +test_that("Complement",{ + expect_equal(complement("2.5R 2/2"), "2.5BG 2/2") + expect_equal(complement("10G 2/2"), "10RP 2/2") + expect_warning(complement("N 10/0"), "grey") +}) + +context("Hues") + +test_that("hue edges",{ + expect_equal(pbgyr("2.5R 2/2"), "10RP 2/2") + expect_equal(rygbp("10RP 2/2"), "2.5R 2/2") + expect_warning(rygbp("N 10/0"), "[Gg]rey") +}) + +context("Handling NAs") +test_that(" NA handler", { +expect_equivalent(na_handle(na.exclude(NA), numeric(0)), as.numeric(NA)) +# vector vector +expect_equal(na_handle(na.exclude(c(NA, 1:2)), 3:4), c(NA, 3, 4)) +# vector dataframe +expect_equivalent(na_handle(na.exclude(c(NA, 1:2)), data.frame(x = 1:2, y = 4:5)), + data.frame(x = c(NA, 1:2), y = c(NA, 4:5))) +# dataframe vector +expect_equivalent(na_handle(na.exclude(data.frame(x = c(NA, 1:2), y = c(NA, 4:5))), 1:2), + c(NA, 1:2)) +# dataframe dataframe +expect_equivalent(na_handle(na.exclude(data.frame(x = c(NA, 1:2), y = c(NA, 4:5))), + data.frame(x = 1:2, y = 4:5)), + data.frame(x = c(NA, 1:2), y = c(NA, 4:5))) +}) + +test_that("single NA", { + expect_error(lighter(NA), "zero") + expect_error(saturate(NA),"zero") + expect_error(rygbp(NA), "zero") + expect_error(complement(NA), "zero") +}) + +test_that("NA with colour", { + expect_equal(lighter(c(NA, "10RP 2/2")), c(NA, lighter("10RP 2/2"))) + expect_equal(saturate(c(NA, "10RP 2/2")), c(NA, saturate("10RP 2/2"))) + expect_equal(rygbp(c(NA, "10RP 2/2")), c(NA, rygbp("10RP 2/2"))) + expect_equal(complement(c(NA, "10RP 2/2")), c(NA, complement("10RP 2/2"))) +}) + diff --git a/tests/testthat/test-convert.R b/tests/testthat/test-convert.R new file mode 100644 index 0000000..50abc37 --- /dev/null +++ b/tests/testthat/test-convert.R @@ -0,0 +1,12 @@ +context("Testing missing value conversion") + +test_that("NAs handled in convert", { + expect_error(mnsl2hvc(c(NA)), "zero") + expect_equal(hvc2mnsl(mnsl2hvc(c(NA, "10RP 2/2"))), c(NA, "10RP 2/2")) +}) + +test_that("NAs handled in checks", { + expect_equal(check_mnsl(NA), as.character(NA)) + expect_equal(in_gamut(NA), as.logical(NA)) #wtf + expect_equal(check_mnsl(c(NA, "10RP 2/2")), c(NA, "10RP 2/2")) +}) -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-munsell.git _______________________________________________ debian-med-commit mailing list debian-med-commit@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/debian-med-commit