Test unhcrthemes nmax and order args

scale_color_fill_nmax.R

remotes::install_github("dickoa/unhcrthemes") 

library(unhcrthemes)
library(ggplot2)
library(ragg)

### checking scale_color
ggplot(iris, aes(x = Petal.Length, y = Petal.Width, color = Species)) +
  geom_point() +
  scale_color_unhcr_d(palette = "pal_main_qual") +
  labs(x = "Petal length", y="Petal width",
      title = "scale_color no change in the order using 'pal_main_qual'",
      caption = "Source: someone") +
  theme_unhcr()

ggsave("~/Desktop/scale_color_d0.png", last_plot(),
       device = ragg::agg_png,
       res = 300, units = "in")

### checking scale_color
ggplot(iris, aes(x = Petal.Length, y = Petal.Width, color = Species)) +
  geom_point() +
  scale_color_unhcr_d(palette = "pal_main_qual", nmax = 5,
                      order = c(1, 3, 5)) +
  labs(x = "Petal length", y="Petal width",
      title = "scale_color changing the order",
      subtitle = "nmax = 5, order = c(1, 3, 5)",
      caption = "Source: someone") +
  theme_unhcr()

ggsave("~/Desktop/scale_color_d1.png", last_plot(),
       device = ragg::agg_png,
       res = 300, units = "in")

### checking scale_fill
ggplot(iris, aes(x = Petal.Length, y = Petal.Width,  fill = Species)) +
  geom_point(shape = 21, size = 5) +
  scale_fill_unhcr_d(palette = "pal_main_qual", nmax = 5, order = c(1, 3, 5)) +
  labs(x = "Petal length", y="Petal width",
      title = "scale_fill also works!",
      subtitle = "nmax = 5, order = c(1, 3, 5)",
      caption = "Source: someone") +
  theme_unhcr()

ggsave("~/Desktop/scale_fill_d1.png", last_plot(),
       device = ragg::agg_png,
       res = 300, units = "in")


## change to check again
ggplot(iris, aes(x = Petal.Length, y = Petal.Width,  fill = Species)) +
  geom_point(shape = 21, size = 5) +
  scale_fill_unhcr_d(palette = "pal_main_qual", nmax = 5, order = c(5, 4, 1)) +
  labs(x = "Petal length", y = "Petal width",
      title = "scale_fill changing order",
      subtitle = "nmax = 5, order = c(5, 4, 1)",
      caption = "Source: someone") +
  theme_unhcr()

ggsave("~/Desktop/scale_fill_d2.png", last_plot(),
       device = ragg::agg_png,
       res = 300, units = "in")


### No impact on sequential scale
ggplot(iris, aes(x = Petal.Length, y = Petal.Width, color = Sepal.Width)) +
  geom_point() +
  scale_color_unhcr_c(palette = "pal_blue_seq") +
  labs(x = "Petal length", y = "Petal width",
       title = "scale_color sequential still works!",
       caption = "Source: someone") +
  theme_unhcr()

ggsave("~/Desktop/scale_color_c.png", last_plot(),
       device = ragg::agg_png,
       res = 300, units = "in")

scales.R

#' UNHCR ggplot2 color scales
#'
#' UNHCR ggplot2 color scales
#'
#' @inheritParams scales::gradient_n_pal
#' @inheritParams ggplot2::continuous_scale
#' @inheritParams ggplot2::discrete_scale
#'
#' @param type One of \"sequential\", \"diverging\" or \"qualitative\"
#' @param palette If a string, will use that named palette. If a number, will
#'   index into the list of palettes of appropriate `type`
#' @param direction Sets the order of colors in the scale. If 1, the default,
#'   colors are as output by [unhcr_pal()]. If -1, the order of colors is reversed
#' @param nmax Maximum number of different colors the palette should contain. If not provided, is calculated automatically
#'  from the data.
#' @param order Numeric vector listing the order in which the colors should be used. Default is \code{1:nmax}.
#' @param ... Other arguments passed on to [discrete_scale()] or
#' [continuous_scale()] to control name, limits, breaks, labels and so forth
#'
#' @importFrom ggplot2 discrete_scale continuous_scale
#' @importFrom scales gradient_n_pal
#'
#' @examples
#' library(ggplot2)
#'
#' ggplot(msleep, aes(vore, sleep_total, fill = vore)) +
#'         geom_boxplot() +
#'         scale_fill_unhcr_d(palette = 1, direction = -1)
#'
#' @rdname unhcr_scale
#' @export
#'
scale_color_unhcr_c <- function(..., type = "sequential",
                                palette = 1,
                                direction = 1,
                                na.value = "#E9E9E9", guide = "colourbar") {

  pal <- unhcr_pal_scale(type = type,
                         palette = palette,
                         direction = direction)(256)

  continuous_scale("colour",
                   "unhcr_continuous",
                   gradient_n_pal(pal),
                   na.value = na.value,
                   guide = guide,
                   ...)
}

