2

我正在编辑这个以提供一个更好的例子来说明我需要什么。如果有帮助，我会将原始消息保留在底部。

我有以下数据：

x=c(1,2,7,3,4,8,9,5,6,7,11,13,15,8,9,10,11,12,13,15)
y=c(2:10,9,8,7,6,8,10,11,12,13,14,1)
date=strptime(20010101:20010120,'%Y%m%d')
z=data.frame(date,x,y)
z$diff=z$y-z$x
z$min=pmin(x,y)
z$max=pmax(x,y)

所以我的数据是这样的：

         date  x  y diff min max
1  2001-01-01  1  2    1   1   2
2  2001-01-02  2  3    1   2   3
3  2001-01-03  7  4   -3   4   7
4  2001-01-04  3  5    2   3   5
5  2001-01-05  4  6    2   4   6
6  2001-01-06  8  7   -1   7   8
7  2001-01-07  9  8   -1   8   9
8  2001-01-08  5  9    4   5   9
9  2001-01-09  6 10    4   6  10
10 2001-01-10  7  9    2   7   9
11 2001-01-11 11  8   -3   8  11
12 2001-01-12 13  7   -6   7  13
13 2001-01-13 15  6   -9   6  15
14 2001-01-14  8  8    0   8   8
15 2001-01-15  9 10    1   9  10
16 2001-01-16 10 11    1  10  11
17 2001-01-17 11 12    1  11  12
18 2001-01-18 12 13    1  12  13
19 2001-01-19 13 14    1  13  14
20 2001-01-20 15  1  -14   1  15

我想创建一个多边形图，其中多边形的颜色根据 z$diff 小于零的时间而变化。所以情节应该是这样的：

根据条件使用不同颜色的多边形图

我知道线段可以用线条来做到这一点，但不幸的是我需要用多边形来做到这一点。

原始信息：

假设我有这些数据：

x=rnorm(100)
y=rnorm(100)
date=strptime(20010101:20010410,'%Y%m%d')
date=date[complete.cases(date)]
z=data.frame(date,x,y)
z$max=apply(z[2:3],1,which.max)
z$min=apply(z[2:3],1,which.min)
z$v=z$max-z$min
w=z[z$v<0,]

然后我尝试制作一个由两种颜色组成的多边形，一种用于 x>y 时，另一种用于 y>x 时。我这样做：

plot(z$date,z$x,type='n')
polygon(c(z$date,z$date[nrow(z):1]),c(z$x,z$y[nrow(z):1]),col='skyblue',border=NA)
polygon(c(w$date,w$date[nrow(w):1]),c(w$x,w$y[nrow(w):1]),col='salmon',border=NA)

发生的情况是，当数据框中存在间隙时w，多边形会覆盖这些间隙。我知道如何使用剪辑来剪辑一个区域，但它可以用来剪辑数据帧中的多个间隙吗？

理想情况下，只要 y>x w，多边形就应该在多边形上重叠。z

4

4 回答 4

3

可以通过仅由 组成的数据中的一条线来分隔多边形NA。

library(reshape2)
library(ggplot2)

z <- data.frame(
    date=date,
    min=pmin(x, y),
    max=pmax(x, y),
    series=ifelse(x>y, 1, 2)
)

# Helper function to create closed polygon, optionally adding NA line at bottom
rdata <- function(dat, addNA=FALSE){
  rdat <- dat[nrow(dat):1, ]
  ret <- rbind(
      data.frame(x= dat$date, y= dat$max, series= dat$series), 
      data.frame(x=rdat$date, y=rdat$min, series=rdat$series)
  )
  if(addNA) ret <- rbind(ret, c(NA, NA, NA))
  ret
}

# Closed polygon 1
rz <- rdata(z)

#Closed polygon 2
z2 <- z
rlez <- rle(z$series)$lengths
z2$chunk <- rep(seq_along(rlez), times=rlez)
rz2 <- ddply(z2, .(chunk), rdata, addNA=TRUE)
rz2 <- rz2[rz2$series!=1, ]

创建绘图

ggplot(rz, aes(x, y, fill="Less than")) + geom_polygon() + 
    geom_polygon(data=rz2, aes(x, y, fill="Greater than")) +
    scale_fill_discrete("Legend") +
    xlab("Date") +
    ylab("Value")

在此处输入图像描述

PS。我不知道您的数据在现实生活中代表什么，但我的直觉是您可以更好地可视化它（或者至少也可以），如果您使用geom_linerange而不是多边形，那么工作量会少得多。

