ggplot中的自定义离散色标不尊重顺序

Question

上下文

我正在尝试创建一个自定义色标，以便在ggplot 中使用scale_fill_perso 之类的名称来调用。我按照这个不错的blog post 中描述的步骤进行操作。我的离散量表有 7 个级别。

我设法正确设置了比例（见下文）。当使用具有 7 个级别的图表时，我有预期的颜色。但是，当我不使用尽可能多的颜色时，我希望R 尊重我的调色板的顺序，而不是在值之间进行插值（参见示例）。例如，如果我有 3 种颜色，我希望 R 使用我的颜色向量的前三个值。

我认为这来自my_pal，它本身使用grDevices::colorRampPalette，当使用小于颜色向量大小的多个类时，会使用极值而不是顺序来切割颜色向量。

所以我的问题是：有没有办法捕捉类的数量，如果number classes < length(color vector) 不使用colorRampPalette 插值？

当前实现

步骤遵循上述blog post。

首先，创建一个颜色向量及其调用方式：

mycolors <- c(
`red` = "#E2447A",
`green` = "#BCE550",
`blue` = "#708DD3", 
`grey` = "#666666",
`orange` = "#FFBAA8",
`violet` = "#D1A3FF",
`lightgrey` = "#B2B2B2"
)

my_cols <- function(...) {

  cols <- c(...)

  if (is.null(cols))
    return (mycolors)

  mycolors[cols]
}

call_palettes <- function(palette = "main"){
  if (palette == "main"){ return(my_cols()) }
}

目前只有一个调色板，但这可能会改变。然后创建插入值的调色板函数（据我所知）：

my_pal <- function(palette = "main", reverse = FALSE, ...) {

  args <- list(...)
  #return(args)

  pal <- call_palettes(palette, ...)

  if (reverse) pal <- rev(pal)

  grDevices::colorRampPalette(pal, ...)
}

然后创建scale_fill_perso 函数以使用该调色板。

scale_fill_perso <- function(palette = "main", discrete = TRUE, reverse = FALSE, ...) {
  pal <- my_pal(palette = palette, reverse = reverse)

  if (discrete) {
    ggplot2::discrete_scale("fill", paste0("my_pal_", palette), palette = pal, ...)
  } else {
    ggplot2::scale_fill_gradientn(colours = pal(256), ...)
  }
}

输出

使用7个类，没问题：

iris$random <- sample(1:7, nrow(iris), replace = TRUE)

ggplot2::ggplot(iris) +
  ggplot2::geom_histogram(ggplot2::aes(x = Sepal.Width, y = ..density..,
                                       fill = factor(random))) +
  scale_fill_perso(palette = "main")

但是，当使用更小的颜色数量时，我想使用矢量的前三种颜色（红-绿-蓝），目前不是这样

ggplot2::ggplot(iris) +
  ggplot2::geom_histogram(ggplot2::aes(x = Sepal.Width, y = ..density..,
                                       fill = factor(Species))) +
  scale_fill_perso(palette = "main")

我发现这是因为my_pal 没有将向量的顺序视为信息。例如，对于 2 种颜色，它取向量的两个极值：

my_pal()(2)
# "#E2447A" "#B2B2B2"
mycolors 
#      red     green      blue      grey    orange    violet lightgrey 
# "#E2447A" "#BCE550" "#708DD3" "#666666" "#FFBAA8" "#D1A3FF" "#B2B2B2" 

对于三个，它添加中间值：

my_pal()(3)
# "#E2447A" "#666666" "#B2B2B2"
mycolors 
#      red     green      blue      grey    orange    violet lightgrey 
# "#E2447A" "#BCE550" "#708DD3" "#666666" "#FFBAA8" "#D1A3FF" "#B2B2B2" 

当数字类别

Answer 1

经过一番挖掘，我通过稍微修改colorRamp和colorRampPalette函数找到了解决方案。

