Use palette functions from khroma

DESCRIPTION

@@ -30,6 +30,7 @@ Imports:
     graphics,
     grDevices,
     isopleuros (>= 1.2.0),
+    khroma (>= 1.13.0),
     methods,
     MASS,
     stats,

NAMESPACE

@@ -17,6 +17,12 @@ S3method(quantile,CompositionMatrix)
 S3method(scale,CompositionMatrix)
 S3method(split,CompositionMatrix)
 S3method(split,LogRatio)
+export(palette_color_continuous)
+export(palette_color_discrete)
+export(palette_color_picker)
+export(palette_line)
+export(palette_shape)
+export(palette_size_range)
 export(remove_NA)
 export(remove_constant)
 export(remove_zero)
@@ -75,6 +81,13 @@ importFrom(arkhe,remove_constant)
 importFrom(arkhe,remove_zero)
 importFrom(arkhe,sparsity)
 importFrom(grDevices,hcl.colors)
+importFrom(isopleuros,ternary_pairs)
+importFrom(khroma,palette_color_continuous)
+importFrom(khroma,palette_color_discrete)
+importFrom(khroma,palette_color_picker)
+importFrom(khroma,palette_line)
+importFrom(khroma,palette_shape)
+importFrom(khroma,palette_size_range)
 importFrom(methods,"as<-")
 importFrom(methods,"slot<-")
 importFrom(methods,.hasSlot)
@@ -108,4 +121,3 @@ importMethodsFrom(arkhe,describe)
 importMethodsFrom(arkhe,replace_NA)
 importMethodsFrom(arkhe,replace_zero)
 importMethodsFrom(dimensio,pca)
-importMethodsFrom(isopleuros,ternary_pairs)

R/AllGenerics.R

@@ -958,6 +958,10 @@ NULL
 #' @param groups A `vector` of grouping elements, as long as the variables in
 #'  `x`. If a single `character` string is passed, it must be the name of a
 #'  categorical variable from the original dataset.
+#' @param palette_color A palette [`function`] that when called with a single
+#'  argument (`groups`) returns a `character` vector of colors.
+#' @param palette_symbol A palette [`function`] that when called with a single
+#'  argument (`groups`) returns a vector of symbols.
 #' @inheritParams isopleuros::ternary_pairs
 #' @return
 #'  `plot()` is called for its side-effects: is results in a graphic being
@@ -980,6 +984,8 @@ NULL
 #'  `x`. If a single `character` string is passed, it must be the name of a
 #'  categorical variable from the original dataset.
 #'  If set, a matrix of panels defined by `groups` will be drawn.
+#' @param palette_color A palette [`function`] that when called with a single
+#'  argument (`groups`) returns a `character` vector of colors.
 #' @param rug A [`logical`] scalar: should a *rug* representation (1-d plot) of
 #'  the data be added to the plot?
 #' @param ticksize A length-one [`numeric`] vector giving the length of the

R/nexus-package.R

@@ -38,7 +38,7 @@
 "_PACKAGE"
 
 #' @import arkhe
-#' @importMethodsFrom isopleuros ternary_pairs
+#' @importFrom isopleuros ternary_pairs
 #' @importFrom grDevices hcl.colors
 #' @importFrom methods as as<- callGeneric callNextMethod
 #'  .hasSlot initialize is new setClass setGeneric setMethod slot slot<-

R/plot.R

@@ -5,13 +5,15 @@ NULL
 # CompositionMatrix ============================================================
 #' @export
 #' @method plot CompositionMatrix
