additional checks c4a_data

R/c4a_data.R

@@ -61,13 +61,14 @@ c4a_data = function(x, xNA = NA, types = "cat", series = "x", nmin = NA, nmax =
  # check color list
  if (!is.list(x)) stop("x is not a list")
  nms = names(x)
+ if (is.null(nms)) stop("x must be named")
  x = lapply(x, validate_colors, name = "x", from_list = TRUE)
 
  # number of palettes
  k = length(x)
 
  # make everything length k (number of palettes)
- args = setdiff(ls(), c("x", "k"))
+ args = setdiff(ls(), c("x", "k", "nms"))
  length(range_matrix_args)
 
  # manual preprocessing
@@ -138,7 +139,9 @@ c4a_data = function(x, xNA = NA, types = "cat", series = "x", nmin = NA, nmax =
  if (length(seriesID)) fnms[seriesID] = paste0(series[seriesID], ".", fnms[seriesID])
 
 
- if (anyDuplicated(fnms)) stop("Duplicated names found")
+ if (anyDuplicated(fnms)) {
+ stop("Duplicated names found: ", paste(fnms[anyDuplicated(fnms)], collapse = ", "))
+ }
 
 
  names(x) = nms

R/process_palette.R

@@ -17,7 +17,10 @@ process_palette = function(pal, type, colNA = NA, take.gray.for.NA = TRUE, remov
  #specplot(hcl(h=seq(0,360,by=10), c = 15, l= 0))
  if (remove.blacks && type == "cat") {
  isB = (hcl[,3] + hcl[,2]) <= 15
- if (any(isB)) {
+ if (all(isB)) {
+ message("Palette contains only (almost) blacks. Therefore remove.blacks is set to FALSE")
+ remove.blacks = FALSE
+ } else if (any(isB)) {
  pal = pal[!isB]
  hcl = hcl[!isB,]
  }
@@ -27,11 +30,15 @@ process_palette = function(pal, type, colNA = NA, take.gray.for.NA = TRUE, remov
  if (type == "cat") {
  if (take.gray.for.NA) {
  wG = which(hcl[,2] < .C4A$Cgray)
- if (length(wG) && is.na(colNA)) {
+ if (length(wG) == nrow(hcl)) {
+ message("Palette contains only (almost) greys. Therefore take.gray.for.NA and remove.other.grays will be set to FALSE")
+ take.gray.for.NA = FALSE
+ remove.other.grays = FALSE
+ } else if (length(wG) && is.na(colNA)) {
  wNA = wG[which.max(hcl[wG, 3])]
  colNA = pal[wNA]
  pal = pal[-wNA]
- hcl = hcl[-wNA,]
+ hcl = hcl[-wNA,,drop=FALSE]
  }
  }