这个想法是捕获colorRampPalette 中的类数量，并将其用作colorRamp 函数中对颜色向量进行切片的参数：

colorRamp_d <- function (colors, n,
                         bias = 1,
                         space = c("rgb", "Lab"),
                         interpolate = c("linear",
                                         "spline"),
                         alpha = FALSE){

  # PRELIMINARY STEPS ----------------
  if (bias <= 0)
    stop("'bias' must be positive")
  if (!missing(space) && alpha)
    stop("'alpha' must be false if 'space' is specified")
  colors <- t(col2rgb(colors, alpha = alpha)/255)
  space <- match.arg(space)
  interpolate <- match.arg(interpolate)

  # CUT THE COLOR VECTOR ----------------------

  if (space == "Lab")
    colors <- convertColor(colors, from = "sRGB", to = "Lab")
  interpolate <- switch(interpolate, linear = stats::approxfun,
                        spline = stats::splinefun)

  # RESPECT ORDER IF NCLASSES<NCOLORS
  if (n<nrow(colors)) colors <- colors[1:n,]

  if ((nc <- nrow(colors)) == 1L) {
    colors <- colors[c(1L, 1L), ]
    nc <- 2L
  }
  x <- seq.int(0, 1, length.out = nc)^bias
  palette <- c(interpolate(x, colors[, 1L]), interpolate(x,
                                                         colors[, 2L]), interpolate(x, colors[, 3L]), if (alpha) interpolate(x,
                                                                                                                             colors[, 4L]))
  roundcolor <- function(rgb) pmax(pmin(rgb, 1), 0)
  if (space == "Lab")
    function(x) roundcolor(convertColor(cbind(palette[[1L]](x),
                                              palette[[2L]](x), palette[[3L]](x), if (alpha)
                                                palette[[4L]](x)), from = "Lab", to = "sRGB")) *
    255
  else function(x) roundcolor(cbind(palette[[1L]](x), palette[[2L]](x),
                                    palette[[3L]](x), if (alpha)
                                      palette[[4L]](x))) * 255
}


colorRampPalette_d <- function (colors, ...){
  # n: number of classes
  function(n) {
    ramp <- colorRamp_d(colors, n, ...)
    x <- ramp(seq.int(0, 1, length.out = n))
    if (ncol(x) == 4L)
      rgb(x[, 1L], x[, 2L], x[, 3L], x[, 4L], maxColorValue = 255)
    else rgb(x[, 1L], x[, 2L], x[, 3L], maxColorValue = 255)
  }
}

与grDevices::colorRamp 函数的唯一区别是参数n（类数）和这一行引入的切片：

if (n<nrow(colors)) colors <- colors[1:n,]

最后，我没有调用Grdevices::colorRampPalette，而是调用了我的自定义colorRampPalette_d：

my_pal <- function(palette = "main", reverse = FALSE, ...) {

  args <- list(...)
  #return(args)

  pal <- call_palettes(palette, ...)

  if (reverse) pal <- rev(pal)

  colorRampPalette_d(pal, ...)
}

产量：

ggplot2::ggplot(iris) +
  ggplot2::geom_histogram(ggplot2::aes(x = Sepal.Width, y = ..density..,
                                       fill = factor(Species))) +
  scale_fill_perso(palette = "main")

Answer 2

linog 对问题的回答解决了我的问题。我无法评论答案，但对于其他使用它的人，请注意您必须修改两个函数，colorRamp 和 colorRampPalette，在后者中，对 colorRamp 的调用从它之前的子函数中移动，变成ramp <- colorRamp_d(colors, n, ...)。

可以在此处找到另一种自定义色标的方法 https://www.garrickadenbuie.com/blog/custom-discrete-color-scales-for-ggplot2/，但这采用了另一种方法并且不使用 colorRamp 功能，因此只能用于具有最大颜色数的离散色标。它确实允许使用默认颜色，因此可能适合仅获取一组具有有限颜色范围的快速图表的分析。它还展示了如何适应英式和美式颜色拼写。