#' @rdname unhcr_scale
#' @export
scale_color_unhcr_d <- function(..., type = "qualitative",
                                palette = 1,
                                direction = 1,
                                nmax = NULL,
                                order = NULL,
                                na.value = "#E9E9E9") {

  pal <- unhcr_pal_scale(type = type,
                         palette = palette,
                         nmax = nmax,
                         order = order,
                         direction = direction)

  discrete_scale("colour",
                 "unhcr_discrete",
                 pal,
                 na.value = na.value,
                 ...)
}


#' @rdname unhcr_scale
#' @aliases scale_color_unhcr_c
#' @export
scale_colour_unhcr_c <- scale_color_unhcr_c

#' @rdname unhcr_scale
#' @aliases scale_color_unhcr_d
#' @export
scale_colour_unhcr_d <- scale_color_unhcr_d

#' @rdname unhcr_scale
#' @export
scale_fill_unhcr_c <- function(..., type = "sequential",
                               palette = 1,
                               direction = 1,
                               na.value = "#E9E9E9",
                               guide = "colourbar") {

  pal <- unhcr_pal_scale(type = type,
                         palette = palette,
                         direction = direction)(256)

  continuous_scale("fill",
                   "unhcr_continuous",
                   gradient_n_pal(pal),
                   na.value = na.value,
                   guide = guide,
                   ...)
}

#' @rdname unhcr_scale
#' @export
scale_fill_unhcr_d <- function(..., type = "qualitative",
                               palette = 1,
                               direction = 1,
                               nmax = NULL,
                               order = NULL,
                               na.value	= "#E9E9E9") {

  pal <- unhcr_pal_scale(type = type,
                         palette = palette,
                         nmax = nmax,
                         order = order,
                         direction = direction)

  discrete_scale("fill",
                 "unhcr_discrete",
                 pal,
                 na.value = na.value,
                 ...)
}

#' @noRd
unhcr_pal_scale <- function(type = "qualitative",
                            nmax = FALSE, order = FALSE,
                            palette = 1, direction = 1) {
  pal <- unhcr_pal_name(palette, type)

  function(n) {
    if (is.null(nmax) | type != "qualitative")
      nmax <- n
    if (is.null(order) | type != "qualitative")
      order <- 1:n

    if (n > nmax) {
      warning("Insufficient values in scale_{color|fill}_unhcr_d. ", n, " needed but only ",
              nmax, " provided.", call. = FALSE)
    }

    # 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 (nmax < 3) {
      pal <- suppressWarnings(unhcr_pal(nmax, pal))
    } else {
      pal <- unhcr_pal(nmax, pal)
    }

    # In both cases ensure we have n items
    pal <- pal[order]

    if (direction == -1)
      pal = rev(pal)
    pal
  }
}


#' @noRd
unhcr_pal_name <- function(palette, type) {
  if (is.character(palette)) {
    if (!palette %in% unhcrcolors$name) {
      warning("Unknown palette ", palette)
      palette = "pal_blue_s"
    }
    return(palette)
  }

  type <- match.arg(type, unique(unhcrcolors$type))
  unhcrcolors$name[unhcrcolors$type == type][palette]
}