是可能的多個剪輯嗎？

我正在編輯這個以提供我需要的更好的示例。如果有幫助，我會保留原始信息的底部。是可能的多個剪輯嗎？

，我有以下數據：

所以我的數據是這樣的：

  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 $差異的多邊形的顏色改變多邊形陰謀小於零。所以劇情應該是這樣的：

Polygon plot with different color based on condition

我知道段可以用線條做到這一點，但不幸的是我，我需要用一個多邊形來做到這一點。

原始郵件：

比方說，我有這樣的數據：

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多邊形重疊。

來源

2011-11-23 thequerist

是的，它是。每當多邊形遇到NA值的行時，它都會被剪切。我試着用你的數據，它原則上工作，但我無法弄清楚你的數據操作，所以沒有公佈答案。 – Andrie

我不確定這是否正確。如果我理解了蝙蝠俠的想法，那麼它最終會成爲多邊形，每個連續的z在z $ v <0範圍內。 v <0的每個區域都需要自己調用多邊形以及它自己的循環結構。如果只有一行有v <0 between v> 0行會怎麼樣？這只是一個寬度爲零的線，對吧？ [實際上可能忽略..現在閱讀幫助（多邊形），它可能是可行的... – Spacedman

啊棘手的一點是，你必須扭轉每個段內的y值的順序 - 扭轉整個向量將無法正常工作。 – Spacedman

有可能通過一條線在僅由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")

enter image description here

PS。我不知道你的數據在現實生活中的表現如何，但是我的直覺是你可以更好地（或者至少）更好地想象它，如果你使用geom_linerange而不是多邊形，那麼用更少的努力。

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

enter image description here

來源

2011-11-25 23:27:04 Andrie

謝謝。線範圍是一個更好的選擇。我也想出了一個不那麼優雅的方式來做到這一點：'plot（b $ Date，b $ Max，type ='h'，col ='skyblue'）; lines（w $ Date，w $ Max，type = 'H'，COL = '鮭魚'）;線（b $日期，b $最小，類型= 'H'，COL = '白'）'。不是很優雅，但現在我將開始學習ggplot，因爲我對它的功能印象深刻。 – thequerist

我建議你合併單個數據框上的所有數據，併爲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)

enter image description here

來源

2011-11-23 20:16:53

不幸的是，這不是我正在尋找的。我沒有嘗試合併，但是當v <0時，我嘗試用NAs替換所有x和y的數據幀，這與您所做的一樣，除非您使用合併來獲得該結果。我還試着在w表中得到了一個有趣的結果，當v <0時用零替換日期，x和y，但是又不是我想要的。當某個日期只有一種顏色的陰影時，您會知道您的方向是正確的，我會在您的圖表中看到藍色和紅色的日期。看看Spacedman關於細分市場的評論。 – thequerist

從所述一個@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")

enter image description here

這顯然有一些弱點：

假設條件是平均的x和y值是合理的。使用POSIXct，但可能不會使用純日期！
如果您不希望塊在塊的邊界處「分裂差異」超過一天，則必須在for循環中執行一些操作以查看並查看每個塊的長度。

我還沒有清理這個根本上，所以我敢肯定，改進是可能的......

來源

2011-11-26 01:25:40 joran

是的，我很擔心安德里的第一個解決方案是如何處理色帶持續多少天。我很困擾多邊形，我沒有考慮使用酒吧。我怎樣才能給兩個答案賞金？你的答案都讓我朝着一個我自己不會走的方向前進。 – thequerist

我跟今天這個玩弄，看一個高雅的做法有可能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)

enter image description here

來源

2011-12-06 21:13:00 thequerist

是可能的多個剪輯嗎？

回答

相關問題