ggplot2 geom_ribbon to colour-label time series

Question

I want to colour-label a time series using ggplot2. I have two distinct states (classes) as given by the labels vector below and I want to super-impose this on top of a plot of IBM Close prices.

Below is my attempt, which unfortunately can not produce distinctively colour-coded regions by state. I am mainly having trouble with using geom_ribbon():

library(TTR)
library(ggplot2)

data <- getYahooData("IBM", start = 20130101, end = 20150101, freq = "daily")
df <- data.frame(data)
df$Date <-as.Date(row.names(df),"%Y-%m-%d")        

# plot colour coded states on top of the original signal
dput(labels)
c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L)

# colour and class labels to be used by geom_ribbon
df_bg <- data.frame(x = c(0, rep(which(as.logical(diff(labels))), each=2), length(labels)), 
                    ymin = min(df$Close, na.rm = TRUE), 
                    ymax = 1.1*max(df$Close, na.rm = TRUE), 
                    fill = factor(rep(labels[c(which(as.logical(diff(labels))), length(labels) )], each=2))
                    )

ggplot(data=df) +
  geom_line(aes(x=1:nrow(df), y=diff_ma )) +
  labs(title="IBM 2-State HMM") +
  geom_ribbon(data = df_bg, 
              aes(x = x, ymin=ymin, ymax=ymax, fill=fill), alpha=.2) +
  xlab("Date") +
  ylab("Levels") +
  theme(legend.justification = c(1, 0), legend.position = c(1, 0))

As you can see below, rather than distinct red and blue filled regions, this geom_ribbon code produces a mixture of the two.

What am I doing wrong here? I think it is the fill column in df_bg, but I am not entirely sure. Also, if I wanted to plot by Date in the x axis, can I still use geom_ribbon to colour label?

P.S: This question is related to my previous one here.

Answer 1

You need to add a group argument to your data and geom_ribbon call. Otherwise it groups by color and just uses the filling color from the minimum to the maximum value for each of your colors.

# colour and class labels to be used by geom_ribbon
df_bg <- data.frame(x = c(0, rep(which(as.logical(diff(labels))), each=2), length(labels)), 
                    ymin = min(df$Close, na.rm = TRUE), 
                    ymax = 1.1*max(df$Close, na.rm = TRUE), 
                    fill = factor(rep(labels[c(which(as.logical(diff(labels))), length(labels) )], 
                                      each=2)),
                    grp = factor(rep(seq(sum(as.logical(diff(labels)), na.rm=TRUE)+1), each=2))
)
# 
ggplot(data=df) +
  geom_line(aes(x=1:nrow(df), y=Close)) +
  labs(title="IBM 2-State HMM") +
  geom_ribbon(data = df_bg, 
              aes(x = x, ymin=ymin, y=180, ymax=ymax, fill=fill, group=grp), alpha=.2) +
  xlab("Date") +
  ylab("Levels") +
  theme(legend.justification = c(1, 0), legend.position = c(1, 0))

EDIT: In order to change the x-axis to Date format, you can use the Date in your geom_line command and change the x of your df_bg to a Date.

# colour and class labels to be used by geom_ribbon
df_bg <- data.frame(x = df[c(1, rep(which(as.logical(diff(labels))), each=2), length(labels)), "Date"], 
                    ymin = min(df$Close, na.rm = TRUE), 
                    ymax = 1.1*max(df$Close, na.rm = TRUE), 
                    fill = factor(rep(labels[c(which(as.logical(diff(labels))), length(labels) )], 
                                      each=2)),
                    grp = factor(rep(seq(sum(as.logical(diff(labels)), na.rm=TRUE)+1), each=2))
)
#
ggplot(data=df) +
  geom_line(aes(x=Date, y=Close)) +
  labs(title="IBM 2-State HMM") +
  geom_ribbon(data = df_bg, 
              aes(x = x, ymin=ymin, y=180, ymax=ymax, fill=fill, group=grp), alpha=.2) +
  xlab("Date") +
  ylab("Levels") +
  theme(legend.justification = c(1, 0), legend.position = c(1, 0))