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,]

次に、2つの色で構成されるポリゴンを作成しようとします。1つはx> yの場合、もう1つは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、ポリゴンがそれらのギャップをカバーします。クリップを使用して1つの領域をクリップする方法を知っていますが、データフレーム内の複数のギャップをクリップするために使用できますか？

理想的には、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. チャンクが 1 日よりも長いチャンクの境界で「差を分割」しないようにする場合は、forループをいじって、先を見越して各チャンクの長さを確認する必要があります。

私はこれをまったくクリーンアップしていないので、改善が可能であると確信しています...

于 2011-11-26T01:25:40.620 に答える
0

z と w の異なる列名を持つ単一のデータ フレーム上のすべてのデータをマージすることをお勧めします。

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'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)

ここに画像の説明を入力

于 2011-12-06T21:13:00.877 に答える