1
votes

I want to do a graph with ggplot2, where I need the space/area between the intercept (=1) and the values (which I connected through geom_line) to be red (if the values are lower than 1) or green (if the values are bigger than 1). The data is from microsoft (price performance since 1999).

Data:

require(quantmod)
require(dplyr)
require(ggplot2)

getSymbols("MSFT", from ="1999-01-01")
microsoft <- data.frame(time(MSFT), MSFT[,6]) 
microsoft$time <- as.Date(microsoft$time.MSFT., "%Y-%m-%d")

microsoft <- microsoft %>%
mutate(change = MSFT.Adjusted - first(MSFT.Adjusted),
     change.pc = change/first(MSFT.Adjusted)+1) 

that is the ggplot I have so far:

ggplot(microsoft, aes(x = time, y = change.pc)) +
  geom_line(stat = "identity") + 
  geom_hline(aes(yintercept=1), color="black") + 
  theme_bw() + 
  xlab("Jahr") + ylab("") + 
  ggtitle("Microsoft Kursentwicklung seit Januar 1999")

I want to fill the space between y = 1 and the values above in green, and the space between y = 1 and the values under in red. I tried geom_ribbon, geom_area, geom_polynom, but nothing worked. The biggest problem is, that it fills the space green, but not online above y = 1 but also under. and the red you can't even see...

here what I tried:

geom_area(data = subset(microsoft, change.pc > 1), fill = "green", alpha =0.5)
geom_area(data = subset(microsoft, change.pc < 1), fill = "red", alpha = 0.5) 

I put these to lines in my plot, and then the problem I described above appeared.

Among other things I also tried this (found here on stackoverflow.com):

microsoft$grp <- "orig"
microsoft <- microsoft[order(microsoft$time),]
microsoft_new <- do.call("rbind",
             sapply(1:(nrow(microsoft) -1), function(i){
               f <- lm(time ~ change.pc, microsoft[i:(i+1), ])
               if (f$qr$rank < 2) return(NULL)
               r <- predict(f, newdata = data.frame(change.pc = 0))
               if(microsoft[i, ]$time < r & r < microsoft[i+1, ]$time)
                 return(data.frame(time = r, change.pc = 0))
               else return(NULL)
             })
)
microsoft_2 <- rbind(microsoft, microsoft_new)  
ggplot(microsoft_2, aes(x = time, y = change.pc)) +
  geom_area(data = subset(microsoft_2, change.pc <= 1), fill = "red") +
  geom_area(data = subset(microsoft_2, change.pc >= 1), fill = "blue") +
  scale_x_continuous("", expand = c(0,0), breaks = seq(1999, 2017, 3)) +
  theme_bw()

That didn't work either. Does anyone has an idea how I could achieve what I need? This is how it should look

enter image description here

2
could not find function "getSymbols". Please make your example reproducible.Axeman
@Axeman: That function comes from the quantmod package. I've added the required packages in the example to make it reproducible.shadow

2 Answers

6
votes

I couldn't get your data to work, but using some made up data, the following approach looks like you're example:

library(ggplot2)
set.seed(0)
microsoft <- data.frame(date=1:1000, y=cumsum(runif(1000)-0.5))

ggplot(microsoft, aes(x=date,y=y)) +
geom_ribbon(aes(ymin=pmin(microsoft$y,0), ymax=0), fill="red", col="red", alpha=0.5) +
geom_ribbon(aes(ymin=0, ymax=pmax(microsoft$y,0)), fill="green", col="green", alpha=0.5) +
geom_line(aes(y=0))

Graph produced by sample code

0
votes

You can use geom_ribbon for this. The following solution is similar to @Miff's solution, but with intersection at 1. I have in addition added the desired scales.

ggplot(microsoft, aes(x = time, y = change.pc)) +
  geom_ribbon(aes(ymin=pmin(change.pc,1), ymax=1), fill="red", col="red", alpha=0.5) +
  geom_ribbon(aes(ymin=1, ymax=pmax(microsoft$change.pc,1)), fill="green", col="green", alpha=0.5) +
  geom_hline(aes(yintercept=1), color="black") + 
  theme_bw(base_size = 16) + 
  scale_x_date(name = "Jahr", 
               date_breaks = "3 years", 
               date_minor_breaks = "1 year",
               date_labels = "%Y") +
  scale_y_continuous(name = "", 
                     breaks = seq(.8, 2.8, by = .4), 
                     labels = paste0(seq(80, 280, by = 40), "%")) +
  ggtitle("Microsoft Kursentwicklung seit Januar 1999")