r - 用高/低和日期填充两行之间的区域

Question

前言:对于我自己的问题，我提供了一个合理令人满意的答案。我了解这是可以接受的做法。我自然希望能提出建议和改进。

我的目的是绘制两个时间序列(存储在数据框中，日期存储为“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的相关问题和解答，但我还没有找到足够详细的问题来解决我的问题。以下是一些有用的交流:

create-geom-ribbon-for-min-max-range:提出类似的问题，但提供的细节少于我想要的。

possible-bug-in-geom-ribbon:密切相关，但是缺少有关如何计算最大/最小的中间步骤。

fill-region-between-two-loess-smoothed-lines-in-r-with-ggplot:密切相关，但侧重于黄土线。优秀的。

ggplot-colouring-areas-between-density-lines-according-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)

这将产生以下图表: