填充两条线之间的区域,高/低和日期

Question

Forword:我为自己的问题提供了一个相当令人满意的答案.我明白这是可以接受的做法.我自然希望能够提出建议和改进.

我的目的是绘制两个时间序列(存储在数据框中,日期存储为类'Date'),并根据一个是否在另一个之上,用两种不同的颜色填充数据点之间的区域.例如,绘制债券指数和股票指数,并在股票指数高于债券指数时用红色填充该区域,否则用蓝色填充该区域.

我已经用于ggplot2此目的,因为我对该软件包非常熟悉(作者:Hadley Wickham),但可以随意提出其他方法.我根据包的geom_ribbon()功能编写了一个自定义函数ggplot2.在早期,我遇到了与我在处理geom_ribbon()函数和类对象方面缺乏经验相关的问题'Date'.下面的功能代表了我解决这些问题的努力,几乎肯定是迂回,不必要的复杂,笨拙等等.所以我的问题是:请建议改进​​和/或替代方法.最终,在这里提供通用功能会很棒.

数据:

set.seed(123456789)
df <- data.frame(
    Date  = seq.Date(as.Date("1950-01-01"), by = "1 month", length.out = 12*10),
    Stocks = 100 + c(0, cumsum(runif(12*10-1, -30, 30))),
    Bonds = 100 + c(0, cumsum(runif(12*10-1, -5, 5))))
library('reshape2')
df <- melt(df, id.vars = 'Date')

自定义功能:

## Function to plot geom_ribbon for class Date
geom_ribbon_date <- function(data, group, N = 1000) {
    # convert column of class Date to numeric
    x_Date <- as.numeric(data[, which(sapply(data, class) == "Date")])
    # append numeric date to dataframe
    data$Date.numeric <- x_Date
    # ensure fill grid is as fine as data grid
    N <- max(N, length(x_Date))
    # generate a grid for fill
    seq_x_Date <- seq(min(x_Date), max(x_Date), length.out = N)
    # ensure the grouping variable is a factor
    group <- factor(group)
    # create a dataframe of min and max
    area <- Map(function(z) {
        d <- data[group == z,];
        approxfun(d$Date.numeric, d$value)(seq_x_Date);
    }, levels(group))
    # create a categorical variable for the max
    maxcat <- apply(do.call('cbind', area), 1, which.max)
    # output a dataframe with x, ymin, ymax, is. max 'dummy', and group
    df <- data.frame(x = seq_x_Date, 
        ymin = do.call('pmin', area), 
        ymax = do.call('pmax', area), 
        is.max = levels(group)[maxcat],
        group = cumsum(c(1, diff(maxcat) != 0))
    )
    # convert back numeric dates to column of class Date
    df$x <- as.Date(df$x, origin = "1970-01-01")
    # create and return the geom_ribbon
    gr <- geom_ribbon(data = df, aes(x, ymin = ymin, ymax = ymax, fill = is.max, group = group), inherit.aes = FALSE)
    return(gr)
}

用法:

ggplot(data = df, aes(x = Date, y = value, group = variable, colour = variable)) + 
    geom_ribbon_date(data = df, group = df$variable) +
    theme_bw() +
    xlab(NULL) +
    ylab(NULL) +
    ggtitle("Bonds Versus Stocks (Fake Data!)") +
    scale_fill_manual('is.max', breaks = c('Stocks', 'Bonds'), 
                        values = c('darkblue','darkred')) +
    theme(legend.position = 'right', legend.direction = 'vertical') +
    theme(legend.title = element_blank()) +
    theme(legend.key = element_blank())

结果:

虽然stackoverflow上有相关的问题和答案,但我没有找到一个足够详细的用于我的目的.以下是一些有用的交流:

1. create-geom-ribbon-for-min-max-range:问一个类似的问题,但提供的细节比我想要的要少.
2. 可能的bug-in-geom-ribbon:密切相关,但缺少如何计算max/min的中间步骤.
3. 填充区域 - 两个黄土 - 平滑线 - 在 - 与 - ggplot:密切相关,但侧重于黄土线.优秀.
4. ggplot-coloring-areas-between-density-lines-based-to-relative-position:密切相关,但侧重于密度.这篇文章给了我极大的启发

Answer 1

也许我不理解你的全部问题，但似乎一个相当直接的方法是将第三行定义为每个时间点的两个时间序列的最小值。 geom_ribbon然后调用两次（对于 的每个唯一值调用一次Asset）以绘制由每个系列和最小线形成的色带。代码可能如下所示：

set.seed(123456789)
df <- data.frame(
  Date  = seq.Date(as.Date("1950-01-01"), by = "1 month", length.out = 12*10),
  Stocks = 100 + c(0, cumsum(runif(12*10-1, -30, 30))),
  Bonds = 100 + c(0, cumsum(runif(12*10-1, -5, 5))))

library(reshape2)
library(ggplot2)
df <- cbind(df,min_line=pmin(df[,2],df[,3]) ) 
df <- melt(df, id.vars=c("Date","min_line"), variable.name="Assets", value.name="Prices")

sp <- ggplot(data=df, aes(x=Date, fill=Assets))
sp <- sp + geom_ribbon(aes(ymax=Prices, ymin=min_line))
sp <- sp + scale_fill_manual(values=c(Stocks="darkred", Bonds="darkblue"))
sp <- sp + ggtitle("Bonds Versus Stocks (Fake Data!)")
plot(sp)

这会产生以下图表：