ggplot2 geom_ribbon для цветовых меток временных рядов

Question

Я хочу, чтобы цветная метка временного ряда использовала ggplot2. У меня есть два разных состояния (классы), приведенные ниже в коде labels, и я хочу супер-навязать это сверху графика IBM Close.

Ниже приведена моя попытка, которая, к сожалению, не может производить четко окрашенные регионы по штату. Я в основном возникают проблемы с использованием 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)) 

Как вы можете видеть ниже, а не четкие красные и синие закрашенные области, этот geom_ribbon код дает смесь двух.

Что я здесь делаю неправильно? Я думаю, что это fill столбец в df_bg, но я не совсем уверен. Кроме того, если бы я хотел построить по дате по оси x, могу ли я использовать geom_ribbon для цветной метки?

P.S: Этот вопрос связан с моим предыдущим here.

Answer 1

Вам необходимо добавить аргумент group к вашим данным и позвонить geom_ribbon. В противном случае он группируется по цвету и просто использует цвет заполнения от минимального до максимального значения для каждого из ваших цветов.

# 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: Для того, чтобы изменить x-axis в Date формат, вы можете использовать Date в вашей команде geom_line и изменить х из ваших df_bg в 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))