是否可以在绘图上使用多个剪辑？答案

【问题标题】：Is a multiple clip on a plot possible?是否可以在绘图上使用多个剪辑？
【发布时间】：2011-11-23 00:39:32
【问题描述】：

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

我有以下数据：

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 中存在间隙时，多边形会覆盖这些间隙。我知道如何使用clip来裁剪一个区域，但是它可以用来裁剪数据框中的多个间隙吗？

理想情况下，w 多边形应在 y>x 时与 z 多边形重叠。

【问题讨论】：

是的。每次您的多边形遇到具有 NA 值的行时，它都会剪辑。我用你的数据试过了，它原则上是有效的，但我无法弄清楚你的数据操作，所以没有发布答案。
我不确定这是否正确。如果我理解查询者想要什么，它最终会变成多个多边形，一个对应于 z 中 z$v0 行之间有 v
啊，棘手的一点是您必须颠倒每个段中 y 值的顺序 - 颠倒整个向量是行不通的。
Spacedman，我将边框从 NA 更改为相应的颜色，以处理只有一行的多边形。是的，w 数据框将需要某种方式来反转段。我想如果所有其他方法都失败了，我将求助于找出一种方法，从每个连续的行系列中制作多个数据框，然后从中制作多个多边形。不过，我的数据可以追溯到 1960 年，我真的很想避免这种情况。
Andrie，对不起，我对 R 很陌生，我的数据操作还有很多不足之处。基本上，我为此示例创建了两组随机数，创建了一个日期字段，然后由于某种原因消除了几个月之间得到的 NA。然后我将所有这些都放在一个数据框中，并确定 y 是否大于 x。我的实际数据中有两列以上，这就是我选择最大值和最小值的原因。如果 x 更大，我希望这些多边形的颜色与 y 更大时不同。希望这让它更清楚一点。我可能不应该在这个例子中使用随机数。

标签： r clip

【解决方案1】：

可以在仅由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)

【讨论】：

谢谢。线范围是更好的选择。我还想出了一个不太优雅的方式来做这件事：plot(b$Date,b$Max,type='h',col='skyblue');lines(w$Date,w$Max,type='h',col='salmon');lines(b$Date,b$Min,type='h',col='white')。不是很优雅，但现在我将开始学习 ggplot，因为它的功能给我留下了深刻的印象。

【解决方案2】：

与@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")

这显然有一些弱点：

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

我根本没有清理它，所以我确信可以改进......

【讨论】：

是的，我担心 Andrie 的第一个解决方案是如何处理色带持续多少天。我被多边形困住了，我没有考虑过使用条形图。我怎样才能赏金两个答案？你的两个回答都把我引向了一个我自己不会去的方向。

【解决方案3】：

我建议您合并单个数据框中的所有数据，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)

【讨论】：

不幸的是，这不是我想要的。我没有尝试合并，但我确实尝试在w 数据帧上的 vw 表中的 v

【解决方案4】：

我今天正在玩这个，看看是否有可能对the bar plot in Andrie's answer 进行优雅的基本方法。这是基础中的一个简单方法：

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)

【讨论】：