4
votes

Remplissez la zone entre les lignes à l'aide de ggplot dans R

Objectif

J'essaie de remplir la zone entre deux lignes dans un tracé généré avec ggplot dans R. Je voudrais remplir tout ce qui se trouve entre les lignes au-dessus de la ligne horizontale avec un autre couleur que sous la ligne horizontale.

J'ai réussi à tout remplir entre les deux lignes avec une seule couleur, cependant, je n'ai pas réussi à différencier au-dessus et en dessous de la ligne verticale par deux couleurs différentes.

set.seed(123) 

# Load packages
library(tidyverse)

# Create sample dataframe
df <- data.frame(x=seq(1,50,1),y=runif(50, min = 0, max = 10))

# Generate plot
ggplot(data = df, aes(x = x, y = y)) +
  geom_line() +
  geom_hline(yintercept = 5) +
  theme_classic() +
  geom_ribbon(aes(ymin=5,ymax=y), fill="blue")

Comment puis-je remplir le espace au-dessus et au-dessous de la ligne verticale avec une couleur différente?

r ggplot2

1 commentaires

Vouliez-vous dire une ligne horizontale peut-être?

3 Réponses :

1
votes

remplissez trois couches dans l'ordre, pour un résultat particulièrement laid:

# Generate plot
ggplot(data = df, aes(x = x, y = y)) +
  geom_line() +
  geom_hline(yintercept = 5) +
  theme_classic() +
  geom_ribbon(aes(ymin=y,ymax=10), fill="green")+
  geom_ribbon(aes(ymin=0,ymax=y), fill="yellow")+
  geom_ribbon(aes(ymin=5,ymax=y), fill="blue")

1 commentaires

Merci pour la contribution! Cependant, j'essaie de colorer entre les lignes et non «en dehors» des lignes.

2
votes

Créez un nouveau jouet var z . Il prend la valeur 5 si y> 5 sinon est égal à y.

library(ggplot2)
library(dplyr)
df <- data.frame(x=seq(1,50,1),y=runif(50, min = 0, max = 10))

Ensuite, ajoutez une deuxième couche de geom_ribbon () en utilisant plutôt z .

Générer un tracé:

ggplot(data = df, aes(x = x, y = y)) +
  geom_line() +
  geom_ribbon(aes(ymin=5,ymax=y), fill="red", color="red")+
  geom_ribbon(aes(ymin=5, ymax=z), fill="blue", color="blue") +
  geom_hline(yintercept = 5) + # move this under geom_ribbon for a nicer result
  theme_minimal()

Ce n'est cependant pas parfait comme Z.Lin l'a remarqué, car la partie bleue s'étend sur la ligne. Je ne pense pas que ce problème puisse être résolu.

Données:

df <- df %>% 
  mutate(z = ifelse(y>5, y, 5))

4 commentaires

@ Z.Lin Cela peut être résolu en déplaçant le geom_hline () sous les deux geom_ribbon () . Votre réponse est meilleure imo et mérite d'être acceptée (+1)

Merci, mais ce n'est pas ce que je voulais dire. Vous voudrez peut-être mettre la couche geom_line au premier plan pour vérifier? Faites-le blanc ou quelque chose pour un contraste plus clair.

Belle prise! Je confirme que le ruban dépasse les lignes, je vais essayer de comprendre pourquoi c'est, des idées? Je vous remercie.

Wow maintenant que vous faites remarquer que c'est vraiment moche, je suis désolé de ne pas l'avoir remarqué auparavant.

5
votes

Vous pouvez calculer les coordonnées des points d'intersection des deux lignes et les ajouter à votre bloc de données:

p1 <- ggplot(df,
             aes(x = x, y = y)) +
  geom_ribbon(aes(ymin=5, ymax=y), fill="dodgerblue") +
  geom_line() +
  geom_hline(yintercept = m) +
  geom_point() + 
  theme_classic()

p2 <- ggplot(df.new, aes(x = x, y = y)) +      
  geom_ribbon(data = . %>% filter(y >= m),
              aes(ymin = m, ymax = y), 
              fill="dodgerblue") +
  geom_ribbon(data = . %>% filter(y <= m),
              aes(ymin = y, ymax = m), 
              fill = "firebrick1") +
  geom_line() +
  geom_hline(yintercept = 5) +
  geom_point() +      
  theme_classic()

Avec ce bloc de données, vous pouvez ensuite définir deux geom_ribbon séparés couches avec différentes couleurs. Comparaison des résultats ci-dessous (note: j'ai également ajouté un calque geom_point pour l'illustration, et changé les couleurs car le bleu dans l'original est un peu éblouissant pour les yeux ...)

m <- 5 # replace with desired y-intercept value for the horizontal line

# identify each run of points completely above (or below) the horizontal
# line as a new section
df.new <- df %>%
  arrange(x) %>%
  mutate(above.m = y >= m) %>%
  mutate(changed = is.na(lag(above.m)) | lag(above.m) != above.m) %>%
  mutate(section.id = cumsum(changed)) %>%
  select(-above.m, -changed)

# calculate the x-coordinate of the midpoint between adjacent sections
# (the y-coordinate would be m), & add this to the data frame
df.new <- rbind(
  df.new,
  df.new %>%
    group_by(section.id) %>%
    filter(x %in% c(min(x), max(x))) %>%
    ungroup() %>%
    mutate(mid.x = ifelse(section.id == 1 | 
                            section.id == lag(section.id), 
                          NA,
                          x - (x - lag(x)) / 
                            (y - lag(y)) * (y - m))) %>% 
    select(mid.x, y, section.id) %>%
    rename(x = mid.x) %>%
    mutate(y = m) %>%
    na.omit())

0 commentaires