如何根据条件覆盖 aes 颜色（由变量控制）？

Question

我正在尝试根据变量的值以不同颜色绘制 r 中的多个非线性最小二乘回归。 但是，我也显示了最后一个方程，我希望方程对应的非线性回归中的颜色也为黑色。

我尝试过的内容显示在 geom_smooth() 层中 - 我尝试包含 ifelse() 语句，但这不起作用，因为这里描述的原因：Different between colour argument and aes colour in ggplot2?

test <- function() {
  require(ggplot2)
  set.seed(1);

  master <- data.frame(matrix(NA_real_, nrow = 0, ncol = 3))

for( i in 1:5 ) {
   df <- data.frame(matrix(NA_real_, nrow = 50, ncol = 3))
   colnames(df) <- c("xdata", "ydata", "test")

   df$xdata = as.numeric(sample(1:100, size = nrow(df), replace = FALSE))
   df$ydata = as.numeric(sample(1:3, size = nrow(df), prob=c(.60, .25, .15), replace = TRUE))
   # browser()
   df$test = i

   master <- rbind(master, df)
 }

df <- master

last <- 5

# based on https://stackoverflow.com/questions/18305852/power-regression-in-r-similar-to-excel

power_eqn = function(df, start = list(a=300,b=1)) {
    m = nls(as.numeric(reorder(xdata,-ydata)) ~ a*ydata^b, start = start, data = df)
    # View(summary(m))
    # browser()
    # eq <- substitute(italic(hat(y)) == a  ~italic(x)^b*","~~italic(r)^2~"="~r2*","~~p~"="~italic(pvalue),
    eq <- substitute(italic(y) == a  ~italic(x)^b*","~~italic('se')~"="~se*","~~italic(p)~"="~pvalue,
                 list(a = format(coef(m)[1], digits = 6), # a
                      b = format(coef(m)[2], digits = 6), # b
                      # r2 = format(summary(m)$r.squared, digits = 3), 
                      se = format(summary(m)$parameters[2,'Std. Error'], digits = 6), # standard error
                      pvalue = format(summary(m)$coefficients[2,'Pr(>|t|)'], digits=6) )) # p value (based on t statistic)
   as.character(as.expression(eq))                 
 }

plot1 <- ggplot(df, aes(x = as.numeric(reorder(xdata,-ydata)), y = ydata ) ) + 
    geom_point(color="black", shape=1 ) + 
    # PROBLEM LINE
    stat_smooth(aes(color=ifelse(test==5, "black", test)), method = 'nls', formula = 'y~a*x^b', method.args = list(start= c(a =1,b=1)),se=FALSE, fullrange=TRUE) +
    geom_text(x = quantile(df$xdata)[4], y = max(df$ydata), label = power_eqn(df), parse = TRUE, size=4, color="black") + # make bigger? add border around?
    theme(legend.position = "none", axis.ticks.x = element_blank() ) + #, axis.title.x = "family number", axis.title.y = "number of languages" ) # axis.text.x = element_blank(), 
    labs( x = "xdata", y = "ydata", title="test" )
plot1
}

test()

这是我得到的图表。

我希望对应于点和方程的线也是黑色的。有谁知道如何做到这一点？

我不想使用 scale_fill_manual 等，因为我的真实数据会有很多很多行 - 除非 scale_fill_manual/etc.可以随机生成。

Answer 1

您可以使用 scale_color_manual 使用自定义创建的调色板，其中您的兴趣级别（在您的示例中 test 等于 5）设置为黑色。下面我使用来自 RColorBrewer 的调色板，如有必要，将它们扩展到所需的级别数并将最后一种颜色设置为黑色。

library(RColorBrewer) # provides several great palettes

createPalette <- function(n, colors = 'Greens') {
  max_colors <- brewer.pal.info[colors, ]$maxcolors # Get maximum colors in palette
  palette <- brewer.pal(min(max_colors, n), colors) # Get RColorBrewer palette
  if (n > max_colors) {
    palette <- colorRampPalette(palette)(n) # make it longer i n > max_colros
  }

  # assume that  n-th color should be black
  palette[n] <- "#000000"

  # return palette
  palette[1:n]
}

# create a palette with 5 levels using the Spectral palette
# change from 5 to the needed number of levels in your real data.
mypalette <- createPalette(5, 'Spectral') #  palettes from RColorBrewer

然后我们可以使用mypalette 和scale_color_manual(values=mypalette) 根据test 变量对点和线进行着色。

请注意，我已将geom_point 和stat_smooth 更新为使用aes(color=as.factor(test))。我还将对power_eqn 的调用更改为仅使用df$test==5 所在的数据点。黑点、线条和方程现在应该基于相同的数据。

plot1 <- ggplot(df, aes(x = as.numeric(reorder(xdata,-ydata)), y = ydata )) + 
  geom_point(aes(color=as.factor(test)), shape=1) + 
  stat_smooth(aes(color=as.factor(test)), method = 'nls', formula = 'y~a*x^b', method.args = list(start= c(a =1,b=1)),se=FALSE, fullrange=TRUE) +
  geom_text(x = quantile(df$xdata)[4], y = max(df$ydata), label = power_eqn(df[df$test == 5,]), parse = TRUE, size=4, color="black") +
  theme(legend.position = "none", axis.ticks.x = element_blank() ) + 
  labs( x = "xdata", y = "ydata", title="test" ) +
  scale_color_manual(values = mypalette)

plot1

See resulting figure here (not reputation enough to include them)

希望我的回答对你有用。