implementing checks and fix for #44

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: aqp
 Version: 1.18.2
-Date: 2019-12-09
+Date: 2019-12-12
 Title: Algorithms for Quantitative Pedology
 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut", "cre"), email = "[email protected]"), person(given="Pierre", family="Roudier", email="[email protected]", role = c("aut", "ctb")), person(given="Andrew", family="Brown", email="[email protected]", role = c("aut", "ctb")))
 Author: Dylan Beaudette [aut, cre], Pierre Roudier [aut, ctb], Andrew Brown [aut, ctb]

R/munsell2rgb.R

@@ -223,7 +223,7 @@ munsell2rgb <- function(the_hue, the_value, the_chroma, alpha=1, maxColorValue=1
 		stop('Must supply a valid Munsell color.')
 
 	# check to make sure that each vector is the same length
-	if(length(unique( c(length(the_hue),length(the_value),length(the_chroma)))) != 1)
+	if(length(unique( c(length(the_hue), length(the_value), length(the_chroma)))) != 1)
 		stop('All inputs must be vectors of equal length.')
 
   ## plyr <= 1.6 : check to make sure hue is a character
@@ -252,10 +252,21 @@ munsell2rgb <- function(the_hue, the_value, the_chroma, alpha=1, maxColorValue=1
   ## 2016-03-07: "fix" values of 2.5 by rounding to 2
   the_value <- ifelse(the_value == 2.5, 2, the_value)
 
+  ## temporary fix for #44 (https://github.com/ncss-tech/aqp/issues/44)
+  # round non integer value and chroma
+  if ( !isTRUE(all.equal(as.character(the_value), as.character(as.integer(the_value)) )) ) {
+    the_value <- round(as.numeric(the_value))
+    warning("'the_value' has been rounded to the nearest integer.", call. = FALSE)
+  }
+  if ( !isTRUE(all.equal(as.character(the_chroma), as.character(as.integer(the_chroma)) )) ) {
+    the_chroma <- round(as.numeric(the_chroma))
+    warning("'the_chroma' has been rounded to the nearest integer.", call. = FALSE)
+  }
 
   # join new data with look-up table
   d <- data.frame(hue=the_hue, value=the_value, chroma=the_chroma, stringsAsFactors=FALSE)
-  res <- join(d, munsell, type='left', by=c('hue','value','chroma')) # result has original munsell + r,g,b
+  ## TODO: convert to merge()
+  res <- join(d, munsell, type='left', by=c('hue','value','chroma')) 
 
   # reset options:
   options(opt.original)

tests/testthat/test-color-conversion.R

@@ -21,11 +21,12 @@ x.neutral <- parseMunsell('N 2/', return_triplets=TRUE)
 test_that("parsing Munsell notation", {
 
   # parsing bogus notation generates NA
-  expect_equal(parseMunsell('10YZ 4/5'), as.character(NA))
-  expect_equal(parseMunsell('10YR /5'), as.character(NA))
-  expect_equal(parseMunsell('10YR '), as.character(NA))
-  expect_equal(parseMunsell('10YR 4/'), as.character(NA))
-  expect_equal(parseMunsell('G1 6/N'), as.character(NA))
+  # will also generate a warning from munsell2rgb()
+  expect_equal(suppressWarnings(parseMunsell('10YZ 4/5')), as.character(NA))
+  expect_equal(suppressWarnings(parseMunsell('10YR /5')), as.character(NA))
+  expect_equal(suppressWarnings(parseMunsell('10YR ')), as.character(NA))
+  expect_equal(suppressWarnings(parseMunsell('10YR 4/')), as.character(NA))
+  expect_equal(suppressWarnings(parseMunsell('G1 6/N')), as.character(NA))
 
   # parsing bogus notation without conversion
   # doesn't replace with NA
@@ -61,6 +62,31 @@ test_that("Munsell hue parsing", {
 })
 
 
+test_that("non-integer value and chroma are rounded", {
+
+  # rounding of value, throws warning
+  expect_warning(res <- parseMunsell('10YR 3.3/4'), regexp = 'rounded')
+  # this will not throw a warning
+  res <- parseMunsell('10YR 3.3/4', convertColors = FALSE)
+  # results should be the same
+  expect_equal(
+    suppressWarnings(parseMunsell('10YR 3.3/4')),
+    parseMunsell('10YR 3/4')
+  )
+
+  # rounding of chroma, throws warning
+  expect_warning(res <- parseMunsell('10YR 3/4.6'), regexp = 'rounded')
+  # this will not throw a warning
+  res <- parseMunsell('10YR 3/4.6', convertColors = FALSE)
+  # results should be the same
+  expect_equal(
+    suppressWarnings(parseMunsell('10YR 3/4.6')),
+    parseMunsell('10YR 3/5')
+  )
+
+})
+
+
 test_that("Munsell <--> sRGB and back again", {
 
   # sRGB in hex notation