如果r中的值小于0或大于0，如何根据条件为geom_line（）和geom_point（）正确着色？

ViSa 发表于 Dev

签证

从tidytuesday数据集我想创建一个线图的颜色在蓝色如果大于0和红若小于0。

library(tidyverse)
library(tidytuesdayR)
library(ggthemes)
library(glue)
library(scales)

加载数据中

tt <- tt_load("2021-02-23")
employed <- tt$employed

阴谋

employed %>% 
  na.omit() %>% 
  group_by(year) %>% 
  summarise(employment_yrwise = sum(employ_n)) %>% 
  mutate(employ_change = (employment_yrwise - lag(employment_yrwise, default = 0))/
           lag(employment_yrwise) ) %>% 

  mutate(employ_change = replace(employ_change, is.na(employ_change), 0),
         line_color = ifelse(employ_change >= 0, "blue","red")) %>% 
  
  ggplot(aes(x = year, y = employ_change, 
             label = round(employ_change*100, digits = 2),
         col = line_color)) +
  geom_line(group=1) +
  geom_point() +
  scale_y_continuous(labels = scales::percent_format(),
                     limits = c(-0.08, 0.02) ) +
  geom_text(nudge_y = .005) +
  labs(title = "Yearly % Change in Employment")

我不确定为什么我会被上面的代码弄到图表下方，当颜色低于0时，它的颜色似乎是相反的，而线条却不能正确地上色：

也尝试了下面的代码，但是也没有用：

employed %>% 
  na.omit() %>% 
  group_by(year) %>% 
  summarise(employment_yrwise = sum(employ_n)) %>% 
  mutate(employ_change = (employment_yrwise - lag(employment_yrwise, default = 0))/
           lag(employment_yrwise) ) %>% 
  mutate(employ_change = replace(employ_change, is.na(employ_change), 0) #,
         #line_color = ifelse(employ_change >= 0, "blue","red")
         ) %>% 
  
  ggplot(aes(x = year, y = employ_change, 
             label = round(employ_change*100, digits = 2)
             # ,col = line_color
             )) +
  geom_line(group=1) +
  geom_point() +
  scale_y_continuous(labels = scales::percent_format(),
                     limits = c(-0.08, 0.02) ) +
  scale_color_manual(values = c("blue","red")) +
  geom_text(nudge_y = .005) +
  labs(title = "Yearly % Change in Employment")

特朗布兰德

至于根据线条是否在某点之上/之下而给它们提供不同的颜色，则您需要在交叉点处对这些线进行插值以分配不同的颜色，因为线段本身不能具有多种颜色。这是用于内插此类线条的自-窃解决方案。

首先，我们将编写两个函数。一个用于查找交叉点并整形数据，另一个用于在交叉点进行插值。

library(ggplot2)

divide_line <- function(x, y, at = 0) {
  df <- data.frame(x, ymin = at, ymax = y)
  df$sign <- sign(df$ymax - df$ymin)
  df <- df[order(df$x), ]
  df$id <- with(rle(df$sign), rep.int(seq_along(values), lengths))
  
  crossover <- which(c(FALSE, diff(df$id) == 1))
  crossover <- sort(c(crossover, crossover - 1))
  splitter  <- rep(seq_len(length(crossover) / 2), each = 2)
  crossover <- lapply(split(df[crossover, ], splitter), find_isect)
  
  df <- do.call(rbind, c(list(df), crossover))
  df[order(df$x),]
}

find_isect <- function(df) {
  list2env(df, envir = rlang::current_env())
  dx <- x[1] - x[2]
  dy <- ymin[1] - ymin[2]
  t <- (-1 * (ymin[1] - ymax[1]) * dx) / (dx * (ymax[1] - ymax[2]) - dy * dx)
  df$x <- x[1] + t * -dx
  df$ymin <- df$ymax <- ymin[1] + t * -dy
  return(df)
}

然后，我们可以执行以下操作：

df <- data.frame(
  x = 1:100,
  y = rnorm(100)
)

df <- divide_line(df$x, df$y, at = 0)

ggplot(df, aes(x, ymax, group = id, colour = as.factor(sign))) +
  geom_line()