如何根据条件覆盖 aes 颜色(由变量控制)?

How to override an aes color (controlled by a variable) based on a condition?

我正在尝试根据变量值以不同颜色绘制 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 

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。可以随机生成。

您可以使用 scale_color_manual 使用自定义创建的调色板,其中您的兴趣级别(在您的示例中,测试等于 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

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

请注意,我已将 geom_pointstat_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)

希望我的回答对您有用。