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

Question

语境

我正在尝试使用scale_fill_perso中的ggplot类的东西创建要调用的自定义色阶。 我按照这篇不错的博客文章中描述的步骤进行操作。 我的离散量表有 7 个级别。

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

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

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

当前实施

步骤遵循上述博客文章。

首先，创建一个颜色向量和调用它的方法：

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()) }
}

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

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 function 以使用该调色板。

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), ...)
  }
}

Output

使用 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")

但是，当使用多个colors较小时，我想使用我的向量的前三个colors（红-绿-蓝），暂时不是这样

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

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

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" 

当数字类别 < 数字 colors 时，如何确保遵循向量顺序？

Answer 1

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

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

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 function 的唯一区别是参数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功能，因此只能用于最大数量为 colors 的离散秤。 它确实允许默认 colors 因此可能适合分析，其中只需快速获取一组具有有限颜色范围的图表。 它还展示了如何同时满足英式和美式颜色拼写的要求。