ggplot(z, aes(x=date, ymin=min, ymax=max, colour=factor(series))) + 
    geom_linerange(size=5)

在此处输入图像描述

于 2011-11-25T23:27:04.543 回答
3

与@Andrie 采取的方向不同。我发现它使用起来更直观geom_ribbon（我敢肯定这只是geom_polygon某种程度的包装）。

您没有很好地指定如何处理长度为 1 的块。从技术上讲，这样一个块的“多边形”只是一个垂直线段。对我来说更直观的是让这些块在任一方向略微延伸，以“在中间相遇”。

#Construct similar data
x=c(1,2,7,3,4,8,9,5,6,7,11,13,15,8,9,10,11,12,13,15)
y=c(2:10,9,8,7,6,8,10,11,12,13,14,1)
date=strptime(20010101:20010120,'%Y%m%d')
z=data.frame(date,x,y)
z$diff=z$y-z$x
z$min=pmin(x,y)
z$max=pmax(x,y)

#Assign a unique integer to each chunk
tmp <- rle(z$diff > 0)
z$series <- rep(1:length(tmp$lengths),times = tmp$lengths)

#Grab just the useful columns
z1 <- z[,c(1,4:7)]

#This is the ugly part.
# Loop through data and add a row
# at the transitions    
for (i in 2:nrow(z1)){
    if (z1$series[i] != z1$series[i-1]){
        newRow <- colwise(mean)(z1[c(i,i-1),])
        newRow1 <- newRow2 <- newRow
        newRow1$series <- z1$series[i-1]; newRow2$series <- z1$series[i]
        newRow1$diff <- z1$diff[i-1]; newRow2$diff <- z1$diff[i]
        z1 <- rbind(z1,newRow1,newRow2)
    }
}

#Put everything back in order
z1 <- arrange(z1,date)

#Create a factor to build the legend with
z1$diff <- sign(z1$diff)
z1$grp <- factor(ifelse(z1$diff > 0,"Greater Than","Less Than"))

#The only clever bit ;)
ribbons <- dlply(z1,.(series),.fun = function(x){geom_ribbon(data = x,aes(ymin = min,ymax = max,fill = grp))})

p <- ggplot(z1,aes(x = date, ymin = min,ymax = max,fill = grp)) +
        ribbons + 
        labs(x = NULL,y = NULL,fill = "Legend")

在此处输入图像描述

这显然有一些弱点：

  1. 假设平均x和y值是明智的。使用 POSIXct，但可能不会使用纯日期！
  2. 如果您不希望这些块在超过一天的块边界处“分割差异”，则必须在for循环中进行一些摆弄以向前看并查看每个块的长度。

我根本没有清理这个，所以我相信改进是可能的......

于 2011-11-26T01:25:40.620 回答
0

我建议您合并单个数据帧上的所有数据，z 和 w 具有不同的 col 名称。

names(w) <- c('date1','x1','y1','max1','min1','v1')
kk <- merge(z,w, by.x='date', by.y='date1', all.x=TRUE)

plot(kk$date,kk$x,type='n')
polygon(c(kk$date,kk$date[nrow(kk):1]),c(kk$x,kk$y[nrow(kk):1])
        ,col='skyblue',border=NA)
polygon(c(kk$date,kk$date[nrow(kk):1]), c(kk$x1,kk$y1[nrow(kk):1])
        ,col='salmon',border=NA)

在此处输入图像描述

于 2011-11-23T20:16:53.010 回答
0

我今天正在玩这个，看看是否可以对Andrie 的答案中的条形图采用一种优雅的基本方法。这是基础中的一个简单方法：

x=c(1,2,7,3,4,8,9,5,6,7,11,13,15,8,9,10,11,12,13,15)
y=c(2:10,9,8,7,6,8,10,11,12,13,14,1)
date=strptime(20010101:20010120,'%Y%m%d')
z=data.frame(date,x,y)
z$diff=z$y-z$x
z$min=pmin(x,y)
z$max=pmax(x,y)

zp=z[z$diff>0,]
zn=z[z$diff<0,]

plot(z$date,z$max,type='n',ylim=range(0,max(z$max)))
segments(zp$date,zp$min,zp$date,zp$max,col='skyblue',lwd=10,lend=1)
segments(zn$date,zn$min,zn$date,zn$max,col='salmon',lwd=10,lend=1)

在此处输入图像描述

于 2011-12-06T21:13:00.877 回答