在两行之间填充区域,高/低和日期

前言:我对自己的问题提供了一个合理满意的答案。 我明白这是可以接受的做法。 当然,我的希望是邀请建议和改进。

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

我为此使用了ggplot2 ,因为我对该软件包非常熟悉(作者:Hadley Wickham),但随时可以提出其他方法。 我编写了一个基于ggplot2包的geom_ribbon()函数的自定义函数。 在初期,我遇到了与我在处理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:提出一个类似的问题,但提供的细节比我所寻找的要少。
  • 可能的bug-in-geom-ribbon:密切相关,但如何计算最大/最小值的中间步骤缺失。
  • 填充区域之间的两个黄土平滑线在r与ggplot:密切相关,但专注于黄土线。 优秀。
  • ggplot-coloring-areas-between-density-lines-according-to-relative-position:密切相关,但关注密度。 这篇文章极大地鼓舞了我。

  • 也许我并不了解你的完整问题,但似乎相当直接的做法是将第三行定义为每个时间点两个时间序列的最小值。 然后调用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)
    

    这产生了以下图表:


    我前段时间也有同样的问题,这里是相关的文章。 它定义了一个函数,用于查找两行之间的交点,以及另一个函数,该函数在输入中采用数据帧,然后使用matplotpolygon为两列之间的空间matplot

    编辑

    这里是代码,修改了一下,允许绘制最后一个多边形

    set.seed(123456789)
    dat <- 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))))
    
    intersects <- function(x1, x2) {
        seg1 <- which(!!diff(x1 > x2))     # location of first point in crossing segments
        above <- x2[seg1] > x1[seg1]       # which curve is above prior to crossing
        slope1 <- x1[seg1+1] - x1[seg1]
        slope2 <- x2[seg1+1] - x2[seg1]
        x <- seg1 + ((x2[seg1] - x1[seg1]) / (slope1 - slope2))
        y <- x1[seg1] + slope1*(x - seg1)
        data.frame(x=x, y=y, pindex=seg1, pabove=(1:2)[above+1L]) 
     # pabove is greater curve prior to crossing
    }
    
    fillColor <- function(data, addLines=TRUE) {
    ## Find points of intersections
    ints <- intersects(data[,2], data[,3]) # because the first column is for Dates
    intervals <- findInterval(1:nrow(data), c(0, ints$x))
    
    ## Make plot
    matplot(data, type="n", col=2:3, lty=1, lwd=4,xaxt='n',xlab='Date')
    axis(1,at=seq(1,dim(data)[1],length.out=12),
    labels=data[,1][seq(1,dim(data)[1],length.out=12)])
    legend("topright", c(colnames(data)[2], colnames(data)[3]), col=3:2, lty=1, lwd=2)
    
    ## Draw the polygons
    for (i in seq_along(table(intervals))) {
        xstart <- ifelse(i == 1, 0, ints$x[i-1])
        ystart <- ifelse(i == 1, data[1,2], ints$y[i-1])
        xend <- ints$x[i]
        yend <- ints$y[i]
        x <- seq(nrow(data))[intervals == i]
        polygon(c(xstart, x, xend, rev(x)), c(ystart, data[x,2], yend, rev(data[x,3])),
    col=ints$pabove[i]%%2+2)
    }
    
    # add end of plot
    
    xstart <- ints[dim(ints)[1],1]
    ystart <- ints[dim(ints)[1],2]
    xend <- nrow(data)
    yend <- data[dim(data)[1],2]
    x <- seq(nrow(data))[intervals == max(intervals)]
    polygon(c(xstart, x, xend, rev(x)), c(ystart, data[x,2], yend, rev(data[x,3])),
    col=ints[dim(ints)[1]-1,4]%%2+2)
    
    ## Add lines for curves
    if (addLines)
        invisible(lapply(1:2, function(x) lines(seq(nrow(data)), data[,x], col=x%%2+2, lwd=2)))
    }
    
    ## Plot the data
    fillColor(dat,FALSE)
    

    最后的结果是这个(用与问题相同的数据)

    在这里输入图像描述

    链接地址: http://www.djcxy.com/p/88513.html

    上一篇: Fill area between two lines, with high/low and dates

    下一篇: Webpack build very slow because of external libraries