Different colours for values above / below a linea

问题:

I'm using ggplot to plot a time series with a linear regression line. I would like to have different colours for my time series depending on whether it is above or below the trend line.

Here is a code example to plot the series and the corresponding trend line with different colours for the series and the line:

x  <- seq(as.Date("2000/1/1"), as.Date("2010/1/1"), "years")
y  <- rnorm(length(x),0,10)
df <- data.frame(x,y)

ggplot(df, aes(x, y)) + 
  stat_smooth(method = 'lm', aes(colour = 'Trend'), se = FALSE) +
  geom_line(aes(colour = 'Observation') ) +   
  theme_bw() + 
  xlab("x") + 
  ylab("y") + 
  scale_colour_manual(values = c("blue","red"))

Have a nice day!

回答1:

I got rid of the dates, since they were driving me nuts. Perhaps someone can add a solution for that. Otherwise it seems quite doable, with some basic high school maths.

df <- data.frame(x = 2000:2010,
                 y = rnorm(11, 0, 10))
fm <- lm(y ~ x, data = df)
co <- coef(fm)
df$under_over <- sign(fm$residuals)
for (i in 1:(nrow(df) - 1)) {
  # Get slope and intercept for line segment
  slope <- (df$y[i + 1] - df$y[i]) / (df$x[i + 1] - df$x[i])
  int  <- df$y[i] - slope * df$x[i]
  # find where they would cross
  x <- (co[1] - int) / (slope - co[2])
  y <- slope * x + int
  # if that is in the range of the segment it is a crossing, add to the data
  if (x > df$x[i] & x < df$x[i + 1])
    df <- rbind(df, c(x = x, y = y, under_over = NA))
}
#order by x
df <- df[order(df$x), ]
# find color for intersections
for (i in 1:nrow(df))
  if (is.na(df$under_over[i]))
    df$under_over[i] <- df$under_over[i + 1]

ggplot(df) +
  geom_abline(intercept = co[1], slope = co[2]) +
  geom_path(aes(x, y, col = as.factor(under_over), group = 1)) +
  theme_bw()