我想通过使用函数将所有geom_*类型对象的默认颜色更改为特定的调色板。

以下是geom_line()并使用功能change_colours()的示例

# load ggplot2 and tidyr library
require(ggplot2)
require(tidyr)

# create a mock data frame
df <- data.frame(cbind(var1=500*cumprod(1+rnorm(300, 0, 0.04)),
                       var2=400*cumprod(1+rnorm(300, 0, 0.04)),
                       var3=300*cumprod(1+rnorm(300, 0, 0.04))))
df$TS <- as.POSIXct(Sys.time()+seq(300))
df <- gather(df, stock, price, -TS)

# create basic base graph
p <- ggplot(df, aes(x=TS, y=price, group=stock))+geom_line(aes(colour=stock))

# custom pallet
custom_pal <- c("#002776", "#81BC00", "#00A1DE", "#72C7E7", "#3C8A2E", "#BDD203",
                "#313131", "#335291", "#9AC933", "#33B4E5", "#8ED2EC", "#63A158",
                "#CADB35", "#575757", "#4C689F", "#A7D04C", "#4CBDE8", "#9DD8EE",
                "#76AD6D", "#D1DF4F", "#8C8C8C", "#7F93BA", "#C0DE80", "#80D0EE",
                "#B8E3F3", "#9DC496", "#DEE881", "#B4B4B4", "#99A9C8", "#CDE499",
                "#99D9F2", "#C7E9F5", "#B1D0AB", "#E5ED9A", "#DCDCDC")

# the function the change colours
change_colours <- function(ggplot_obj, pal){
  p <- ggplot_obj
  group_data <- p$data[, as.character(p$mapping$group)]
  n_groups <- length(unique(group_data))
  group_data_cols <- pal[group_data]

  p + theme_light()+ geom_line(colour=group_data_cols)
}

p
p1 <- change_colours(ggplot_obj=p, pal=custom_pal)
p1


我希望将change_colours()函数更改为对所有geom_*类型层更通用

任何帮助将非常感激。

最佳答案

以下应该执行的操作。请注意,它仅更改映射到变量的颜色。直接传递给geom_*的颜色不会受到影响(下面有一个示例)。有关修改colourfill(以先映射为准)的方法,请参见本文的下半部分。

change_colours <- function(p, palette) {
  n <- nlevels(p$data[[deparse(p$mapping$group)]])
  tryCatch(as.character(palette),
           error=function(e) stop('palette should be a vector of colours', call.=FALSE))
  if(n > length(palette)) stop('Not enough colours in palette.')
  pal <- function(n) palette[seq_len(n)]
  p + theme_light() + discrete_scale('colour', 'foo', pal)
}

# Here, df is from the OP's post
p <- ggplot(df, aes(x=TS, y=price, group=stock))


例子:

# NB: custom_pal is defined in the OP's post
change_colours(p + geom_line(aes(colour=stock)), custom_pal)


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

change_colours(p + geom_point(aes(colour=stock)), custom_pal)


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

并使用不同的调色板:

change_colours(p + geom_smooth(aes(colour=stock)),
               c('firebrick', 'midnightblue', 'violet', 'seagreen'))


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

如上所述,这只会更改映射到变量的colourfill。例如,它不会影响以下颜色:

change_colours(p + geom_point(colour=rep(c('tomato', 'hotpink', 'cadetblue'), each=300)),
               custom_pal)


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP



响应OP的comment,您可以轻松地检测到正在使用的映射类型(例如alphacolourfill)。只需查看p$layers[[1]]$mapping

如果我们假设第一层的第一个fillcolour映射是您要更改颜色的映射,则可以执行以下操作:

change_colours <- function(p, palette, type) {
  n <- nlevels(p$data[[deparse(p$mapping$group)]])
  tryCatch(as.character(palette),
           error=function(e) stop('palette should be a vector of colours', call.=FALSE))
  if(n > length(palette)) stop('Not enough colours in palette.')
  if(missing(type))
    type <- grep('colour|fill', names(p$layers[[1]]$mapping), value=TRUE)[1]
  pal <- function(n) palette[seq_len(n)]
  p + theme_light() + discrete_scale(type, 'foo', pal)
}

# Here, df is from the OP's post
p <- ggplot(df, aes(x=TS, y=price, group=stock))


例子:

更改填充而不是颜色:

change_colours(p + geom_point(aes(fill=stock), pch=21),
               c('white', 'grey50', 'grey80'))


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

显示第一个映射的颜色/填充美学的优先级:

change_colours(p + geom_point(aes(fill=stock, color=stock), pch=21) +
                 geom_smooth(aes(color=stock)),
               c('black', 'grey50', 'grey80'))


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

change_colours(p + geom_point(aes(color=stock, fill=stock), pch=21) +
                 geom_smooth(aes(color=stock)),
               c('black', 'grey50', 'grey80'))


r - 将颜色更改为ggplot对象的已定义调色板-LMLPHP

使用type参数覆盖第一个映射美学的优先级,例如:

change_colours(p + geom_point(aes(color=stock, fill=stock), pch=21) +
                 geom_smooth(aes(color=stock)),
               c('black', 'grey50', 'grey80'), type='fill')

08-18 20:21