added ax_colors_manual()

NAMESPACE

@@ -19,6 +19,7 @@ export(apexchartProxy)
 export(ax_annotations)
 export(ax_chart)
 export(ax_colors)
+export(ax_colors_manual)
 export(ax_dataLabels)
 export(ax_fill)
 export(ax_grid)
@@ -77,6 +78,7 @@ importFrom(magrittr,"%>%")
 importFrom(rlang,"!!")
 importFrom(rlang,as_label)
 importFrom(rlang,eval_tidy)
+importFrom(rlang,is_named)
 importFrom(rlang,sym)
 importFrom(shiny,getDefaultReactiveDomain)
 importFrom(shiny,registerInputHandler)

R/colors.R

@@ -0,0 +1,44 @@
+
+#' Set specific color's series
+#'
+#' @param ax A \code{apexcharts} \code{htmlwidget} object. 
+#' @param values Named list, names represent data series, values colors to use.
+#'
+#' @return A \code{apexcharts} \code{htmlwidget} object.
+#' @export
+#'
+#' @example examples/colors.R
+ax_colors_manual <- function(ax, values) {
+  groups <- get_groups(ax)
+  values <- validate_values(values, groups)
+  ax_colors(ax = ax, values$val)
+}
+
+#' @importFrom rlang is_named
+validate_values <- function(values, groups) {
+  if (!rlang::is_named(values))
+    stop("values must be a named list or vector")
+  nm <- names(values)
+  val <- unname(unlist(values))
+  nm_check <- setdiff(groups, nm)
+  if (length(nm_check) > 0) {
+    warning("Some groups doesn't have a corresponding color value")
+  }
+  list(
+    nm = intersect(groups, nm), 
+    val = val[match(x = groups, table = nm, nomatch = 0L)]
+  )
+}
+
+get_groups <- function(ax) {
+  if (!inherits(ax, "apexcharter"))
+    stop("ax must be an apexcharter htmlwidget")
+  if (is.null(ax$x$ax_opts$series))
+    stop("ax must have a series of data")
+  groups <- lapply(ax$x$ax_opts$series, `[[`, "name")
+  groups <- unlist(groups)
+  as.character(groups)
+}
+
+
+

examples/colors.R

@@ -0,0 +1,56 @@
+## scatter
+
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) %>% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "6" = "firebrick",
+    "8" = "forestgreen"
+  ))
+
+# If missing level, colors are recycled
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) %>% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "8" = "forestgreen"
+  ))
+
+# Ignore levels not present in data
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) %>% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "6" = "firebrick",
+    "8" = "forestgreen",
+    "99" = "yellow"
+  ))
+
+
+
+## Bar
+
+tab <- table(sample(letters[1:5], 100, TRUE), sample(LETTERS[1:5], 100, TRUE))
+dat <- as.data.frame(tab)
+
+apex(
+  data = dat,
+  type = "column",
+  mapping = aes(x = Var1, y = Freq, group = Var2)
+) %>% 
+  ax_colors_manual(list(
+    A = "steelblue",
+    C = "firebrick",
+    D = "forestgreen",
+    B = "peachpuff",
+    E = "chartreuse"
+  ))

man/ax_colors_manual.Rd

@@ -0,0 +1,77 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/colors.R
+\name{ax_colors_manual}
+\alias{ax_colors_manual}
+\title{Set specific color's series}
+\usage{
+ax_colors_manual(ax, values)
+}
+\arguments{
+\item{ax}{A \code{apexcharts} \code{htmlwidget} object.}
+
+\item{values}{Named list, names represent data series, values colors to use.}
+}
+\value{
+A \code{apexcharts} \code{htmlwidget} object.
+}
+\description{
+Set specific color's series
+}
+\examples{
+## scatter
+
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) \%>\% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "6" = "firebrick",
+    "8" = "forestgreen"
+  ))
+
+# If missing level, colors are recycled
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) \%>\% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "8" = "forestgreen"
+  ))
+
+# Ignore levels not present in data
+apex(
+  data = mtcars, 
+  type = "scatter",
+  mapping = aes(x = wt, y = mpg, fill = cyl)
+) \%>\% 
+  ax_colors_manual(list(
+    "4" = "steelblue",
+    "6" = "firebrick",
+    "8" = "forestgreen",
+    "99" = "yellow"
+  ))
+
+
+
+## Bar
+
+tab <- table(sample(letters[1:5], 100, TRUE), sample(LETTERS[1:5], 100, TRUE))
+dat <- as.data.frame(tab)
+
+apex(
+  data = dat,
+  type = "column",
+  mapping = aes(x = Var1, y = Freq, group = Var2)
+) \%>\% 
+  ax_colors_manual(list(
+    A = "steelblue",
+    C = "firebrick",
+    D = "forestgreen",
+    B = "peachpuff",
+    E = "chartreuse"
+  ))
+}