-plot.CompositionMatrix <- function(x, ..., margin = NULL, groups = NULL) {
+plot.CompositionMatrix <- function(x, ..., margin = NULL, groups = NULL,
+                                   palette_color = palette_color_discrete(),
+                                   palette_symbol = palette_shape()) {
   ## Grouping
   groups <- get_variable(x, which = groups)
   if (!is.null(groups) && !all(is.na(groups))) {
     arkhe::assert_length(groups, nrow(x))
-    col <- dimensio::palette_color_discrete(list(...)$col)(groups)
-    pch <- dimensio::palette_shape(list(...)$pch)(groups)
+    col <- palette_color(groups)
+    pch <- palette_symbol(groups)
   } else {
     col <- list(...)$col %||% graphics::par("col")
     pch <- list(...)$pch %||% graphics::par("pch")
@@ -30,6 +32,7 @@ setMethod("plot", c(x = "CompositionMatrix", y = "missing"), plot.CompositionMat
 #' @export
 #' @method plot LogRatio
 plot.LogRatio <- function(x, ..., groups = NULL,
+                          palette_color = palette_color_discrete(),
                           rug = TRUE, ticksize = 0.05,
                           ncol = NULL, flip = FALSE,
                           xlab = NULL, ylab = NULL,
@@ -50,9 +53,11 @@ plot.LogRatio <- function(x, ..., groups = NULL,
   if (is.null(groups) || all(is.na(groups))) {
     grp <- list(all = z)
     groups <- rep("all", m)
+    border <- list(...)$border %||% graphics::par("col")
   } else {
     arkhe::assert_length(groups, m)
     grp <- split(z, f = groups)
+    border <- palette_color(names(grp))
     rug <- FALSE
   }
   k <- length(grp)
@@ -74,8 +79,7 @@ plot.LogRatio <- function(x, ..., groups = NULL,
   col.main <- list(...)$col.main %||% graphics::par("col.main")
 
   lty <- list(...)$lty %||% graphics::par("lty")
-  border <- dimensio::palette_color_discrete(list(...)$border)(names(grp))
-  col <- list(...)$col %||% grDevices::adjustcolor(border, alpha.f = 0.5)
+  col <- grDevices::adjustcolor(border, alpha.f = 0.25)
 
   ## Compute densities
   n_dens <- 512

R/reexport.R

@@ -15,3 +15,29 @@ arkhe::remove_constant
 #' @importFrom arkhe sparsity
 #' @export
 arkhe::sparsity
+
+# REEXPORT FROM KHROMA
+
+#' @importFrom khroma palette_color_continuous
+#' @export
+khroma::palette_color_continuous
+
+#' @importFrom khroma palette_color_discrete
+#' @export
+khroma::palette_color_discrete
+
+#' @importFrom khroma palette_color_picker
+#' @export
+khroma::palette_color_picker
+
+#' @importFrom khroma palette_shape
+#' @export
+khroma::palette_shape
+
+#' @importFrom khroma palette_line
+#' @export
+khroma::palette_line
+
+#' @importFrom khroma palette_size_range
+#' @export
+khroma::palette_size_range

inst/examples/ex-density.R

@@ -1,9 +1,13 @@
 ## Data from Day et al. 2011
 data("kommos", package = "folio") # Coerce to compositional data
 kommos <- remove_NA(kommos, margin = 1) # Remove cases with missing values
-coda <- as_composition(kommos) # Use ceramic types for grouping
+coda <- as_composition(kommos)
 
 ## Log ratio
 clr <- transform_clr(coda)
-plot(clr, groups = NULL, flip = TRUE, border = "black", col = NA)
+
+## Density plot
+plot(clr, groups = NULL, flip = TRUE)
+
+## Use ceramic types for grouping
 plot(clr, groups = "type", flip = TRUE)

inst/examples/ex-plot.R

@@ -1,7 +1,10 @@
 ## Data from Day et al. 2011
 data("kommos", package = "folio") # Coerce to compositional data
 kommos <- remove_NA(kommos, margin = 1) # Remove cases with missing values
-coda <- as_composition(kommos) # Use ceramic types for grouping
+coda <- as_composition(kommos, parts = 3:8)
 
-plot(coda[, 1:6, drop = FALSE], groups = "type")
-plot(coda[, 1:6, drop = FALSE], groups = NULL)
+## Use ceramic types for grouping
+plot(coda, groups = "type")
+
+## Center and scale ternary plots
+plot(coda, groups = NULL, center = TRUE, scale = TRUE)