创建具有不同间隔宽度且图例级别之间没有间隔的离散颜色条 [英] Create discrete color bar with varying interval widths and no spacing between legend levels

问题描述

我想在 ggplot2 中重现此色标：

（。

  library（ggplot2）
 #importFrom RColorBrewer brewer.pal 
 
 mybreaks<-c（ 0,1,2,5,10）
 
 new_breaks<-seq（mybreaks [1]，mybreaks [length（mybreaks）]，sect_x（mybreaks））
 my_lims<- c（mybreaks [1]，mybreaks [length（mybreaks）]）
 rep_times<-（diff（mybreaks）[！is.na（diff（mybreaks））]）/ sect_x（mybreaks）
 mycols<-rep（RColorBrewer :: brewer.pal（length（mybreaks）-1， Reds），rep_times）
 
 ggplot（iris，aes（Sepal.Length，y = Sepal。宽度，填充= Petal.Length））+ 
 geom_point（形状= 21）+ 
 scale_fill_discrete_gradient（极限= my_lims，
 breaks = mybreaks，color = mycols，bins = length（mycols）， 
 guide = guide_colourbar（frame.colour = black，
 ticks.colour =&  black，＃您也可以使用NA 
 barwidth = 20）
）+ 
 theme（legend.position = bottom）
  

选项2的功能

  ##来自Claus Wilke 
离散_梯度_pal<-函数（ colours，bins = 5）{
 ramp<-scales :: colour_ramp（colours）
 
 function（x）{
 if（length（x）== 0）return （character（））
 
i<-floor（x * bins）
i<-ifelse（i> bins-1，bins-1，i）
 ramp（i /（bins-1））
} 
} 
 ##修改为填充来自克劳斯威尔克（Claus Wilke）的
 scale_fill_discrete_gradient<-
函数（...，colours，bins = 5，
 na.value = grey50，
 guide = colourbar; ，
美学=填充，颜色）{
颜色<-如果（缺失（颜色））
颜色
其他颜色
 Continuous_scale（
美学，
离散梯度，
discrete_pal_pal（颜色，容器），
 na.value = na.value，
 guide = guide，
 ... 
）
} 
 
 ## https://stackoverflow.com/a/5173906/7941188 
小数位数<-函数（x）{
 if（（x %% 1）！= 0）{
 nchar（strsplit（sub（'0 + $'，''，as.character（x）），。，fixed = TRUE） [[1]] [[2]]）
}否则{
 return（0）
} 
} 
 
 ##其中每个元素都可以被整数整除
＃importFrom数字除数
 sect_x<-function（x） {
 diff_x<-diff（x）[！is.na（diff（x））] 
 diff_x<-round（diff_x，2）
 max_dec<-max（sapply （diff_x，小数位））
 ## https://math.stackexchange.com/a/3732661/662220 
 m_int<-10 ^（-1 * max_dec）
 x_div< -as.integer（round（diff_x / m_int，0））
 x_div<-x_div [x_div！= 0] 
 max_divisor<-max（Reduce（intersect，lapply（x_div，数字::除数）））
 fac_div<-m_int * max_divisor 
 fac_div 
} 
 
  

I'd like to reproduce this color scale in ggplot2: (Source)

In the past I have found that creating discrete color scales with labels in-between in ggplot2 can be tricky.

Can this be accomplished at all? A similar, but not completely identical question I have recently posed is this one.

解决方案

I think the following answer is sufficiently different to merit a second answer. ggplot2 has massively changed in the last 2 years (!), and there are now new functions such as scale_..._binned, and specific gradient creating functions such as scale_..._fermenter

This has made the creation of a discrete gradient bar fairly straight forward.

For a "full separator" instead of ticks, see user teunbrands post.

library(ggplot2)

ggplot(iris, aes(Sepal.Length, y = Sepal.Width, fill = Petal.Length))+
  geom_point(shape = 21) +
  scale_fill_fermenter(breaks = c(1:3,5,7), palette = "Reds") + 
  guides(fill = guide_colorbar(
    ticks = TRUE, 
    even.steps = FALSE,
    frame.linewidth = 0.55, 
    frame.colour = "black", 
    ticks.colour = "black",
    ticks.linewidth = 0.3)) +
  theme(legend.position = "bottom")

Another option, which I have posted earlier today, and which I will leave for posterity, would be to create manual breaks and to calculate how often the colors need to be repeated, which involves a fair bit of algebra. It also used modified functions from Claus Wilke.

library(ggplot2)
#importFrom RColorBrewer brewer.pal

mybreaks <- c(0,1,2,5,10) 

new_breaks <- seq(mybreaks[1], mybreaks[length(mybreaks)], sect_x(mybreaks))
my_lims <- c(mybreaks[1], mybreaks[length(mybreaks)])
rep_times <- (diff(mybreaks)[!is.na(diff(mybreaks))])/sect_x(mybreaks)
mycols <- rep(RColorBrewer::brewer.pal(length(mybreaks)-1, "Reds"), rep_times) 

ggplot(iris, aes(Sepal.Length, y = Sepal.Width, fill = Petal.Length))+
  geom_point(shape = 21) +
  scale_fill_discrete_gradient(limits = my_lims,
    breaks = mybreaks, colors = mycols, bins = length(mycols),
    guide = guide_colourbar(frame.colour = "black", 
                            ticks.colour = "black", # you can also remove the ticks with NA
                            barwidth=20)
  ) +
  theme(legend.position = "bottom")

Functions for option 2

## from Claus Wilke
discrete_gradient_pal <- function(colours, bins = 5) {
  ramp <- scales::colour_ramp(colours)
  
  function(x) {
    if (length(x) == 0) return(character())
    
    i <- floor(x * bins)
    i <- ifelse(i > bins-1, bins-1, i)
    ramp(i/(bins-1))
  }
}
## modified to "fill" from Claus Wilke
scale_fill_discrete_gradient <- 
  function(..., colours, bins = 5, 
           na.value = "grey50", 
           guide = "colourbar", 
           aesthetics = "fill", colors)  {
    colours <- if (missing(colours)) 
      colors
    else colours
    continuous_scale(
      aesthetics,
      "discrete_gradient",
      discrete_gradient_pal(colours, bins),
      na.value = na.value,
      guide = guide,
      ...
    )
  } 

## https://stackoverflow.com/a/5173906/7941188
decimalplaces <- function(x) {
    if ((x %% 1) != 0) {
      nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed=TRUE)[[1]][[2]])
    } else {
      return(0)
    }
  }

## find the number by which each element is divisible as an integer
# importFrom numbers divisors
sect_x <- function(x){
  diff_x <- diff(x)[!is.na(diff(x))]
  diff_x <- round(diff_x, 2)
  max_dec <-  max(sapply(diff_x, decimalplaces))
  ## https://math.stackexchange.com/a/3732661/662220
  m_int <- 10^(-1*max_dec)
  x_div <- as.integer(round(diff_x / m_int, 0))
  x_div <- x_div[x_div != 0]
  max_divisor <- max(Reduce(intersect, lapply(x_div, numbers::divisors)))
  fac_div <- m_int * max_divisor
  fac_div
}

这篇关于创建具有不同间隔宽度且图例级别之间没有间隔的离散颜色条的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！